diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS index 85b236229..b3693f6c0 100644 --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -1,2 +1,2 @@ -* @c-cube @mattjbray +* @c-cube diff --git a/.github/workflows/format.yml b/.github/workflows/format.yml new file mode 100644 index 000000000..0677ccd1a --- /dev/null +++ b/.github/workflows/format.yml @@ -0,0 +1,18 @@ +name: format + +on: + push: + branches: + - main + pull_request: + +jobs: + format: + name: format + runs-on: ubuntu-latest + container: ghcr.io/ocaml-tracing/ocaml-opentelemetry/ci-4.14:latest + + steps: + - uses: actions/checkout@d23441a48e516b6c34aea4fa41551a30e30af803 # v6.1.0 + + - run: opam exec -- make format-check diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index 888b7cebc..ec590c251 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -5,26 +5,30 @@ on: branches: - main +permissions: + contents: write + packages: read + jobs: deploy: runs-on: ubuntu-latest - steps: - - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + container: ghcr.io/ocaml-tracing/ocaml-opentelemetry/ci-5.4:latest - # needed for depext to work - - run: sudo apt-get update && sudo apt-get install mccs - - - uses: ocaml/setup-ocaml@15d660006c1d3110d77c34b7faa3bddefe8b82f0 # v3.7.0 + steps: + - uses: actions/checkout@d23441a48e516b6c34aea4fa41551a30e30af803 # v6.1.0 with: - ocaml-compiler: '5.1.x' - dune-cache: true - allow-prerelease-opam: true + submodules: recursive - - name: Deps - run: opam install odig opentelemetry opentelemetry-lwt opentelemetry-client-ocurl opentelemetry-cohttp-lwt + - name: Install local packages + run: opam exec -- dune build @install && opam exec -- dune install - - name: Build - run: opam exec -- odig odoc --cache-dir=_doc/ opentelemetry opentelemetry-lwt opentelemetry-client-ocurl opentelemetry-cohttp-lwt + - name: Build documentation + run: | + opam exec -- odig odoc --cache-dir=_doc/ \ + opentelemetry opentelemetry-client opentelemetry-lwt \ + opentelemetry-cohttp-lwt opentelemetry-client-ocurl \ + opentelemetry-client-ocurl-lwt opentelemetry-client-cohttp-lwt \ + opentelemetry-client-cohttp-eio opentelemetry-logs - name: Deploy uses: peaceiris/actions-gh-pages@373f7f263a76c20808c831209c920827a82a2847 # v3.9.3 diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 1abf24da7..795552a8d 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -11,62 +11,37 @@ jobs: strategy: fail-fast: false matrix: - os: - - ubuntu-latest - #- windows-latest - #- macos-latest - ocaml-compiler: - - 4.08.x - - 4.13.x - - 5.0.x - - 5.3.x - - runs-on: ${{ matrix.os }} + include: + - ocaml-version: "4.08" + container: ghcr.io/ocaml-tracing/ocaml-opentelemetry/ci-4.08:latest + eio: false + - ocaml-version: "4.14" + container: ghcr.io/ocaml-tracing/ocaml-opentelemetry/ci-4.14:latest + eio: false + - ocaml-version: "5.4" + container: ghcr.io/ocaml-tracing/ocaml-opentelemetry/ci-5.4:latest + eio: true + + runs-on: ubuntu-latest + container: ${{ matrix.container }} steps: - - name: Checkout code - uses: actions/checkout@11d5960a326750d5838078e36cf38b85af677262 # v4.4.0 + - uses: actions/checkout@d23441a48e516b6c34aea4fa41551a30e30af803 # v6.1.0 with: submodules: recursive - # needed for depext to work - - run: sudo apt-get update && sudo apt-get install mccs - if: ${{ matrix.os == 'ubuntu-latest' }} - - - name: Use OCaml ${{ matrix.ocaml-compiler }} - uses: ocaml/setup-ocaml@15d660006c1d3110d77c34b7faa3bddefe8b82f0 # v3.7.0 - with: - ocaml-compiler: ${{ matrix.ocaml-compiler }} - opam-depext-flags: --with-test - dune-cache: true - allow-prerelease-opam: true - - - run: | - opam pin ocaml-protoc 3.0.1 -y -n - opam pin pbrt 3.0.1 -y -n - opam install pbrt -y - - # We cannot install packages that need eio on ocaml versions before 5 - - run: | - packages=$(ls ./*.opam | grep -v eio) - opam install $packages --deps-only --with-test --solver=mccs - if: ${{ ! (startsWith(matrix.ocaml-compiler, '5')) }} - - # We should be able to install all packages on ocaml 5 - - run: opam install . --deps-only --with-test --solver=mccs - if: ${{ startsWith(matrix.ocaml-compiler, '5') }} - - - run: opam exec -- dune build @install -p opentelemetry,opentelemetry-lwt,opentelemetry-client-ocurl,opentelemetry-cohttp-lwt,opentelemetry-client-cohttp-lwt,opentelemetry-logs + - name: Build + run: opam exec -- dune build @install -p opentelemetry,opentelemetry-client,opentelemetry-lwt,opentelemetry-cohttp-lwt,opentelemetry-client-ocurl,opentelemetry-client-ocurl-lwt,opentelemetry-client-cohttp-lwt,opentelemetry-logs - - run: opam pin trace --dev -y -n - - run: opam install trace - - run: opam exec -- dune build @install -p opentelemetry + - name: Build eio packages + if: ${{ matrix.eio }} + run: opam exec -- dune build @install -p opentelemetry-client-cohttp-eio,opentelemetry,opentelemetry-client,opentelemetry-lwt,opentelemetry-cohttp-lwt,opentelemetry-client-ocurl,opentelemetry-client-ocurl-lwt,opentelemetry-client-cohttp-lwt,opentelemetry-logs - - run: opam install ocaml-protoc - - run: opam exec -- dune build @lint + - name: Lint (protoc check) + run: opam exec -- dune build @lint - # check that nothing changed - - run: git diff --exit-code + - name: Check no generated files changed + run: git diff --exit-code - - run: opam exec -- dune build @runtest - if: ${{ matrix.os == 'ubuntu-latest' }} + - name: Run tests + run: opam exec -- dune build @runtest diff --git a/.github/workflows/nix.yml b/.github/workflows/nix.yml deleted file mode 100644 index 68c39d712..000000000 --- a/.github/workflows/nix.yml +++ /dev/null @@ -1,14 +0,0 @@ -name: "nix" -on: - pull_request: - push: -jobs: - tests: - runs-on: ubuntu-latest - steps: - - name: Checkout tree - uses: actions/checkout@11d5960a326750d5838078e36cf38b85af677262 # v4.4.0 - with: - submodules: true - - uses: cachix/install-nix-action@08dcb3a5e62fa31e2da3d490afc4176ef55ecd72 # v30 - - run: nix develop -L .# -c dune build @runtest @check diff --git a/.gitignore b/.gitignore index 811fc6e9d..8f820f027 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,5 @@ _opam .merlin *.install *.exe +*.tmp +/.env diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml new file mode 100644 index 000000000..d3cd5cd17 --- /dev/null +++ b/.pre-commit-config.yaml @@ -0,0 +1,10 @@ +repos: + - repo: local + hooks: + - id: ocamlformat + name: ocamlformat check + entry: make format-check + language: system + files: \.(ml|mli)$ + pass_filenames: false + stages: [pre-push] diff --git a/CHANGES.md b/CHANGES.md index b95744357..a56131b6f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,49 @@ +## 0.91.1 + +- fix: lazy init of random generators +- fix: in trace, respect ~parent:P_none + +## 0.91 + +- expose Self_debug.level_above +- config: better defaults in Sdk, have batching enabled by default + +- better error message for otlp http failures +- bounded queue: provide a per-item measure function for better errors/metrics +- fix: retries are self_debug logged at warning level +- move from ocurl to curl as a dep + +## 0.90 + +- major refactor: split library into `opentelemetry.core`, `opentelemetry`, + `opentelemetry.util`, `opentelemetry.emitter`, `opentelemetry.atomic`, revamp internals +- per-signal providers: separate trace, meter, and logger providers replace + the single monolithic exporter +- `opentelemetry.ambient-context` is now a standalone library, once again +- new `opentelemetry-client-ocurl-lwt` package +- client: split `opentelemetry-client-sync` off of the main client library +- client: add support for `http/json` protocol alongside `http/protobuf` +- client: add HTTP retry with exponential backoff +- client: overhaul bounded queue; introduce generic consumer framework +- client: add `Exporter_add_batching`, `Emitter_add_batching`, `Emitter_sample`, + `Emitter_limit_interval` combinators. Batching is factored out of individual + client libraries. +- client: add sampler as an emitter transformer +- client: add `exporter_stdout` and `debug_exporter` +- client: add `self_metrics` and `self_debug` to exporters +- client: add `after_shutdown` callback in ocurl/ocurl-lwt clients +- `Span.dummy`: inert span that is never modified +- `Span.record_exception` now also sets the span status to error +- `Span.set_span_status` added in `opentelemetry.trace` +- `Span`: carry flags to `span_link` +- `Span`: now mutable thanks to ocaml-protoc 4.0, replaces old `Scope.t` entirely +- `Meter.emit` and `Meter_provider.emit_l` added +- emitter: add `flat_map`, `tap`, `to_list`, `enabled` combinators +- clock abstraction added; `ptime` used by default in logger and metrics +- interval limiter used for `metrics_callbacks` +- update to OTEL spec 1.8.0 +- update semantic conventions +- various bug fixes and performance improvements ## 0.12 diff --git a/Makefile b/Makefile index f769d8f1a..2780da81d 100644 --- a/Makefile +++ b/Makefile @@ -11,15 +11,33 @@ clean: @dune clean protoc-gen: - FORCE_GENPROTO=true @dune build @lint + FORCE_GENPROTO=true dune build @lint + +update-submodules: + git submodule update --init + +doc: + @dune build @doc + +PACKAGES=$(shell opam show . -f name) +odig-doc: + @odig odoc --cache-dir=_doc/ $(PACKAGES) format: @dune build @fmt --auto-promote +format-check: + @dune build $(DUNE_OPTS) @fmt --display=quiet + +setup-githooks: + uvx pre-commit install --hook-type pre-push + WATCH ?= @all watch: @dune build $(WATCH) -w $(OPTS) +include deps/Makefile.ci + VERSION=$(shell awk '/^version:/ {print $$2}' opentelemetry.opam) update_next_tag: @echo "update version to $(VERSION)..." diff --git a/README.md b/README.md index bd5b05509..b54954ae6 100644 --- a/README.md +++ b/README.md @@ -7,10 +7,10 @@ connectors to talk to opentelemetry software such as [jaeger](https://www.jaeger - library `opentelemetry` should be used to instrument your code and possibly libraries. It doesn't communicate with anything except - a backend (default: dummy backend); -- library `opentelemetry-client-ocurl` is a backend that communicates + an exporter (default: no-op); +- library `opentelemetry-client-ocurl` is an exporter that communicates via http+protobuf with some collector (otelcol, datadog-agent, etc.) using cURL bindings; -- library `opentelemetry-client-cohttp-lwt` is a backend that communicates +- library `opentelemetry-client-cohttp-lwt` is an exporter that communicates via http+protobuf with some collector using cohttp. ## License @@ -39,14 +39,14 @@ module Otel = Opentelemetry let (let@) = (@@) let foo () = - let@ scope = Otel.Trace.with_ "foo" + let@ span = Otel.Tracer.with_ "foo" ~attrs:["hello", `String "world"] in - do_work(); - Otel.Metrics.( - emit [ - gauge ~name:"foo.x" [int 42]; - ]); - do_more_work(); + do_work (); + let now = Otel.Clock.now Otel.Meter.default.clock in + Otel.Meter.emit1 Otel.Meter.default + Otel.Metrics.(gauge ~name:"foo.x" [int ~now 42]); + Otel.Span.add_event span (Otel.Event.make "work done"); + do_more_work (); () ``` @@ -56,14 +56,14 @@ If you're writing a top-level application, you need to perform some initial conf 1. Set the [`service_name`][]; 2. optionally configure [ambient-context][] with the appropriate storage for your environment — TLS, Lwt, Eio…; -3. and install a [`Collector`][] (usually by calling your collector's `with_setup` function.) +3. and install an exporter (usually by calling your client library's `with_setup` function.) For example, if your application is using Lwt, and you're using `ocurl` as your collector, you might do something like this: ```ocaml let main () = Otel.Globals.service_name := "my_service"; - Otel.GC_metrics.basic_setup(); + Otel.Gc_metrics.setup (); Opentelemetry_ambient_context.set_storage_provider (Opentelemetry_ambient_context_lwt.storage ()); Opentelemetry_client_ocurl.with_setup () @@ fun () -> @@ -72,33 +72,55 @@ let main () = (* … *) ``` - [`service_name`]: - [`Collector`]: + [`service_name`]: [ambient-context]: now vendored as `opentelemetry.ambient-context`, formerly +## Migration 0.13 → v0.90 + +see `doc/migration_guide_v0.90.md` + ## Configuration -The library is configurable via `Opentelemetry.Config`, via the standard -opentelemetry env variables, or with some custom environment variables. +### Environment Variables + +The library supports standard OpenTelemetry environment variables: + +**General:** +- `OTEL_SDK_DISABLED` - disable the SDK (default: false) +- `OTEL_SERVICE_NAME` - service name +- `OTEL_RESOURCE_ATTRIBUTES` - comma-separated key=value resource attributes +- `OTEL_OCAML_DEBUG=1` - print debug messages from the opentelemetry library + +**Exporter endpoints:** +- `OTEL_EXPORTER_OTLP_ENDPOINT` - base endpoint (default: http://localhost:4318) +- `OTEL_EXPORTER_OTLP_TRACES_ENDPOINT` - traces endpoint +- `OTEL_EXPORTER_OTLP_METRICS_ENDPOINT` - metrics endpoint +- `OTEL_EXPORTER_OTLP_LOGS_ENDPOINT` - logs endpoint + +**Exporter configuration:** +- `OTEL_EXPORTER_OTLP_PROTOCOL` - protocol: http/protobuf or http/json (default: http/protobuf) + +**Headers:** +- `OTEL_EXPORTER_OTLP_HEADERS` - headers as comma-separated key=value pairs +- `OTEL_EXPORTER_OTLP_TRACES_HEADERS` - traces-specific headers +- `OTEL_EXPORTER_OTLP_METRICS_HEADERS` - metrics-specific headers +- `OTEL_EXPORTER_OTLP_LOGS_HEADERS` - logs-specific headers -- `OTEL_EXPORTER_OTLP_ENDPOINT` sets the http endpoint to send signals to -- `OTEL_OCAML_DEBUG=1` to print some debug messages from the opentelemetry library ide -- `OTEL_RESOURCE_ATTRIBUTES` sets a comma separated list of custom resource attributes -## Collector opentelemetry-client-ocurl +## opentelemetry-client-ocurl -This is a synchronous collector that uses the http+protobuf format -to send signals (metrics, traces, logs) to some other collector (eg. `otelcol` +This is a synchronous exporter that uses the http+protobuf format +to send signals (metrics, traces, logs) to some collector (eg. `otelcol` or the datadog agent). -Do note that this backend uses a thread pool and is incompatible +Do note that it uses a thread pool and is incompatible with uses of `fork` on some Unixy systems. See [#68](https://github.com/imandra-ai/ocaml-opentelemetry/issues/68) for a possible workaround. -## Collector opentelemetry-client-cohttp-lwt +## opentelemetry-client-cohttp-lwt -This is a Lwt-friendly collector that uses cohttp to send -signals to some other collector (e.g. `otelcol`). It must be run +This is a Lwt-friendly exporter that uses cohttp to send +signals to some collector (e.g. `otelcol`). It must be run inside a `Lwt_main.run` scope. ## Opentelemetry-trace diff --git a/deps/Makefile.ci b/deps/Makefile.ci new file mode 100644 index 000000000..4b6391989 --- /dev/null +++ b/deps/Makefile.ci @@ -0,0 +1,44 @@ +# CI Docker images — included by top-level Makefile +CI_REGISTRY = ghcr.io/ocaml-tracing/ocaml-opentelemetry +CI_VERSIONS = 4.08 4.14 5.4 +# To update: curl -s https://api.github.com/repos/ocaml/opam-repository/commits/master | jq -r .sha +OPAM_REPO_COMMIT ?= 67472cd54293d750a62d6d4423024d55f77268b0 +CI_BASE_OS_PACKAGES = pkg-config libcurl4-openssl-dev libgmp-dev mccs + +CI_COMMON_PACKAGES = ptime hmap pbrt pbrt_yojson ambient-context mtime \ + thread-local-storage lwt_ppx ambient-context-lwt \ + cohttp cohttp-lwt cohttp-lwt-unix \ + ezcurl ezcurl-lwt ocurl logs alcotest containers \ + trace ocaml-protoc + +CI_PACKAGES_408 = $(CI_COMMON_PACKAGES) lwt.5.9.2 +CI_PACKAGES_414 = $(CI_COMMON_PACKAGES) lwt.5.9.2 ocamlformat.0.27.0 +CI_PACKAGES_54 = $(CI_COMMON_PACKAGES) lwt.6.1.1 \ + ambient-context-eio cohttp-eio tls-eio ca-certs mirage-crypto-rng eio_main odig + +CI_BUILD = docker build -f deps/dockerfile.ocaml \ + --build-arg OPAM_REPO_COMMIT=$(OPAM_REPO_COMMIT) \ + --build-arg "BASE_OS_PACKAGES=$(CI_BASE_OS_PACKAGES)" + +build-ci-docker: + $(CI_BUILD) --build-arg OCAML_VERSION=4.08.1 --build-arg "BASE_PACKAGES=$(CI_PACKAGES_408)" -t $(CI_REGISTRY)/ci-4.08:latest . + $(CI_BUILD) --build-arg OCAML_VERSION=4.14.2 --build-arg "BASE_PACKAGES=$(CI_PACKAGES_414)" -t $(CI_REGISTRY)/ci-4.14:latest . + $(CI_BUILD) --build-arg OCAML_VERSION=5.4.1 --build-arg "BASE_PACKAGES=$(CI_PACKAGES_54)" -t $(CI_REGISTRY)/ci-5.4:latest . + +CI_NON_EIO_PACKAGES = opentelemetry,opentelemetry-client,opentelemetry-lwt,opentelemetry-cohttp-lwt,opentelemetry-client-ocurl,opentelemetry-client-ocurl-lwt,opentelemetry-client-cohttp-lwt,opentelemetry-logs +CI_RUN = docker run --pull=never --rm -t -v $(PWD):/src:z -w /src + +run-ci: + @for v in $(CI_VERSIONS); do \ + echo "=== OCaml $$v ===" ; \ + $(CI_RUN) $(CI_REGISTRY)/ci-$$v:latest \ + sh -c "opam exec -- dune build @install -p $(CI_NON_EIO_PACKAGES) && opam exec -- dune build @runtest" \ + || exit 1 ; \ + done + $(CI_RUN) $(CI_REGISTRY)/ci-5.4:latest \ + opam exec -- dune build @install -p opentelemetry-client-cohttp-eio + +upload-ci-docker: + @for v in $(CI_VERSIONS); do \ + docker push $(CI_REGISTRY)/ci-$$v:latest ; \ + done || ( echo "to login: docker login ghcr.io -u " ; exit 1 ) diff --git a/deps/dockerfile.ocaml b/deps/dockerfile.ocaml new file mode 100644 index 000000000..de148fdf5 --- /dev/null +++ b/deps/dockerfile.ocaml @@ -0,0 +1,40 @@ +ARG BASE_OS=ubuntu:24.04 + +# --- Stage 1: base (shared, no OCaml) --- +FROM $BASE_OS AS base +ARG BASE_OS_PACKAGES="" +ENV OPAMROOTISOK=1 OPAMYES=1 OPAMCONFIRMLEVEL=unsafe-yes +RUN --mount=type=cache,target=/var/cache/apt,sharing=locked \ + --mount=type=cache,target=/var/lib/apt,sharing=locked \ + rm -f /etc/apt/apt.conf.d/docker-clean && \ + apt-get update && \ + apt-get install -y --no-install-recommends ca-certificates curl git unzip build-essential netbase $BASE_OS_PACKAGES +RUN curl -fsSL https://github.com/ocaml/opam/releases/download/2.5.0/opam-2.5.0-x86_64-linux -o /usr/local/bin/opam && \ + chmod +x /usr/local/bin/opam && \ + git config --system --add safe.directory '*' +WORKDIR /root/w + +# --- Stage 2: opam-setup (builds the switch, discarded) --- +FROM base AS opam-setup +ARG OCAML_VERSION +ARG OPAM_REPO_COMMIT=master +ARG BASE_PACKAGES="" + +RUN git init /tmp/opam-repo && cd /tmp/opam-repo && \ + git remote add origin https://github.com/ocaml/opam-repository.git && \ + git fetch --depth 1 origin $OPAM_REPO_COMMIT && \ + git checkout FETCH_HEAD + +RUN opam init --disable-sandboxing --bare --no-setup -k local /tmp/opam-repo && \ + opam switch create /root/w --packages=ocaml-base-compiler.$OCAML_VERSION + +RUN opam install --no-depexts $BASE_PACKAGES && \ + opam clean -a -y && \ + rm -rf /tmp/opam-repo + +# --- Stage 3: final image (base + switch only) --- +FROM base +COPY --from=opam-setup /root/.opam /root/.opam +COPY --from=opam-setup /root/w/_opam /root/w/_opam +ENV OPAMROOT=/root/.opam OPAMSWITCH=/root/w PATH=/root/w/_opam/bin:$PATH +WORKDIR /root/w diff --git a/doc/migration_guide_v0.90.md b/doc/migration_guide_v0.90.md new file mode 100644 index 000000000..0e367cb06 --- /dev/null +++ b/doc/migration_guide_v0.90.md @@ -0,0 +1,271 @@ +# Migration guide: v0.13 → v0.90 + +This guide covers breaking changes when upgrading from v0.13. + +## 1. Backend setup: `Collector` → `Sdk` + `Exporter` + +v0.13 used a first-class module `BACKEND` installed into a global slot via +`Collector.set_backend`. v0.90 replaces this with a plain record `Exporter.t` +installed via `Sdk.set`. + +The `with_setup` helper in each client library still exists, so if you use that +you mainly need to rename the module. + +```ocaml +(* v0.13 *) +Opentelemetry_client_ocurl.with_setup ~config () (fun () -> + (* your code *) + ()) + +(* v0.90: same call, internals changed; ~stop removed, ~after_shutdown added *) +Opentelemetry_client_ocurl.with_setup + ~after_shutdown:(fun _exp -> ()) + ~config () (fun () -> + (* your code *) + ()) +``` + +If you called `setup`/`remove_backend` manually: + +```ocaml +(* v0.13 *) +Opentelemetry_client_ocurl.setup ~config () +(* ... *) +Opentelemetry_client_ocurl.remove_backend () + +(* v0.90 *) +Opentelemetry_client_ocurl.setup ~config () +(* ... *) +Opentelemetry_client_ocurl.remove_exporter () +``` + +The `~stop:bool Atomic.t` parameter has been removed from the ocurl client. +Use `Sdk.active ()` (an `Aswitch.t`) to detect shutdown instead. + +## 2. `Trace.with_` → `Tracer.with_`, callback gets a `Span.t` + +The most common migration. The module is renamed and the callback argument type +changes from `Scope.t` to `Span.t`. + +```ocaml +(* v0.13 *) +Trace.with_ "my-op" ~attrs:["k", `String "v"] (fun (scope : Scope.t) -> + Scope.add_event scope (fun () -> Event.make "something happened"); + Scope.add_attrs scope (fun () -> ["extra", `Int 42]); + do_work () +) + +(* v0.90 *) +Tracer.with_ "my-op" ~attrs:["k", `String "v"] (fun (span : Span.t) -> + Span.add_event span (Event.make "something happened"); + Span.add_attrs span ["extra", `Int 42]; + do_work () +) +``` + +`Trace` is kept as a deprecated alias for `Tracer`. + +Key differences on the callback argument: + +| v0.13 (`Scope.t`) | v0.90 (`Span.t`) | +|--------------------------------------------|--------------------------------------| +| `scope.trace_id` | `Span.trace_id span` | +| `scope.span_id` | `Span.id span` | +| `Scope.add_event scope (fun () -> ev)` | `Span.add_event span ev` | +| `Scope.add_attrs scope (fun () -> attrs)` | `Span.add_attrs span attrs` | +| `Scope.set_status scope st` | `Span.set_status span st` | +| `Scope.record_exception scope e bt` | `Span.record_exception span e bt` | +| `Scope.to_span_ctx scope` | `Span.to_span_ctx span` | +| `Scope.to_span_link scope` | `Span.to_span_link span` | +| `~scope:scope` (pass parent explicitly) | `~parent:span` | + +The `~scope` parameter of `Trace.with_` is renamed to `~parent`: + +```ocaml +(* v0.13 *) +Trace.with_ "child" ~scope:parent_scope (fun child -> ...) + +(* v0.90 *) +Tracer.with_ "child" ~parent:parent_span (fun child -> ...) +``` + +In addition, `Scope.t` is entirely removed because `Span.t` is now mutable. +For additional efficiency, `Span.t` is directly encodable to protobuf +without the need to allocate further intermediate structures. + +## 3. `Logs` → `Logger`, new emit helpers + +The `Logs` module is renamed to `Logger` (`Logs` is kept as a deprecated alias). +Direct construction of log records and batch-emit is replaced by convenience +functions. + +```ocaml +(* v0.13 *) +Logs.emit [ + Logs.make_str ~severity:Severity_number_warn "something went wrong" +] + +Logs.emit [ + Logs.make_strf ~severity:Severity_number_info "processed %d items" n +] + +(* v0.90: simple string *) +Logger.log ~severity:Severity_number_warn "something went wrong" + +(* v0.90: formatted *) +Logger.logf ~severity:Severity_number_info (fun k -> k "processed %d items" n) +``` + +If you need to keep the trace/span correlation: + +```ocaml +(* v0.13 *) +Logs.emit [ + Logs.make_str ~trace_id ~span_id ~severity:Severity_number_info "ok" +] + +(* v0.90 *) +Logger.log ~trace_id ~span_id ~severity:Severity_number_info "ok" +``` + +`Log_record.make_str` / `Log_record.make` still exist if you need to build +records manually and emit them via a `Logger.t`. + +## 4. `Metrics.emit` → emit via a `Meter` + +In v0.13 `Metrics.emit` was a top-level function that sent directly to the +collector. In v0.90 metrics go through a `Meter.t`. For most code the change +is mechanical: + +```ocaml +(* v0.13 *) +Metrics.emit [ + Metrics.gauge ~name:"queue.depth" [ Metrics.int ~now depth ] +] + +(* v0.90: Meter.default emits to the global provider *) +Meter.emit1 Meter.default + (Metrics.gauge ~name:"queue.depth" [ Metrics.int ~now depth ]) +``` + +`now` is now obtained from the meter's clock rather than `Timestamp_ns.now_unix_ns ()`: + +```ocaml +(* v0.13 *) +let now = Timestamp_ns.now_unix_ns () in +Metrics.emit [ Metrics.sum ~name:"counter" [ Metrics.int ~now n ] ] + +(* v0.90 *) +let now = Clock.now Meter.default.clock in +Meter.emit1 Meter.default + (Metrics.sum ~name:"counter" [ Metrics.int ~now n ]) +``` + +## 5. `Metrics_callbacks.register` → `Meter.add_cb` + +```ocaml +(* v0.13 *) +Metrics_callbacks.register (fun () -> + [ Metrics.gauge ~name:"foo" [ Metrics.int ~now:... 42 ] ]) + +(* v0.90: callback now receives a clock *) +Meter.add_cb (fun ~clock () -> + let now = Clock.now clock in + [ Metrics.gauge ~name:"foo" [ Metrics.int ~now 42 ] ]) +``` + +After registering callbacks you must tell the SDK to drive them: + +```ocaml +(* v0.90: call once after setup to schedule periodic emission *) +Meter.add_to_main_exporter Meter.default +``` + +In v0.13 this was automatic once `Metrics_callbacks.register` was called. + +## 6. `GC_metrics.basic_setup` signature unchanged, `setup` changed + +`GC_metrics.basic_setup ()` still works. The module has been renamed +to `Gc_metrics`, but the former name persists as a deprecated alias. + +If you called the lower-level `GC_metrics.setup exp` directly: + +```ocaml +(* v0.13 *) +GC_metrics.setup exporter +(* or *) +GC_metrics.setup_on_main_exporter () + +(* v0.90 *) +Gc_metrics.setup () (* uses Meter.default *) +(* or with a specific meter: *) +Gc_metrics.setup ~meter:my_meter () +``` + +`GC_metrics.setup_on_main_exporter` has been removed. + +## 7. `Collector.on_tick` → `Sdk.add_on_tick_callback` + +```ocaml +(* v0.13 *) +Collector.on_tick (fun () -> do_background_work ()) + +(* v0.90 *) +Sdk.add_on_tick_callback (fun () -> do_background_work ()) +``` + +## 8. `?service_name` parameter removed + +`Trace.with_`, `Logs.emit`, and `Metrics.emit` accepted a `?service_name` +override. This is no longer supported per-call; set it once globally: + +```ocaml +(* v0.13 *) +Trace.with_ "op" ~service_name:"my-svc" (fun _ -> ...) + +(* v0.90: set globally before setup *) +Opentelemetry.Globals.service_name := "my-svc" +Tracer.with_ "op" (fun _ -> ...) +``` + +## 9. `create_backend` / `BACKEND` module type removed + +If you held a reference to a backend module: + +```ocaml +(* v0.13 *) +let (module B : Collector.BACKEND) = + Opentelemetry_client_ocurl.create_backend ~config () +in +Collector.set_backend (module B) + +(* v0.90 *) +let exp : Exporter.t = + Opentelemetry_client_ocurl.create_exporter ~config () +in +Sdk.set exp +``` + +## 10. New features (no migration needed) + +- **`Sdk.get_tracer/get_meter/get_logger`**: obtain a provider pre-stamped with + instrumentation-scope metadata (`~name`, `~version`, `~__MODULE__`). +- **`Trace_provider` / `Meter_provider` / `Log_provider`**: independent + per-signal providers; useful for testing or multi-backend setups. +- **`Dynamic_enricher`**: register callbacks that inject attributes into every + span and log record at creation time (wide events). +- **Batch**: much better handling of batching overall. + +## Quick checklist + +- [ ] `Otel.Trace.with_` → `Otel.Tracer.with_`; callback argument `Scope.t` → `Span.t` +- [ ] `Scope.add_event`/`add_attrs` → `Span.add_event`/`add_attrs` (no thunk wrapper) +- [ ] `~scope:` → `~parent:` in nested `with_` calls +- [ ] `Logs.emit [Logs.make_str ...]` → `Logger.log`/`Logger.logf` +- [ ] `Metrics.emit [...]` → `Meter.emit1 Meter.default ...` +- [ ] `Metrics_callbacks.register` → `Meter.add_cb` (+ call `Meter.add_to_main_exporter`) +- [ ] `GC_metrics.setup exp` → `Gc_metrics.setup ()` +- [ ] `Collector.on_tick` → `Sdk.add_on_tick_callback` +- [ ] Remove `?service_name` call-site overrides; set `Globals.service_name` once +- [ ] `create_backend` → `create_exporter`; `set_backend` → `Sdk.set` +- [ ] `~stop:bool Atomic.t` removed from ocurl client diff --git a/dune b/dune index c37d0f248..92928949a 100644 --- a/dune +++ b/dune @@ -5,5 +5,5 @@ -warn-error -a+8 -w - +a-4-30-40-41-42-44-48-70 + +a-4-30-40-41-42-44-48-58-70 -strict-sequence))) diff --git a/dune-project b/dune-project index 76dfac94c..f336d6430 100644 --- a/dune-project +++ b/dune-project @@ -1,20 +1,21 @@ -(lang dune 2.9) +(lang dune 3.11) (name opentelemetry) (generate_opam_files true) (source - (github imandra-ai/ocaml-opentelemetry)) + (github ocaml-tracing/ocaml-opentelemetry)) -(version 0.12) +(version 0.91.1) -(authors "the Imandra team and contributors") +(implicit_transitive_deps false) -(maintainers - "Simon Cruanes " - "Matt Bray " - "ELLIOTTCABLE ") +(authors "ocaml-tracing" + "ELLIOTTCABLE " + "the imandra team") + +(maintainers "ocaml-tracing") (license MIT) @@ -22,23 +23,24 @@ (package (name opentelemetry) - (synopsis "Instrumentation for https://opentelemetry.io") + (synopsis "Core library for instrumentation and serialization for https://opentelemetry.io") (depends (ocaml (>= "4.08")) ptime hmap - atomic - (thread-local-storage - (and - (>= 0.2) - (< 0.3))) (odoc :with-doc) (alcotest :with-test) (pbrt (and - (>= 3.0) - (< 4.0))) + (>= 4.0) + (< 5.0))) + (pbrt_yojson + (and + (>= 4.0) + (< 5.0))) + (ambient-context + (>= 0.2)) (ocaml-lsp-server :with-dev-setup) (ocamlformat (and @@ -46,14 +48,29 @@ (>= 0.27) (< 0.28))) (mtime - (>= "1.4"))) - (depopts trace lwt eio) + (>= "1.4"))) + (depopts atomic trace thread-local-storage lwt eio picos) (conflicts (trace - (< 0.10))) + (< 0.12))) (tags (instrumentation tracing opentelemetry datadog jaeger))) +(package + (name opentelemetry-client) + (synopsis "Client SDK for https://opentelemetry.io") + (depends + (opentelemetry + (= :version)) + (odoc :with-doc) + (alcotest :with-test) + (thread-local-storage + (and + (>= 0.2) + (< 0.3)))) + (tags + (tracing opentelemetry sdk))) + (package (name opentelemetry-lwt) (synopsis "Lwt-compatible instrumentation for https://opentelemetry.io") @@ -62,6 +79,7 @@ (>= "4.08")) (opentelemetry (= :version)) + ambient-context-lwt (cohttp-lwt-unix :with-test) (odoc :with-doc) (lwt @@ -76,20 +94,51 @@ (name opentelemetry-client-ocurl) (depends (ocaml - (>= "4.08")) + (>= "4.11")) (mtime (>= "1.4")) ; for spans ; atomic ; vendored (opentelemetry (= :version)) + (opentelemetry-client + (= :version)) (odoc :with-doc) (ezcurl (>= 0.2.3)) - ocurl - (alcotest :with-test)) + curl + (alcotest :with-test) + (cohttp-lwt-unix :with-test) + (containers :with-test) + (logs :with-test)) (synopsis "Collector client for opentelemetry, using http + ezcurl")) +(package + (name opentelemetry-client-ocurl-lwt) + (depends + (ocaml + (>= "4.11")) + (mtime + (>= "1.4")) + (opentelemetry + (= :version)) + (opentelemetry-client + (= :version)) + (odoc :with-doc) + (ezcurl-lwt + (>= 0.2.3)) + ocurl + (lwt + (>= "5.7.3")) + (lwt_ppx + (>= "2.0")) + ambient-context-lwt + (alcotest :with-test) + (cohttp-lwt-unix :with-test) + (containers :with-test) + (logs :with-test)) + (synopsis "Collector client for opentelemetry, using ezcurl-lwt")) + (package (name opentelemetry-logs) (depends @@ -104,10 +153,14 @@ (containers :with-test) (cohttp-lwt-unix :with-test) (opentelemetry-client-cohttp-lwt - (and :with-test (= :version))) + (and + :with-test + (= :version))) (opentelemetry-cohttp-lwt - (and :with-test (= :version)))) - (synopsis "Opentelemetry tracing for Cohttp HTTP servers")) + (and + :with-test + (= :version)))) + (synopsis "Opentelemetry-based reporter for Logs")) (package (name opentelemetry-cohttp-lwt) @@ -118,9 +171,12 @@ (= :version)) (opentelemetry-lwt (= :version)) + ambient-context-lwt (odoc :with-doc) (lwt (>= "5.3")) + (cohttp + (>= "6.0.0")) (cohttp-lwt (>= "6.0.0")) (alcotest :with-test)) @@ -136,6 +192,11 @@ ; for spans (opentelemetry (= :version)) + (opentelemetry-client + (= :version)) + (opentelemetry-lwt + (= :version)) + ambient-context-lwt (odoc :with-doc) (lwt (>= "5.3")) @@ -144,8 +205,7 @@ cohttp-lwt cohttp-lwt-unix (alcotest :with-test) - (containers :with-test) - (opentelemetry-lwt (and :with-test (= :version)))) + (containers :with-test)) (synopsis "Collector client for opentelemetry, using cohttp + lwt")) (package @@ -156,9 +216,12 @@ (mtime (>= "1.4")) ca-certs - mirage-crypto-rng-eio + mirage-crypto-rng + ambient-context-eio (opentelemetry (= :version)) + (opentelemetry-client + (= :version)) (odoc :with-doc) (cohttp-eio (>= 6.1.0)) @@ -167,5 +230,10 @@ (>= 2.0.1)) (alcotest :with-test) (containers :with-test) - (cohttp-lwt-unix :with-test)) + (cohttp-lwt-unix :with-test) + (logs :with-test) + (opentelemetry-lwt + (and + :with-test + (= :version)))) (synopsis "Collector client for opentelemetry, using cohttp + eio")) diff --git a/emit1_ocurl_lwt.sh b/emit1_ocurl_lwt.sh new file mode 100755 index 000000000..13b9be902 --- /dev/null +++ b/emit1_ocurl_lwt.sh @@ -0,0 +1,2 @@ +#!/bin/sh +exec dune exec --profile=release tests/bin/emit1_ocurl_lwt.exe -- $@ diff --git a/emit1_stdout.sh b/emit1_stdout.sh new file mode 100755 index 000000000..b47300d6d --- /dev/null +++ b/emit1_stdout.sh @@ -0,0 +1,2 @@ +#!/bin/sh +exec dune exec --profile=release tests/bin/emit1_stdout.exe -- $@ diff --git a/flake.lock b/flake.lock index eb585b9b4..de3aced13 100644 --- a/flake.lock +++ b/flake.lock @@ -95,11 +95,11 @@ "opam2json": "opam2json" }, "locked": { - "lastModified": 1753007101, - "narHash": "sha256-YYdS644zHwmyBY0RYdrhO05uT3xauqJ5Ww1KtN9Q3Z4=", + "lastModified": 1762273592, + "narHash": "sha256-dXex1fPdmzj4xKWEWrcvbgin/iLFaxrt9vi305m6nUc=", "owner": "tweag", "repo": "opam-nix", - "rev": "03dd8b2577c05c42dc9e319d290f2dbfc67ab38b", + "rev": "98ca8f4401e996aeac38b6f14bf3a82d85b7add7", "type": "github" }, "original": { @@ -127,11 +127,11 @@ "opam-repository": { "flake": false, "locked": { - "lastModified": 1751808506, - "narHash": "sha256-H0WN/VhgaI6GLYmLAThoRcsf4XwnMNEBsz/w8FbLSrU=", + "lastModified": 1759971927, + "narHash": "sha256-aUZWd0KOpEnioBwqlwRU40rUFAqT3RTlojXt2oI3omY=", "owner": "ocaml", "repo": "opam-repository", - "rev": "bd82a8dde3f816d8b45ecbe005ac1f8e7f25c207", + "rev": "551314ad1550478ec6be39bb0eaadd2569190464", "type": "github" }, "original": { diff --git a/opentelemetry-client-cohttp-eio.opam b/opentelemetry-client-cohttp-eio.opam index b19ae6b5c..751581a5e 100644 --- a/opentelemetry-client-cohttp-eio.opam +++ b/opentelemetry-client-cohttp-eio.opam @@ -1,23 +1,21 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "0.12" +version: "0.91.1" synopsis: "Collector client for opentelemetry, using cohttp + eio" -maintainer: [ - "Simon Cruanes " - "Matt Bray " - "ELLIOTTCABLE " -] -authors: ["the Imandra team and contributors"] +maintainer: ["ocaml-tracing"] +authors: ["ocaml-tracing" "ELLIOTTCABLE " "the imandra team"] license: "MIT" -homepage: "https://github.com/imandra-ai/ocaml-opentelemetry" -bug-reports: "https://github.com/imandra-ai/ocaml-opentelemetry/issues" +homepage: "https://github.com/ocaml-tracing/ocaml-opentelemetry" +bug-reports: "https://github.com/ocaml-tracing/ocaml-opentelemetry/issues" depends: [ - "dune" {>= "2.9"} + "dune" {>= "3.11"} "ocaml" {>= "5.00"} "mtime" {>= "1.4"} "ca-certs" - "mirage-crypto-rng-eio" + "mirage-crypto-rng" + "ambient-context-eio" "opentelemetry" {= version} + "opentelemetry-client" {= version} "odoc" {with-doc} "cohttp-eio" {>= "6.1.0"} "eio_main" {with-test} @@ -25,6 +23,8 @@ depends: [ "alcotest" {with-test} "containers" {with-test} "cohttp-lwt-unix" {with-test} + "logs" {with-test} + "opentelemetry-lwt" {with-test & = version} ] build: [ ["dune" "subst"] {dev} @@ -35,11 +35,9 @@ build: [ name "-j" jobs - "--promote-install-files=false" "@install" "@runtest" {with-test} "@doc" {with-doc} ] - ["dune" "install" "-p" name "--create-install-files" name] ] -dev-repo: "git+https://github.com/imandra-ai/ocaml-opentelemetry.git" +dev-repo: "git+https://github.com/ocaml-tracing/ocaml-opentelemetry.git" diff --git a/opentelemetry-client-cohttp-lwt.opam b/opentelemetry-client-cohttp-lwt.opam index a486137f3..9b519475a 100644 --- a/opentelemetry-client-cohttp-lwt.opam +++ b/opentelemetry-client-cohttp-lwt.opam @@ -1,21 +1,20 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "0.12" +version: "0.91.1" synopsis: "Collector client for opentelemetry, using cohttp + lwt" -maintainer: [ - "Simon Cruanes " - "Matt Bray " - "ELLIOTTCABLE " -] -authors: ["the Imandra team and contributors"] +maintainer: ["ocaml-tracing"] +authors: ["ocaml-tracing" "ELLIOTTCABLE " "the imandra team"] license: "MIT" -homepage: "https://github.com/imandra-ai/ocaml-opentelemetry" -bug-reports: "https://github.com/imandra-ai/ocaml-opentelemetry/issues" +homepage: "https://github.com/ocaml-tracing/ocaml-opentelemetry" +bug-reports: "https://github.com/ocaml-tracing/ocaml-opentelemetry/issues" depends: [ - "dune" {>= "2.9"} + "dune" {>= "3.11"} "ocaml" {>= "4.08"} "mtime" {>= "1.4"} "opentelemetry" {= version} + "opentelemetry-client" {= version} + "opentelemetry-lwt" {= version} + "ambient-context-lwt" "odoc" {with-doc} "lwt" {>= "5.3"} "lwt_ppx" {>= "2.0"} @@ -23,7 +22,6 @@ depends: [ "cohttp-lwt-unix" "alcotest" {with-test} "containers" {with-test} - "opentelemetry-lwt" {with-test & = version} ] build: [ ["dune" "subst"] {dev} @@ -34,11 +32,9 @@ build: [ name "-j" jobs - "--promote-install-files=false" "@install" "@runtest" {with-test} "@doc" {with-doc} ] - ["dune" "install" "-p" name "--create-install-files" name] ] -dev-repo: "git+https://github.com/imandra-ai/ocaml-opentelemetry.git" +dev-repo: "git+https://github.com/ocaml-tracing/ocaml-opentelemetry.git" diff --git a/opentelemetry-client-ocurl-lwt.opam b/opentelemetry-client-ocurl-lwt.opam new file mode 100644 index 000000000..f8a3080a4 --- /dev/null +++ b/opentelemetry-client-ocurl-lwt.opam @@ -0,0 +1,41 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "0.91.1" +synopsis: "Collector client for opentelemetry, using ezcurl-lwt" +maintainer: ["ocaml-tracing"] +authors: ["ocaml-tracing" "ELLIOTTCABLE " "the imandra team"] +license: "MIT" +homepage: "https://github.com/ocaml-tracing/ocaml-opentelemetry" +bug-reports: "https://github.com/ocaml-tracing/ocaml-opentelemetry/issues" +depends: [ + "dune" {>= "3.11"} + "ocaml" {>= "4.11"} + "mtime" {>= "1.4"} + "opentelemetry" {= version} + "opentelemetry-client" {= version} + "odoc" {with-doc} + "ezcurl-lwt" {>= "0.2.3"} + "ocurl" + "lwt" {>= "5.7.3"} + "lwt_ppx" {>= "2.0"} + "ambient-context-lwt" + "alcotest" {with-test} + "cohttp-lwt-unix" {with-test} + "containers" {with-test} + "logs" {with-test} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/ocaml-tracing/ocaml-opentelemetry.git" diff --git a/opentelemetry-client-ocurl.opam b/opentelemetry-client-ocurl.opam index de605919d..cb80570a2 100644 --- a/opentelemetry-client-ocurl.opam +++ b/opentelemetry-client-ocurl.opam @@ -1,25 +1,25 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "0.12" +version: "0.91.1" synopsis: "Collector client for opentelemetry, using http + ezcurl" -maintainer: [ - "Simon Cruanes " - "Matt Bray " - "ELLIOTTCABLE " -] -authors: ["the Imandra team and contributors"] +maintainer: ["ocaml-tracing"] +authors: ["ocaml-tracing" "ELLIOTTCABLE " "the imandra team"] license: "MIT" -homepage: "https://github.com/imandra-ai/ocaml-opentelemetry" -bug-reports: "https://github.com/imandra-ai/ocaml-opentelemetry/issues" +homepage: "https://github.com/ocaml-tracing/ocaml-opentelemetry" +bug-reports: "https://github.com/ocaml-tracing/ocaml-opentelemetry/issues" depends: [ - "dune" {>= "2.9"} - "ocaml" {>= "4.08"} + "dune" {>= "3.11"} + "ocaml" {>= "4.11"} "mtime" {>= "1.4"} "opentelemetry" {= version} + "opentelemetry-client" {= version} "odoc" {with-doc} "ezcurl" {>= "0.2.3"} - "ocurl" + "curl" "alcotest" {with-test} + "cohttp-lwt-unix" {with-test} + "containers" {with-test} + "logs" {with-test} ] build: [ ["dune" "subst"] {dev} @@ -30,11 +30,9 @@ build: [ name "-j" jobs - "--promote-install-files=false" "@install" "@runtest" {with-test} "@doc" {with-doc} ] - ["dune" "install" "-p" name "--create-install-files" name] ] -dev-repo: "git+https://github.com/imandra-ai/ocaml-opentelemetry.git" +dev-repo: "git+https://github.com/ocaml-tracing/ocaml-opentelemetry.git" diff --git a/opentelemetry-client.opam b/opentelemetry-client.opam new file mode 100644 index 000000000..f0e32f623 --- /dev/null +++ b/opentelemetry-client.opam @@ -0,0 +1,32 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "0.91.1" +synopsis: "Client SDK for https://opentelemetry.io" +maintainer: ["ocaml-tracing"] +authors: ["ocaml-tracing" "ELLIOTTCABLE " "the imandra team"] +license: "MIT" +tags: ["tracing" "opentelemetry" "sdk"] +homepage: "https://github.com/ocaml-tracing/ocaml-opentelemetry" +bug-reports: "https://github.com/ocaml-tracing/ocaml-opentelemetry/issues" +depends: [ + "dune" {>= "3.11"} + "opentelemetry" {= version} + "odoc" {with-doc} + "alcotest" {with-test} + "thread-local-storage" {>= "0.2" & < "0.3"} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/ocaml-tracing/ocaml-opentelemetry.git" diff --git a/opentelemetry-cohttp-lwt.opam b/opentelemetry-cohttp-lwt.opam index 67c89ed5e..09337550d 100644 --- a/opentelemetry-cohttp-lwt.opam +++ b/opentelemetry-cohttp-lwt.opam @@ -1,23 +1,21 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "0.12" +version: "0.91.1" synopsis: "Opentelemetry tracing for Cohttp HTTP servers" -maintainer: [ - "Simon Cruanes " - "Matt Bray " - "ELLIOTTCABLE " -] -authors: ["the Imandra team and contributors"] +maintainer: ["ocaml-tracing"] +authors: ["ocaml-tracing" "ELLIOTTCABLE " "the imandra team"] license: "MIT" -homepage: "https://github.com/imandra-ai/ocaml-opentelemetry" -bug-reports: "https://github.com/imandra-ai/ocaml-opentelemetry/issues" +homepage: "https://github.com/ocaml-tracing/ocaml-opentelemetry" +bug-reports: "https://github.com/ocaml-tracing/ocaml-opentelemetry/issues" depends: [ - "dune" {>= "2.9"} + "dune" {>= "3.11"} "ocaml" {>= "4.08"} "opentelemetry" {= version} "opentelemetry-lwt" {= version} + "ambient-context-lwt" "odoc" {with-doc} "lwt" {>= "5.3"} + "cohttp" {>= "6.0.0"} "cohttp-lwt" {>= "6.0.0"} "alcotest" {with-test} ] @@ -30,11 +28,9 @@ build: [ name "-j" jobs - "--promote-install-files=false" "@install" "@runtest" {with-test} "@doc" {with-doc} ] - ["dune" "install" "-p" name "--create-install-files" name] ] -dev-repo: "git+https://github.com/imandra-ai/ocaml-opentelemetry.git" +dev-repo: "git+https://github.com/ocaml-tracing/ocaml-opentelemetry.git" diff --git a/opentelemetry-logs.opam b/opentelemetry-logs.opam index f3a5c4ee6..07b09d6ae 100644 --- a/opentelemetry-logs.opam +++ b/opentelemetry-logs.opam @@ -1,18 +1,14 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "0.12" -synopsis: "Opentelemetry tracing for Cohttp HTTP servers" -maintainer: [ - "Simon Cruanes " - "Matt Bray " - "ELLIOTTCABLE " -] -authors: ["the Imandra team and contributors"] +version: "0.91.1" +synopsis: "Opentelemetry-based reporter for Logs" +maintainer: ["ocaml-tracing"] +authors: ["ocaml-tracing" "ELLIOTTCABLE " "the imandra team"] license: "MIT" -homepage: "https://github.com/imandra-ai/ocaml-opentelemetry" -bug-reports: "https://github.com/imandra-ai/ocaml-opentelemetry/issues" +homepage: "https://github.com/ocaml-tracing/ocaml-opentelemetry" +bug-reports: "https://github.com/ocaml-tracing/ocaml-opentelemetry/issues" depends: [ - "dune" {>= "2.9"} + "dune" {>= "3.11"} "ocaml" {>= "4.08"} "opentelemetry" {= version} "odoc" {with-doc} @@ -32,11 +28,9 @@ build: [ name "-j" jobs - "--promote-install-files=false" "@install" "@runtest" {with-test} "@doc" {with-doc} ] - ["dune" "install" "-p" name "--create-install-files" name] ] -dev-repo: "git+https://github.com/imandra-ai/ocaml-opentelemetry.git" +dev-repo: "git+https://github.com/ocaml-tracing/ocaml-opentelemetry.git" diff --git a/opentelemetry-lwt.opam b/opentelemetry-lwt.opam index 492464443..46ddf3f93 100644 --- a/opentelemetry-lwt.opam +++ b/opentelemetry-lwt.opam @@ -1,21 +1,18 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "0.12" +version: "0.91.1" synopsis: "Lwt-compatible instrumentation for https://opentelemetry.io" -maintainer: [ - "Simon Cruanes " - "Matt Bray " - "ELLIOTTCABLE " -] -authors: ["the Imandra team and contributors"] +maintainer: ["ocaml-tracing"] +authors: ["ocaml-tracing" "ELLIOTTCABLE " "the imandra team"] license: "MIT" tags: ["instrumentation" "tracing" "opentelemetry" "datadog" "lwt"] -homepage: "https://github.com/imandra-ai/ocaml-opentelemetry" -bug-reports: "https://github.com/imandra-ai/ocaml-opentelemetry/issues" +homepage: "https://github.com/ocaml-tracing/ocaml-opentelemetry" +bug-reports: "https://github.com/ocaml-tracing/ocaml-opentelemetry/issues" depends: [ - "dune" {>= "2.9"} + "dune" {>= "3.11"} "ocaml" {>= "4.08"} "opentelemetry" {= version} + "ambient-context-lwt" "cohttp-lwt-unix" {with-test} "odoc" {with-doc} "lwt" {>= "5.3"} @@ -31,11 +28,9 @@ build: [ name "-j" jobs - "--promote-install-files=false" "@install" "@runtest" {with-test} "@doc" {with-doc} ] - ["dune" "install" "-p" name "--create-install-files" name] ] -dev-repo: "git+https://github.com/imandra-ai/ocaml-opentelemetry.git" +dev-repo: "git+https://github.com/ocaml-tracing/ocaml-opentelemetry.git" diff --git a/opentelemetry.opam b/opentelemetry.opam index cdbdcf2e2..d9f1e542b 100644 --- a/opentelemetry.opam +++ b/opentelemetry.opam @@ -1,34 +1,31 @@ # This file is generated by dune, edit dune-project instead opam-version: "2.0" -version: "0.12" -synopsis: "Instrumentation for https://opentelemetry.io" -maintainer: [ - "Simon Cruanes " - "Matt Bray " - "ELLIOTTCABLE " -] -authors: ["the Imandra team and contributors"] +version: "0.91.1" +synopsis: + "Core library for instrumentation and serialization for https://opentelemetry.io" +maintainer: ["ocaml-tracing"] +authors: ["ocaml-tracing" "ELLIOTTCABLE " "the imandra team"] license: "MIT" tags: ["instrumentation" "tracing" "opentelemetry" "datadog" "jaeger"] -homepage: "https://github.com/imandra-ai/ocaml-opentelemetry" -bug-reports: "https://github.com/imandra-ai/ocaml-opentelemetry/issues" +homepage: "https://github.com/ocaml-tracing/ocaml-opentelemetry" +bug-reports: "https://github.com/ocaml-tracing/ocaml-opentelemetry/issues" depends: [ - "dune" {>= "2.9"} + "dune" {>= "3.11"} "ocaml" {>= "4.08"} "ptime" "hmap" - "atomic" - "thread-local-storage" {>= "0.2" & < "0.3"} "odoc" {with-doc} "alcotest" {with-test} - "pbrt" {>= "3.0" & < "4.0"} + "pbrt" {>= "4.0" & < "5.0"} + "pbrt_yojson" {>= "4.0" & < "5.0"} + "ambient-context" {>= "0.2"} "ocaml-lsp-server" {with-dev-setup} "ocamlformat" {with-dev-setup & >= "0.27" & < "0.28"} "mtime" {>= "1.4"} ] -depopts: ["trace" "lwt" "eio"] +depopts: ["atomic" "trace" "thread-local-storage" "lwt" "eio" "picos"] conflicts: [ - "trace" {< "0.10"} + "trace" {< "0.12"} ] build: [ ["dune" "subst"] {dev} @@ -39,11 +36,9 @@ build: [ name "-j" jobs - "--promote-install-files=false" "@install" "@runtest" {with-test} "@doc" {with-doc} ] - ["dune" "install" "-p" name "--create-install-files" name] ] -dev-repo: "git+https://github.com/imandra-ai/ocaml-opentelemetry.git" +dev-repo: "git+https://github.com/ocaml-tracing/ocaml-opentelemetry.git" diff --git a/src/ambient-context/dune b/src/ambient-context/dune index 68e7acf5f..7345afd0d 100644 --- a/src/ambient-context/dune +++ b/src/ambient-context/dune @@ -1,15 +1,7 @@ (library (name opentelemetry_ambient_context) (public_name opentelemetry.ambient-context) - (synopsis - "Abstraction over thread-local storage and fiber-local storage mechanisms") - (private_modules hmap_key_) + (synopsis "re-export ambient-context") (libraries - thread-local-storage - threads - atomic - opentelemetry.ambient-context.types - (select - hmap_key_.ml - from - (-> hmap_key_.new.ml)))) + (re_export ambient-context.core) + (re_export ambient-context))) diff --git a/src/ambient-context/eio/dune b/src/ambient-context/eio/dune deleted file mode 100644 index f3f76be73..000000000 --- a/src/ambient-context/eio/dune +++ /dev/null @@ -1,7 +0,0 @@ -(library - (name opentelemetry_ambient_context_eio) - (public_name opentelemetry.ambient-context.eio) - (synopsis - "Storage backend for ambient-context using Eio's fibre-local storage") - (optional) ; eio - (libraries eio hmap opentelemetry.ambient-context thread-local-storage)) diff --git a/src/ambient-context/eio/opentelemetry_ambient_context_eio.ml b/src/ambient-context/eio/opentelemetry_ambient_context_eio.ml deleted file mode 100644 index 56451a1af..000000000 --- a/src/ambient-context/eio/opentelemetry_ambient_context_eio.ml +++ /dev/null @@ -1,39 +0,0 @@ -module Fiber = Eio.Fiber - -open struct - let _internal_key : Hmap.t Fiber.key = Fiber.create_key () - - let ( let* ) = Option.bind -end - -module M = struct - let name = "Storage_eio" - - let[@inline] get_map () = Fiber.get _internal_key - - let[@inline] with_map m cb = Fiber.with_binding _internal_key m cb - - let create_key = Hmap.Key.create - - let get k = - let* context = get_map () in - Hmap.find k context - - let with_binding k v cb = - let new_context = - match get_map () with - | None -> Hmap.singleton k v - | Some old_context -> Hmap.add k v old_context - in - with_map new_context cb - - let without_binding k cb = - let new_context = - match get_map () with - | None -> Hmap.empty - | Some old_context -> Hmap.rem k old_context - in - with_map new_context cb -end - -let storage () : Opentelemetry_ambient_context.storage = (module M) diff --git a/src/ambient-context/eio/opentelemetry_ambient_context_eio.mli b/src/ambient-context/eio/opentelemetry_ambient_context_eio.mli deleted file mode 100644 index ac5cf8ba3..000000000 --- a/src/ambient-context/eio/opentelemetry_ambient_context_eio.mli +++ /dev/null @@ -1,2 +0,0 @@ -val storage : unit -> Opentelemetry_ambient_context.storage -(** Storage using Eio's fibers local storage *) diff --git a/src/ambient-context/hmap_key_.new.ml b/src/ambient-context/hmap_key_.new.ml deleted file mode 100644 index 1925b70e7..000000000 --- a/src/ambient-context/hmap_key_.new.ml +++ /dev/null @@ -1 +0,0 @@ -let key : Hmap.t Thread_local_storage.t = Thread_local_storage.create () diff --git a/src/ambient-context/lwt/dune b/src/ambient-context/lwt/dune deleted file mode 100644 index 68a9de156..000000000 --- a/src/ambient-context/lwt/dune +++ /dev/null @@ -1,7 +0,0 @@ -(library - (name opentelemetry_ambient_context_lwt) - (public_name opentelemetry.ambient-context.lwt) - (optional) ; lwt - (synopsis - "Storage backend for ambient-context using Lwt's sequence-associated storage") - (libraries lwt opentelemetry.ambient-context thread-local-storage)) diff --git a/src/ambient-context/lwt/opentelemetry_ambient_context_lwt.ml b/src/ambient-context/lwt/opentelemetry_ambient_context_lwt.ml deleted file mode 100644 index b75105f2e..000000000 --- a/src/ambient-context/lwt/opentelemetry_ambient_context_lwt.ml +++ /dev/null @@ -1,37 +0,0 @@ -open struct - let _internal_key : Hmap.t Lwt.key = Lwt.new_key () - - let ( let* ) = Option.bind -end - -module M = struct - let name = "Storage_lwt" - - let[@inline] get_map () = Lwt.get _internal_key - - let[@inline] with_map m cb = Lwt.with_value _internal_key (Some m) cb - - let create_key = Hmap.Key.create - - let get k = - let* context = get_map () in - Hmap.find k context - - let with_binding k v cb = - let new_context = - match get_map () with - | None -> Hmap.singleton k v - | Some old_context -> Hmap.add k v old_context - in - with_map new_context cb - - let without_binding k cb = - let new_context = - match get_map () with - | None -> Hmap.empty - | Some old_context -> Hmap.rem k old_context - in - with_map new_context cb -end - -let storage () : Opentelemetry_ambient_context.storage = (module M) diff --git a/src/ambient-context/lwt/opentelemetry_ambient_context_lwt.mli b/src/ambient-context/lwt/opentelemetry_ambient_context_lwt.mli deleted file mode 100644 index 3c462a8d1..000000000 --- a/src/ambient-context/lwt/opentelemetry_ambient_context_lwt.mli +++ /dev/null @@ -1,2 +0,0 @@ -val storage : unit -> Opentelemetry_ambient_context.storage -(** Storage using Lwt keys *) diff --git a/src/ambient-context/opentelemetry_ambient_context.ml b/src/ambient-context/opentelemetry_ambient_context.ml index 7c622eb74..421b70935 100644 --- a/src/ambient-context/opentelemetry_ambient_context.ml +++ b/src/ambient-context/opentelemetry_ambient_context.ml @@ -1,124 +1,3 @@ -module TLS = Thread_local_storage -include Opentelemetry_ambient_context_types +(** Just forward to the [ambient-context] library *) -type 'a key = int * 'a Hmap.key - -let debug = - match Sys.getenv_opt "OCAML_AMBIENT_CONTEXT_DEBUG" with - | Some ("1" | "true") -> true - | _ -> false - -let _debug_id_ = Atomic.make 0 - -let[@inline] generate_debug_id () = Atomic.fetch_and_add _debug_id_ 1 - -let compare_key : int -> int -> int = Stdlib.compare - -module Storage_tls_hmap = struct - let[@inline] ( let* ) o f = - match o with - | None -> None - | Some x -> f x - - let key : Hmap.t TLS.t = Hmap_key_.key - - let name = "Storage_tls" - - let[@inline] get_map () = TLS.get_opt key - - let[@inline] with_map m cb = - let old = TLS.get_opt key |> Option.value ~default:Hmap.empty in - TLS.set key m; - Fun.protect ~finally:(fun () -> TLS.set key old) cb - - let create_key = Hmap.Key.create - - let get k = - let* context = get_map () in - Hmap.find k context - - let with_binding k v cb = - let new_context = - match get_map () with - | None -> Hmap.singleton k v - | Some old_context -> Hmap.add k v old_context - in - with_map new_context @@ fun _context -> cb () - - let without_binding k cb = - match get_map () with - | None -> cb () - | Some old_context -> - let new_context = Hmap.rem k old_context in - with_map new_context @@ fun _context -> cb () -end - -let default_storage : storage = (module Storage_tls_hmap) - -let k_current_storage : storage TLS.t = TLS.create () - -let get_current_storage () = - match TLS.get_exn k_current_storage with - | v -> v - | exception TLS.Not_set -> - let v = default_storage in - TLS.set k_current_storage v; - v - -let create_key () = - let (module Store : STORAGE) = get_current_storage () in - if not debug then - 0, Store.create_key () - else ( - let id = generate_debug_id () in - Printf.printf "%s: create_key %i\n%!" Store.name id; - id, Store.create_key () - ) - -let get (id, k) = - let (module Store : STORAGE) = get_current_storage () in - if not debug then - Store.get k - else ( - let rv = Store.get k in - (match rv with - | Some _ -> Printf.printf "%s: get %i -> Some\n%!" Store.name id - | None -> Printf.printf "%s: get %i -> None\n%!" Store.name id); - rv - ) - -let with_binding : 'a key -> 'a -> (unit -> 'r) -> 'r = - fun (id, k) v cb -> - let (module Store : STORAGE) = get_current_storage () in - if not debug then - Store.with_binding k v cb - else ( - Printf.printf "%s: with_binding %i enter\n%!" Store.name id; - let rv = Store.with_binding k v cb in - Printf.printf "%s: with_binding %i exit\n%!" Store.name id; - rv - ) - -let without_binding (id, k) cb = - let (module Store : STORAGE) = get_current_storage () in - if not debug then - Store.without_binding k cb - else ( - Printf.printf "%s: without_binding %i enter\n%!" Store.name id; - let rv = Store.without_binding k cb in - Printf.printf "%s: without_binding %i exit\n%!" Store.name id; - rv - ) - -let set_storage_provider store_new = - let store_before = get_current_storage () in - if store_new == store_before then - () - else - TLS.set k_current_storage store_new; - if debug then ( - let (module Store_before : STORAGE) = store_before in - let (module Store_new : STORAGE) = store_new in - Printf.printf "set_storage_provider %s (previously %s)\n%!" Store_new.name - Store_before.name - ) +include Ambient_context diff --git a/src/ambient-context/opentelemetry_ambient_context.mli b/src/ambient-context/opentelemetry_ambient_context.mli deleted file mode 100644 index 8f19ff0cc..000000000 --- a/src/ambient-context/opentelemetry_ambient_context.mli +++ /dev/null @@ -1,55 +0,0 @@ -(** Ambient context. - - The ambient context, like the Matrix, is everywhere around you. - - It is responsible for keeping track of that context in a manner that's - consistent with the program's choice of control flow paradigm: - - - for synchronous/threaded/direct style code, {b TLS} ("thread local - storage") keeps track of a global variable per thread. Each thread has its - own copy of the variable and updates it independently of other threads. - - - for Lwt, any ['a Lwt.t] created inside the [with_binding k v (fun _ -> …)] - will inherit the [k := v] assignment. - - - for Eio, fibers created inside [with_binding k v (fun () -> …)] will - inherit the [k := v] assignment. This is consistent with the structured - concurrency approach of Eio. - - The only data stored by this storage is a {!Hmap.t}, ie a heterogeneous map. - Various users (libraries, user code, etc.) can create their own {!key} to - store what they are interested in, without affecting other parts of the - storage. *) - -module Types := Opentelemetry_ambient_context_types - -module type STORAGE = Types.STORAGE - -type storage = (module STORAGE) - -val default_storage : storage - -val get_current_storage : unit -> storage - -val set_storage_provider : storage -> unit - -type 'a key -(** A key that can be mapped to values of type ['a] in the ambient context. *) - -val compare_key : int -> int -> int -(** Total order on keys *) - -val create_key : unit -> 'a key -(** Create a new fresh key, distinct from any previously created key. *) - -val get : 'a key -> 'a option -(** Get the current value for a given key, or [None] if no value was associated - with the key in the ambient context. *) - -val with_binding : 'a key -> 'a -> (unit -> 'r) -> 'r -(** [with_binding k v cb] calls [cb()] in a context in which [k] is bound to - [v]. This does not affect storage outside of [cb()]. *) - -val without_binding : 'a key -> (unit -> 'b) -> 'b -(** [without_binding k cb] calls [cb()] in a context where [k] has no binding - (possibly shadowing the current ambient binding of [k] if it exists). *) diff --git a/src/ambient-context/types/dune b/src/ambient-context/types/dune deleted file mode 100644 index b9e4146c5..000000000 --- a/src/ambient-context/types/dune +++ /dev/null @@ -1,4 +0,0 @@ -(library - (name opentelemetry_ambient_context_types) - (public_name opentelemetry.ambient-context.types) - (libraries hmap thread-local-storage)) diff --git a/src/ambient-context/types/opentelemetry_ambient_context_types.ml b/src/ambient-context/types/opentelemetry_ambient_context_types.ml deleted file mode 100644 index 829f77899..000000000 --- a/src/ambient-context/types/opentelemetry_ambient_context_types.ml +++ /dev/null @@ -1,19 +0,0 @@ -type 'a key = 'a Hmap.key - -module type STORAGE = sig - val name : string - - val get_map : unit -> Hmap.t option - - val with_map : Hmap.t -> (unit -> 'b) -> 'b - - val create_key : unit -> 'a key - - val get : 'a key -> 'a option - - val with_binding : 'a key -> 'a -> (unit -> 'b) -> 'b - - val without_binding : 'a key -> (unit -> 'b) -> 'b -end - -type storage = (module STORAGE) diff --git a/src/ambient-context/types/opentelemetry_ambient_context_types.mli b/src/ambient-context/types/opentelemetry_ambient_context_types.mli deleted file mode 100644 index 738b7520d..000000000 --- a/src/ambient-context/types/opentelemetry_ambient_context_types.mli +++ /dev/null @@ -1,32 +0,0 @@ -(** Storage implementation. - - There is a singleton storage for a given program, responsible for providing - ambient context to the rest of the program. *) - -type 'a key = 'a Hmap.key - -module type STORAGE = sig - val name : string - (** Name of the storage implementation. *) - - val get_map : unit -> Hmap.t option - (** Get the hmap from the current ambient context, or [None] if there is no - ambient context. *) - - val with_map : Hmap.t -> (unit -> 'b) -> 'b - (** [with_hmap h cb] calls [cb()] in an ambient context in which [get_map()] - will return [h]. Once [cb()] returns, the storage is reset to its previous - value. *) - - val create_key : unit -> 'a key - (** Create a new storage key, guaranteed to be distinct from any previously - created key. *) - - val get : 'a key -> 'a option - - val with_binding : 'a key -> 'a -> (unit -> 'b) -> 'b - - val without_binding : 'a key -> (unit -> 'b) -> 'b -end - -type storage = (module STORAGE) diff --git a/src/client-cohttp-eio/config.ml b/src/client-cohttp-eio/config.ml index 930881ff4..ff3f0dfbd 100644 --- a/src/client-cohttp-eio/config.ml +++ b/src/client-cohttp-eio/config.ml @@ -1,7 +1,7 @@ -type t = Opentelemetry_client.Config.t +type t = Opentelemetry_client.Http_config.t -module Env = Opentelemetry_client.Config.Env () +module Env = Opentelemetry_client.Http_config.Env () -let pp = Opentelemetry_client.Config.pp +let pp = Opentelemetry_client.Http_config.pp let make = Env.make (fun common () -> common) diff --git a/src/client-cohttp-eio/config.mli b/src/client-cohttp-eio/config.mli index 100bb696b..624c866ed 100644 --- a/src/client-cohttp-eio/config.mli +++ b/src/client-cohttp-eio/config.mli @@ -1,4 +1,4 @@ -type t = Opentelemetry_client.Config.t +type t = Opentelemetry_client.Http_config.t (** Configuration. To build one, use {!make} below. This might be extended with more fields in @@ -6,7 +6,7 @@ type t = Opentelemetry_client.Config.t val pp : Format.formatter -> t -> unit -val make : (unit -> t) Opentelemetry_client.Config.make +val make : (unit -> t) Opentelemetry_client.Http_config.make (** Make a configuration {!t}. *) -module Env : Opentelemetry_client.Config.ENV +module Env : Opentelemetry_client.Http_config.ENV diff --git a/src/client-cohttp-eio/dune b/src/client-cohttp-eio/dune index 79cf93934..85488836b 100644 --- a/src/client-cohttp-eio/dune +++ b/src/client-cohttp-eio/dune @@ -5,15 +5,22 @@ (enabled_if (>= %{ocaml_version} 5.0)) (libraries - opentelemetry - opentelemetry.client - eio - eio.unix - cohttp - cohttp-eio - tls-eio + (re_export opentelemetry) + (re_export opentelemetry-client) + (re_export opentelemetry-client.sync) + ambient-context-eio + (re_export eio) + (re_export eio.core) + (re_export eio.unix) + (re_export cohttp) + (re_export cohttp-eio) + (re_export tls-eio) + fmt + tls + domain-name uri pbrt + threads mtime mtime.clock.os ca-certs diff --git a/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.ml b/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.ml index 189b341e0..180bdea57 100644 --- a/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.ml +++ b/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.ml @@ -1,478 +1,209 @@ -open Eio.Std - (* https://github.com/open-telemetry/oteps/blob/main/text/0035-opentelemetry-protocol.md https://github.com/open-telemetry/oteps/blob/main/text/0099-otlp-http.md *) -module OT = Opentelemetry module Config = Config -module Signal = Opentelemetry_client.Signal -module Batch = Opentelemetry_client.Batch open Opentelemetry - -let ( let@ ) = ( @@ ) +open Opentelemetry_client let spf = Printf.sprintf -let set_headers = Config.Env.set_headers +module Make (CTX : sig + val sw : Eio.Switch.t -let get_headers = Config.Env.get_headers + val env : Eio_unix.Stdenv.base +end) = +struct + module IO : Generic_io.S_WITH_CONCURRENCY with type 'a t = 'a = struct + include Generic_io.Direct_style -let needs_gc_metrics = Atomic.make false + (* NOTE: This is only used in the main consumer thread, even though producers + might be in other domains *) -let last_gc_metrics = Atomic.make (Mtime_clock.now ()) + let sleep_s n = Eio.Time.sleep CTX.env#clock n -let timeout_gc_metrics = Mtime.Span.(20 * s) + let spawn f = Eio.Fiber.fork ~sw:CTX.sw f + end -(* Cross-domain, thread-safe storage for GC metrics gathered from different fibres. *) -module GC_metrics : sig - val add : Proto.Metrics.resource_metrics -> unit + module Notifier : Generic_notifier.S with module IO = IO = struct + module IO = IO - val drain : unit -> Proto.Metrics.resource_metrics list -end = struct - (* Used to prevent data races across domains *) - let mutex = Eio.Mutex.create () + type t = { + mutex: Eio.Mutex.t; + cond: Eio.Condition.t; + } - let gc_metrics = ref [] + let create () : t = + { mutex = Eio.Mutex.create (); cond = Eio.Condition.create () } + + let trigger self = + (* Eio.Condition.broadcast is lock-free since eio 0.8 (ocaml-multicore/eio#397) + and safe to call from other threads/domains and signal handlers. *) + Eio.Condition.broadcast self.cond + + let delete self = + trigger self; + () + + let wait self ~should_keep_waiting = + Eio.Mutex.lock self.mutex; + while should_keep_waiting () do + Eio.Condition.await self.cond self.mutex + done; + Eio.Mutex.unlock self.mutex + + (** Ensure we get signalled when the queue goes from empty to non-empty *) + let register_bounded_queue (self : t) (bq : _ Bounded_queue.Recv.t) : unit = + Bounded_queue.Recv.on_non_empty bq (fun () -> trigger self) + end + + module Httpc : Generic_http_consumer.HTTPC with module IO = IO = struct + module IO = IO + open Opentelemetry.Proto + module Httpc = Cohttp_eio.Client + + type t = Httpc.t + + let authenticator = + match Ca_certs.authenticator () with + | Ok x -> x + | Error (`Msg m) -> + Fmt.failwith "Failed to create system store X509 authenticator: %s" m + + let https ~authenticator = + let tls_config = + match Tls.Config.client ~authenticator () with + | Error (`Msg msg) -> failwith ("tls configuration problem: " ^ msg) + | Ok tls_config -> tls_config + in + fun uri raw -> + let host = + Uri.host uri + |> Option.map (fun x -> Domain_name.(host_exn (of_string_exn x))) + in + Tls_eio.client_of_flow ?host tls_config raw - let add m = - Eio.Mutex.use_rw ~protect:true mutex (fun () -> - gc_metrics := m :: !gc_metrics) + let create () = Httpc.make ~https:(Some (https ~authenticator)) CTX.env#net - let drain () = - Eio.Mutex.use_rw ~protect:true mutex (fun () -> - let metrics = !gc_metrics in - gc_metrics := []; - metrics) -end + let cleanup = ignore -(* capture current GC metrics if {!needs_gc_metrics} is true, - or it has been a long time since the last GC metrics collection, - and push them into {!gc_metrics} for later collection *) -let sample_gc_metrics_if_needed () = - let now = Mtime_clock.now () in - let alarm = Atomic.compare_and_set needs_gc_metrics true false in - let timeout () = - let elapsed = Mtime.span now (Atomic.get last_gc_metrics) in - Mtime.Span.compare elapsed timeout_gc_metrics > 0 - in - if alarm || timeout () then ( - Atomic.set last_gc_metrics now; - let l = - OT.Metrics.make_resource_metrics - ~attrs:(Opentelemetry.GC_metrics.get_runtime_attributes ()) - @@ Opentelemetry.GC_metrics.get_metrics () - in - GC_metrics.add l - ) - -type error = - [ `Status of int * Opentelemetry.Proto.Status.status - | `Failure of string - | `Sysbreak - ] - -let n_errors = Atomic.make 0 - -let n_dropped = Atomic.make 0 - -let report_err_ = function - | `Sysbreak -> Printf.eprintf "opentelemetry: ctrl-c captured, stopping\n%!" - | `Failure msg -> - Format.eprintf "@[<2>opentelemetry: export failed: %s@]@." msg - | `Status (code, { Opentelemetry.Proto.Status.code = scode; message; details }) - -> - let pp_details out l = - List.iter - (fun s -> Format.fprintf out "%S;@ " (Bytes.unsafe_to_string s)) - l - in - Format.eprintf - "@[<2>opentelemetry: export failed with@ http code=%d@ status \ - {@[code=%ld;@ message=%S;@ details=[@[%a@]]@]}@]@." - code scode - (Bytes.unsafe_to_string message) - pp_details details - -module Httpc : sig - type t - - val create : _ Eio.Net.t -> t - - val send : - t -> - url:string -> - decode:[ `Dec of Pbrt.Decoder.t -> 'a | `Ret of 'a ] -> - string -> - ('a, error) result -end = struct - open Opentelemetry.Proto - module Httpc = Cohttp_eio.Client - - type t = Httpc.t - - let authenticator = - match Ca_certs.authenticator () with - | Ok x -> x - | Error (`Msg m) -> - Fmt.failwith "Failed to create system store X509 authenticator: %s" m - - let https ~authenticator = - let tls_config = - match Tls.Config.client ~authenticator () with - | Error (`Msg msg) -> failwith ("tls configuration problem: " ^ msg) - | Ok tls_config -> tls_config - in - fun uri raw -> - let host = - Uri.host uri - |> Option.map (fun x -> Domain_name.(host_exn (of_string_exn x))) - in - Tls_eio.client_of_flow ?host tls_config raw - - let create net = Httpc.make ~https:(Some (https ~authenticator)) net - - (* send the content to the remote endpoint/path *) - let send (client : t) ~url ~decode (body : string) : ('a, error) result = - Switch.run @@ fun sw -> - let uri = Uri.of_string url in - - let open Cohttp in - let headers = Header.(add_list (init ()) (Config.Env.get_headers ())) in - let headers = - Header.(add headers "Content-Type" "application/x-protobuf") - in - - let body = Cohttp_eio.Body.of_string body in - let r = - try - let r = Httpc.post client ~sw ~headers ~body uri in - Ok r - with e -> Error e - in - match r with - | Error e -> - let err = - `Failure - (spf "sending signals via http POST to %S\nfailed with:\n%s" url - (Printexc.to_string e)) + (* send the content to the remote endpoint/path *) + let send (client : t) ~attempt_descr ~url ~headers:user_headers ~decode + (body : string) : ('a, Export_error.t) result = + Eio.Switch.run @@ fun sw -> + let uri = Uri.of_string url in + + let open Cohttp in + let headers = Header.(add_list (init ()) user_headers) in + + let body = Cohttp_eio.Body.of_string body in + let r = + try + let r = Httpc.post client ~sw ~headers ~body uri in + Ok r + with e -> Error e in - Error err - | Ok (resp, body) -> - let body = Eio.Buf_read.(parse_exn take_all) body ~max_size:max_int in - let code = Response.status resp |> Code.code_of_status in - if not (Code.is_error code) then ( - match decode with - | `Ret x -> Ok x - | `Dec f -> + match r with + | Error e -> + let err = + `Failure + (spf "sending signals via http POST to %S\nfailed with:\n%s" url + (Printexc.to_string e)) + in + Error err + | Ok (resp, body) -> + let body = + Eio.Buf_read.(parse_exn take_all) body ~max_size:(10 * 1024 * 1024) + in + let code = Response.status resp |> Code.code_of_status in + if not (Code.is_error code) then ( + match decode with + | `Ret x -> Ok x + | `Dec f -> + let dec = Pbrt.Decoder.of_string body in + let r = + try Ok (f dec) + with e -> + let bt = Printexc.get_backtrace () in + Error + (`Failure + (spf "decoding failed with:\n%s\n%s" (Printexc.to_string e) + bt)) + in + r + ) else ( let dec = Pbrt.Decoder.of_string body in + let r = - try Ok (f dec) + try + let status = Status.decode_pb_status dec in + Error (`Status (code, status, attempt_descr)) with e -> let bt = Printexc.get_backtrace () in Error (`Failure - (spf "decoding failed with:\n%s\n%s" (Printexc.to_string e) - bt)) + (spf + "httpc: decoding of status (url=%S, code=%d) failed with:\n\ + %s\n\ + status: %S\n\ + %s" + url code (Printexc.to_string e) body bt)) in r - ) else ( - let dec = Pbrt.Decoder.of_string body in - - let r = - try - let status = Status.decode_pb_status dec in - Error (`Status (code, status)) - with e -> - let bt = Printexc.get_backtrace () in - Error - (`Failure - (spf - "httpc: decoding of status (url=%S, code=%d) failed with:\n\ - %s\n\ - status: %S\n\ - %s" - url code (Printexc.to_string e) body bt)) - in - r - ) + ) + end end -(** An emitter. This is used by {!Backend} below to forward traces/metrics/… - from the program to whatever collector client we have. *) -module type EMITTER = sig - open Opentelemetry.Proto - - val push_trace : Trace.resource_spans list -> unit - - val push_metrics : Metrics.resource_metrics list -> unit - - val push_logs : Logs.resource_logs list -> unit - - val set_on_tick_callbacks : (unit -> unit) AList.t -> unit - - val tick : unit -> unit - - val cleanup : on_done:(unit -> unit) -> unit -> unit -end +let create_consumer ?(config = Config.make ()) ~sw ~env () : + _ Consumer.Builder.t = + let module M = Make (struct + let sw = sw + + let env = env + end) in + let module C = Generic_http_consumer.Make (M.IO) (M.Notifier) (M.Httpc) in + C.consumer ~ticker_task:(Some 0.5) ~on_tick:Sdk.tick ~config () + +let create_exporter ?(config = Config.make ()) ~sw ~env () = + let consumer = create_consumer ~config ~sw ~env () in + let bq = + Opentelemetry_client_sync.Bounded_queue_sync.create + ~measure:Any_signal_l.length + ~high_watermark:Bounded_queue.Defaults.high_watermark () + in + Exporter_queued.create ~clock:Clock.ptime_clock ~q:bq ~consumer () -(* make an emitter. +let create_backend = create_exporter - exceptions inside should be caught, see - https://opentelemetry.io/docs/reference/specification/error-handling/ *) -let mk_emitter ~stop ~net (config : Config.t) : (module EMITTER) = - (* local helpers *) - let open struct - let client = - (* Prime RNG state for TLS *) - Mirage_crypto_rng_unix.use_default (); - Httpc.create net +let setup_ ~sw ~config env : unit = + Opentelemetry_ambient_context.set_current_storage Ambient_context_eio.storage; + let exp = create_exporter ~config ~sw ~env () in + Sdk.set ~traces:config.traces ~metrics:config.metrics ~logs:config.logs exp; - let send_http ~url data : unit = - let r = Httpc.send client ~url ~decode:(`Ret ()) data in - match r with - | Ok () -> () - | Error `Sysbreak -> - Printf.eprintf "ctrl-c captured, stopping\n%!"; - Atomic.set stop true - | Error err -> - (* TODO: log error _via_ otel? *) - Atomic.incr n_errors; - report_err_ err; - (* avoid crazy error loop *) - Eio_unix.sleep 3. - - let timeout = - if config.batch_timeout_ms > 0 then - Some Mtime.Span.(config.batch_timeout_ms * ms) - else - None - - let batch_traces : Proto.Trace.resource_spans Batch.t = - Batch.make ?batch:config.batch_traces ?timeout () - - let batch_metrics : Proto.Metrics.resource_metrics Batch.t = - Batch.make ?batch:config.batch_metrics ?timeout () - - let batch_logs : Proto.Logs.resource_logs Batch.t = - Batch.make ?batch:config.batch_logs ?timeout () - - let push_to_batch b e = - match Batch.push b e with - | `Ok -> () - | `Dropped -> Atomic.incr n_errors - - let[@inline] guard_exn_ where f = - try f () - with e -> - let bt = Printexc.get_backtrace () in - Printf.eprintf "opentelemetry-eio: uncaught exception in %s: %s\n%s\n%!" - where (Printexc.to_string e) bt - - let push_traces x = - let@ () = guard_exn_ "push trace" in - push_to_batch batch_traces x - - let push_metrics x = - let@ () = guard_exn_ "push metrics" in - sample_gc_metrics_if_needed (); - push_to_batch batch_metrics x - - let push_logs x = - let@ () = guard_exn_ "push logs" in - push_to_batch batch_logs x - - let maybe_emit (batch : 'a Batch.t) url (f : 'a list -> string) ~now ~force - () : unit = - Batch.pop_if_ready ~force ~now batch - |> Option.iter (fun signals -> f signals |> send_http ~url) - - let emit_traces_maybe = - maybe_emit batch_traces config.url_traces Signal.Encode.traces - - let emit_metrics_maybe = - maybe_emit batch_metrics config.url_metrics (fun collected_metrics -> - let gc_metrics = GC_metrics.drain () in - gc_metrics @ collected_metrics |> Signal.Encode.metrics) - - let emit_logs_maybe = - maybe_emit batch_logs config.url_logs Signal.Encode.logs - - let emit_all ~force : unit = - Switch.run @@ fun sw -> - let now = Mtime_clock.now () in - Fiber.fork ~sw @@ emit_logs_maybe ~now ~force; - Fiber.fork ~sw @@ emit_metrics_maybe ~now ~force; - Fiber.fork ~sw @@ emit_traces_maybe ~now ~force - - let on_tick_cbs_ = Atomic.make (AList.make ()) - - let run_tick_callbacks () = - List.iter - (fun f -> - try f () - with e -> - Printf.eprintf "on tick callback raised: %s\n" - (Printexc.to_string e)) - (AList.get @@ Atomic.get on_tick_cbs_) - end in - let module M = struct - let set_on_tick_callbacks = Atomic.set on_tick_cbs_ - - let push_trace e = push_traces e - - let push_metrics e = push_metrics e - - let push_logs e = push_logs e - - let tick () = - if Config.Env.get_debug () then - Printf.eprintf "tick (from domain %d)\n%!" (Domain.self () :> int); - run_tick_callbacks (); - sample_gc_metrics_if_needed (); - emit_all ~force:false - - let cleanup ~on_done () = - if Config.Env.get_debug () then - Printf.eprintf "opentelemetry: exiting…\n%!"; - Atomic.set stop true; - run_tick_callbacks (); - sample_gc_metrics_if_needed (); - emit_all ~force:true; - on_done () - end in - (module M : EMITTER) - -module Backend (Emitter : EMITTER) : Opentelemetry.Collector.BACKEND = struct - open Opentelemetry.Proto - open Opentelemetry.Collector - open Emitter - - let send_trace : Trace.resource_spans list sender = - { - send = - (fun l ~ret -> - (if Config.Env.get_debug () then - let@ () = Lock.with_lock in - Format.eprintf "send spans %a@." - (Format.pp_print_list Trace.pp_resource_spans) - l); - push_trace l; - ret ()); - } + Option.iter + (fun min_level -> Opentelemetry.Self_debug.to_stderr ~min_level ()) + config.log_level; - let last_sent_metrics = Atomic.make (Mtime_clock.now ()) - - let timeout_sent_metrics = Mtime.Span.(5 * s) - (* send metrics from time to time *) - - let signal_emit_gc_metrics () = - if Config.Env.get_debug () then - Printf.eprintf "opentelemetry: emit GC metrics requested\n%!"; - Atomic.set needs_gc_metrics true - - let additional_metrics () : Metrics.resource_metrics list = - (* add exporter metrics to the lot? *) - let last_emit = Atomic.get last_sent_metrics in - let now = Mtime_clock.now () in - let add_own_metrics = - let elapsed = Mtime.span last_emit now in - Mtime.Span.compare elapsed timeout_sent_metrics > 0 - in - - (* there is a possible race condition here, as several threads might update - metrics at the same time. But that's harmless. *) - if add_own_metrics then ( - Atomic.set last_sent_metrics now; - let open OT.Metrics in - [ - make_resource_metrics - [ - sum ~name:"otel.export.dropped" ~is_monotonic:true - [ - int - ~start_time_unix_nano:(Mtime.to_uint64_ns last_emit) - ~now:(Mtime.to_uint64_ns now) (Atomic.get n_dropped); - ]; - sum ~name:"otel.export.errors" ~is_monotonic:true - [ - int - ~start_time_unix_nano:(Mtime.to_uint64_ns last_emit) - ~now:(Mtime.to_uint64_ns now) (Atomic.get n_errors); - ]; - ]; - ] - ) else - [] - - let send_metrics : Metrics.resource_metrics list sender = - { - send = - (fun m ~ret -> - (if Config.Env.get_debug () then - let@ () = Lock.with_lock in - Format.eprintf "send metrics %a@." - (Format.pp_print_list Metrics.pp_resource_metrics) - m); - - let m = List.rev_append (additional_metrics ()) m in - push_metrics m; - ret ()); - } + Opentelemetry.Self_debug.log Opentelemetry.Self_debug.Info (fun () -> + "opentelemetry: cohttp-eio exporter installed"); + Opentelemetry_client.Self_trace.set_enabled config.self_trace; + if config.self_metrics then Opentelemetry.Sdk.setup_self_metrics () - let send_logs : Logs.resource_logs list sender = - { - send = - (fun m ~ret -> - (if Config.Env.get_debug () then - let@ () = Lock.with_lock in - Format.eprintf "send logs %a@." - (Format.pp_print_list Logs.pp_resource_logs) - m); - push_logs m; - ret ()); - } - - let tick = Emitter.tick +let setup ?(config = Config.make ()) ?(enable = true) ~sw env = + if enable && not config.sdk_disabled then setup_ ~sw ~config env - let cleanup = Emitter.cleanup +let remove_exporter () = + let p, waker = Eio.Promise.create () in + Sdk.remove () ~on_done:(fun () -> Eio.Promise.resolve waker ()); + Eio.Promise.await p - let set_on_tick_callbacks = Emitter.set_on_tick_callbacks -end +let remove_backend = remove_exporter -let create_backend ~sw ?(stop = Atomic.make false) ?(config = Config.make ()) - env : (module OT.Collector.BACKEND) = - let module E = (val mk_emitter ~stop ~net:env#net config) in - let module B = Backend (E) in - (* Run a background fiber to keep the backend ticking regularly. - - NOTE: This cannot be located inside the [Backend], because switches - are not thread safe, and cannot be used accross domains, but the - backend is accessed across domains. *) - Eio.Fiber.fork ~sw (fun () -> - while not @@ Atomic.get stop do - Eio.Time.sleep env#clock 0.5; - B.tick () - done); - - (module B) - -let setup_ ~sw ?stop ?config env : unit = - let backend = create_backend ?stop ?config ~sw env in - OT.Collector.set_backend backend - -let setup ?stop ?config ?(enable = true) ~sw env = - if enable then setup_ ~sw ?stop ?config env - -let remove_backend () = OT.Collector.remove_backend ~on_done:ignore () - -let with_setup ?stop ?config ?(enable = true) f env = - if enable then - Switch.run @@ fun sw -> - snd - @@ Fiber.pair - (fun () -> setup_ ~sw ?stop ?config env) - (fun () -> Fun.protect ~finally:(fun () -> remove_backend ()) f) - else +let with_setup ?(config = Config.make ()) ?(enable = true) env f = + if enable && not config.sdk_disabled then ( + Eio.Switch.run @@ fun sw -> + setup_ ~sw ~config env; + Fun.protect f ~finally:remove_exporter + ) else f () diff --git a/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.mli b/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.mli index f88ddef55..814180a67 100644 --- a/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.mli +++ b/src/client-cohttp-eio/opentelemetry_client_cohttp_eio.mli @@ -3,25 +3,33 @@ https://opentelemetry.io/docs/reference/specification/protocol/exporter/ *) -val get_headers : unit -> (string * string) list - -val set_headers : (string * string) list -> unit -(** Set http headers that are sent on every http query to the collector. *) - module Config = Config -val create_backend : +val create_consumer : + ?config:Config.t -> sw:Eio.Switch.t -> - ?stop:bool Atomic.t -> + env:Eio_unix.Stdenv.base -> + unit -> + Opentelemetry_client.Consumer.any_signal_l_builder +(** Consumer that pulls from a queue *) + +val create_exporter : ?config:Config.t -> - Eio_unix.Stdenv.base -> - (module Opentelemetry.Collector.BACKEND) -(** Create a new backend using Cohttp_eio + sw:Eio.Switch.t -> + env:Eio_unix.Stdenv.base -> + unit -> + Opentelemetry.Exporter.t +(** NOTE [after_cleanup] optional parameter removed @since 0.12 *) - NOTE [after_cleanup] optional parameter removed @since 0.12 *) +val create_backend : + ?config:Config.t -> + sw:Eio.Switch.t -> + env:Eio_unix.Stdenv.base -> + unit -> + Opentelemetry.Exporter.t +[@@deprecated "use create_exporter"] val setup : - ?stop:bool Atomic.t -> ?config:Config.t -> ?enable:bool -> sw:Eio.Switch.t -> @@ -36,16 +44,15 @@ val setup : an atomic boolean. When it becomes true, background threads will all stop after a little while. *) -val remove_backend : unit -> unit -(** Shutdown current backend +val remove_exporter : unit -> unit +(** Shutdown current exporter @since 0.12 *) +val remove_backend : unit -> unit +[@@deprecated "use remove_exporter"] +(** @since 0.12 *) + val with_setup : - ?stop:bool Atomic.t -> - ?config:Config.t -> - ?enable:bool -> - (unit -> 'a) -> - Eio_unix.Stdenv.base -> - 'a + ?config:Config.t -> ?enable:bool -> Eio_unix.Stdenv.base -> (unit -> 'a) -> 'a (** [with_setup () f] is like [setup(); f()] but takes care of cleaning up after [f()] returns See {!setup} for more details. *) diff --git a/src/client-cohttp-lwt/config.ml b/src/client-cohttp-lwt/config.ml index 930881ff4..ff3f0dfbd 100644 --- a/src/client-cohttp-lwt/config.ml +++ b/src/client-cohttp-lwt/config.ml @@ -1,7 +1,7 @@ -type t = Opentelemetry_client.Config.t +type t = Opentelemetry_client.Http_config.t -module Env = Opentelemetry_client.Config.Env () +module Env = Opentelemetry_client.Http_config.Env () -let pp = Opentelemetry_client.Config.pp +let pp = Opentelemetry_client.Http_config.pp let make = Env.make (fun common () -> common) diff --git a/src/client-cohttp-lwt/config.mli b/src/client-cohttp-lwt/config.mli index 100bb696b..624c866ed 100644 --- a/src/client-cohttp-lwt/config.mli +++ b/src/client-cohttp-lwt/config.mli @@ -1,4 +1,4 @@ -type t = Opentelemetry_client.Config.t +type t = Opentelemetry_client.Http_config.t (** Configuration. To build one, use {!make} below. This might be extended with more fields in @@ -6,7 +6,7 @@ type t = Opentelemetry_client.Config.t val pp : Format.formatter -> t -> unit -val make : (unit -> t) Opentelemetry_client.Config.make +val make : (unit -> t) Opentelemetry_client.Http_config.make (** Make a configuration {!t}. *) -module Env : Opentelemetry_client.Config.ENV +module Env : Opentelemetry_client.Http_config.ENV diff --git a/src/client-cohttp-lwt/dune b/src/client-cohttp-lwt/dune index 480fb4a8d..8df457b76 100644 --- a/src/client-cohttp-lwt/dune +++ b/src/client-cohttp-lwt/dune @@ -5,11 +5,19 @@ (preprocess (pps lwt_ppx)) (libraries - opentelemetry - opentelemetry.client - lwt - cohttp-lwt - cohttp-lwt-unix + (re_export opentelemetry) + (re_export opentelemetry-lwt) + (re_export opentelemetry-client) + (re_export opentelemetry-client.lwt) + (re_export opentelemetry-client.sync) + (re_export lwt) + (re_export lwt.unix) + (re_export cohttp-lwt) + (re_export cohttp-lwt-unix) + (re_export cohttp) + (re_export unix) + uri + threads pbrt mtime mtime.clock.os)) diff --git a/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml b/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml index 4cb8f22ef..c59c89661 100644 --- a/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml +++ b/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml @@ -3,92 +3,19 @@ https://github.com/open-telemetry/oteps/blob/main/text/0099-otlp-http.md *) -module OT = Opentelemetry module Config = Config -module Signal = Opentelemetry_client.Signal -module Batch = Opentelemetry_client.Batch +open Opentelemetry_client open Opentelemetry open Common_ -let set_headers = Config.Env.set_headers +type error = Export_error.t -let get_headers = Config.Env.get_headers - -external reraise : exn -> 'a = "%reraise" -(** This is equivalent to [Lwt.reraise]. We inline it here so we don't force to - use Lwt's latest version *) - -let needs_gc_metrics = Atomic.make false - -let last_gc_metrics = Atomic.make (Mtime_clock.now ()) - -let timeout_gc_metrics = Mtime.Span.(20 * s) - -let gc_metrics = ref [] -(* side channel for GC, appended to {!E_metrics}'s data *) - -(* capture current GC metrics if {!needs_gc_metrics} is true, - or it has been a long time since the last GC metrics collection, - and push them into {!gc_metrics} for later collection *) -let sample_gc_metrics_if_needed () = - let now = Mtime_clock.now () in - let alarm = Atomic.compare_and_set needs_gc_metrics true false in - let timeout () = - let elapsed = Mtime.span now (Atomic.get last_gc_metrics) in - Mtime.Span.compare elapsed timeout_gc_metrics > 0 - in - if alarm || timeout () then ( - Atomic.set last_gc_metrics now; - let l = - OT.Metrics.make_resource_metrics - ~attrs:(Opentelemetry.GC_metrics.get_runtime_attributes ()) - @@ Opentelemetry.GC_metrics.get_metrics () - in - gc_metrics := l :: !gc_metrics - ) - -type error = - [ `Status of int * Opentelemetry.Proto.Status.status - | `Failure of string - | `Sysbreak - ] - -let n_errors = Atomic.make 0 - -let n_dropped = Atomic.make 0 - -let report_err_ = function - | `Sysbreak -> Printf.eprintf "opentelemetry: ctrl-c captured, stopping\n%!" - | `Failure msg -> - Format.eprintf "@[<2>opentelemetry: export failed: %s@]@." msg - | `Status (code, { Opentelemetry.Proto.Status.code = scode; message; details }) - -> - let pp_details out l = - List.iter - (fun s -> Format.fprintf out "%S;@ " (Bytes.unsafe_to_string s)) - l - in - Format.eprintf - "@[<2>opentelemetry: export failed with@ http code=%d@ status \ - {@[code=%ld;@ message=%S;@ details=[@[%a@]]@]}@]@." - code scode - (Bytes.unsafe_to_string message) - pp_details details - -module Httpc : sig - type t - - val create : unit -> t - - val send : - t -> - url:string -> - decode:[ `Dec of Pbrt.Decoder.t -> 'a | `Ret of 'a ] -> - string -> - ('a, error) result Lwt.t +open struct + module IO = Opentelemetry_client_lwt.Io_lwt +end - val cleanup : t -> unit -end = struct +module Httpc : Generic_http_consumer.HTTPC with module IO = IO = struct + module IO = IO open Opentelemetry.Proto open Lwt.Syntax module Httpc = Cohttp_lwt_unix.Client @@ -100,19 +27,12 @@ end = struct let cleanup _self = () (* send the content to the remote endpoint/path *) - let send (_self : t) ~url ~decode (bod : string) : ('a, error) result Lwt.t = + let send (_self : t) ~attempt_descr ~url ~headers:user_headers ~decode + (bod : string) : ('a, error) result Lwt.t = let uri = Uri.of_string url in let open Cohttp in - let headers = Header.(add_list (init ()) (Config.Env.get_headers ())) in - let headers = - Header.( - add_list headers - [ - "Content-Type", "application/x-protobuf"; - "Accept", "application/x-protobuf"; - ]) - in + let headers = Header.(add_list (init ()) user_headers) in let body = Cohttp_lwt.Body.of_string bod in @@ -154,7 +74,7 @@ end = struct let r = try let status = Status.decode_pb_status dec in - Error (`Status (code, status)) + Error (`Status (code, status, attempt_descr)) with e -> let bt = Printexc.get_backtrace () in Error @@ -170,338 +90,59 @@ end = struct ) end -(** An emitter. This is used by {!Backend} below to forward traces/metrics/… - from the program to whatever collector client we have. *) -module type EMITTER = sig - open Opentelemetry.Proto - - val push_trace : Trace.resource_spans list -> unit - - val push_metrics : Metrics.resource_metrics list -> unit - - val push_logs : Logs.resource_logs list -> unit - - val set_on_tick_callbacks : (unit -> unit) AList.t -> unit - - val tick : unit -> unit - - val cleanup : on_done:(unit -> unit) -> unit -> unit -end - -(* make an emitter. - - exceptions inside should be caught, see - https://opentelemetry.io/docs/reference/specification/error-handling/ *) -let mk_emitter ~stop ~(config : Config.t) () : (module EMITTER) = - let open Proto in - let open Lwt.Syntax in - (* local helpers *) - let open struct - let timeout = - if config.batch_timeout_ms > 0 then - Some Mtime.Span.(config.batch_timeout_ms * ms) - else - None - - let batch_traces : Trace.resource_spans Batch.t = - Batch.make ?batch:config.batch_traces ?timeout () - - let batch_metrics : Metrics.resource_metrics Batch.t = - Batch.make ?batch:config.batch_metrics ?timeout () - - let batch_logs : Logs.resource_logs Batch.t = - Batch.make ?batch:config.batch_logs ?timeout () - - let on_tick_cbs_ = Atomic.make (AList.make ()) - - let set_on_tick_callbacks = Atomic.set on_tick_cbs_ - - let send_http_ (httpc : Httpc.t) ~url data : unit Lwt.t = - let* r = Httpc.send httpc ~url ~decode:(`Ret ()) data in - match r with - | Ok () -> Lwt.return () - | Error `Sysbreak -> - Printf.eprintf "ctrl-c captured, stopping\n%!"; - Atomic.set stop true; - Lwt.return () - | Error err -> - (* TODO: log error _via_ otel? *) - Atomic.incr n_errors; - report_err_ err; - (* avoid crazy error loop *) - Lwt_unix.sleep 3. - - let send_metrics_http client (l : Metrics.resource_metrics list) = - Signal.Encode.metrics l |> send_http_ client ~url:config.url_metrics - - let send_traces_http client (l : Trace.resource_spans list) = - Signal.Encode.traces l |> send_http_ client ~url:config.url_traces +module Consumer_impl = + Generic_http_consumer.Make (IO) (Opentelemetry_client_lwt.Notifier_lwt) + (Httpc) - let send_logs_http client (l : Logs.resource_logs list) = - Signal.Encode.logs l |> send_http_ client ~url:config.url_logs +let create_consumer ?(config = Config.make ()) () = + Consumer_impl.consumer ~ticker_task:(Some 0.5) ~on_tick:OTEL.Sdk.tick ~config + () - (* emit metrics, if the batch is full or timeout lapsed *) - let emit_metrics_maybe ~now ?force httpc : bool Lwt.t = - match Batch.pop_if_ready ?force ~now batch_metrics with - | None -> Lwt.return false - | Some l -> - let batch = !gc_metrics @ l in - gc_metrics := []; - let+ () = send_metrics_http httpc batch in - true - - let emit_traces_maybe ~now ?force httpc : bool Lwt.t = - match Batch.pop_if_ready ?force ~now batch_traces with - | None -> Lwt.return false - | Some l -> - let+ () = send_traces_http httpc l in - true - - let emit_logs_maybe ~now ?force httpc : bool Lwt.t = - match Batch.pop_if_ready ?force ~now batch_logs with - | None -> Lwt.return false - | Some l -> - let+ () = send_logs_http httpc l in - true - - let[@inline] guard_exn_ where f = - try f () - with e -> - let bt = Printexc.get_backtrace () in - Printf.eprintf - "opentelemetry-cohttp-lwt: uncaught exception in %s: %s\n%s\n%!" where - (Printexc.to_string e) bt - - let emit_all_force (httpc : Httpc.t) : unit Lwt.t = - let now = Mtime_clock.now () in - let+ (_ : bool) = emit_traces_maybe ~now ~force:true httpc - and+ (_ : bool) = emit_logs_maybe ~now ~force:true httpc - and+ (_ : bool) = emit_metrics_maybe ~now ~force:true httpc in - () - - (* thread that calls [tick()] regularly, to help enforce timeouts *) - let setup_ticker_thread ~tick ~finally () = - let rec tick_thread () = - if Atomic.get stop then ( - finally (); - Lwt.return () - ) else - let* () = Lwt_unix.sleep 0.5 in - let* () = tick () in - tick_thread () - in - Lwt.async tick_thread - end in - let httpc = Httpc.create () in - - let module M = struct - (* we make sure that this is thread-safe, even though we don't have a - background thread. There can still be a ticker thread, and there - can also be several user threads that produce spans and call - the emit functions. *) - - let push_to_batch b e = - match Batch.push b e with - | `Ok -> () - | `Dropped -> Atomic.incr n_errors - - let push_trace e = - let@ () = guard_exn_ "push trace" in - push_to_batch batch_traces e; - let now = Mtime_clock.now () in - Lwt.async (fun () -> - let+ (_ : bool) = emit_traces_maybe ~now httpc in - ()) - - let push_metrics e = - let@ () = guard_exn_ "push metrics" in - sample_gc_metrics_if_needed (); - push_to_batch batch_metrics e; - let now = Mtime_clock.now () in - Lwt.async (fun () -> - let+ (_ : bool) = emit_metrics_maybe ~now httpc in - ()) - - let push_logs e = - let@ () = guard_exn_ "push logs" in - push_to_batch batch_logs e; - let now = Mtime_clock.now () in - Lwt.async (fun () -> - let+ (_ : bool) = emit_logs_maybe ~now httpc in - ()) - - let set_on_tick_callbacks = set_on_tick_callbacks - - let tick_ () = - if Config.Env.get_debug () then - Printf.eprintf "tick (from %d)\n%!" (tid ()); - sample_gc_metrics_if_needed (); - List.iter - (fun f -> - try f () - with e -> - Printf.eprintf "on tick callback raised: %s\n" - (Printexc.to_string e)) - (AList.get @@ Atomic.get on_tick_cbs_); - let now = Mtime_clock.now () in - let+ (_ : bool) = emit_traces_maybe ~now httpc - and+ (_ : bool) = emit_logs_maybe ~now httpc - and+ (_ : bool) = emit_metrics_maybe ~now httpc in - () - - let () = setup_ticker_thread ~tick:tick_ ~finally:ignore () - - (* if called in a blocking context: work in the background *) - let tick () = Lwt.async tick_ - - let cleanup ~on_done () = - if Config.Env.get_debug () then - Printf.eprintf "opentelemetry: exiting…\n%!"; - Lwt.async (fun () -> - let* () = emit_all_force httpc in - Httpc.cleanup httpc; - on_done (); - Lwt.return ()) - end in - (module M) - -module Backend - (Arg : sig - val stop : bool Atomic.t - - val config : Config.t - end) - () : Opentelemetry.Collector.BACKEND = struct - include (val mk_emitter ~stop:Arg.stop ~config:Arg.config ()) - - open Opentelemetry.Proto - open Opentelemetry.Collector - - let send_trace : Trace.resource_spans list sender = - { - send = - (fun l ~ret -> - (if Config.Env.get_debug () then - let@ () = Lock.with_lock in - Format.eprintf "send spans %a@." - (Format.pp_print_list Trace.pp_resource_spans) - l); - push_trace l; - ret ()); - } - - let last_sent_metrics = Atomic.make (Mtime_clock.now ()) - - let timeout_sent_metrics = Mtime.Span.(5 * s) - (* send metrics from time to time *) - - let signal_emit_gc_metrics () = - if Config.Env.get_debug () then - Printf.eprintf "opentelemetry: emit GC metrics requested\n%!"; - Atomic.set needs_gc_metrics true - - let additional_metrics () : Metrics.resource_metrics list = - (* add exporter metrics to the lot? *) - let last_emit = Atomic.get last_sent_metrics in - let now = Mtime_clock.now () in - let add_own_metrics = - let elapsed = Mtime.span last_emit now in - Mtime.Span.compare elapsed timeout_sent_metrics > 0 - in - - (* there is a possible race condition here, as several threads might update - metrics at the same time. But that's harmless. *) - if add_own_metrics then ( - Atomic.set last_sent_metrics now; - let open OT.Metrics in - [ - make_resource_metrics - [ - sum ~name:"otel.export.dropped" ~is_monotonic:true - [ - int - ~start_time_unix_nano:(Mtime.to_uint64_ns last_emit) - ~now:(Mtime.to_uint64_ns now) (Atomic.get n_dropped); - ]; - sum ~name:"otel.export.errors" ~is_monotonic:true - [ - int - ~start_time_unix_nano:(Mtime.to_uint64_ns last_emit) - ~now:(Mtime.to_uint64_ns now) (Atomic.get n_errors); - ]; - ]; - ] - ) else - [] - - let send_metrics : Metrics.resource_metrics list sender = - { - send = - (fun m ~ret -> - (if Config.Env.get_debug () then - let@ () = Lock.with_lock in - Format.eprintf "send metrics %a@." - (Format.pp_print_list Metrics.pp_resource_metrics) - m); - - let m = List.rev_append (additional_metrics ()) m in - push_metrics m; - ret ()); - } - - let send_logs : Logs.resource_logs list sender = - { - send = - (fun m ~ret -> - (if Config.Env.get_debug () then - let@ () = Lock.with_lock in - Format.eprintf "send logs %a@." - (Format.pp_print_list Logs.pp_resource_logs) - m); +let create_exporter ?(config = Config.make ()) () = + let consumer = create_consumer ~config () in + let bq = + Opentelemetry_client_sync.Bounded_queue_sync.create + ~measure:OTEL.Any_signal_l.length + ~high_watermark:Bounded_queue.Defaults.high_watermark () + in + Exporter_queued.create ~clock:Clock.ptime_clock ~q:bq ~consumer () - push_logs m; - ret ()); - } -end +let create_backend = create_exporter -let create_backend ?(stop = Atomic.make false) ?(config = Config.make ()) () = - let module B = - Backend - (struct - let stop = stop +let setup_ ~config () : unit = + Opentelemetry_client_lwt.Util_ambient_context.setup_ambient_context (); + let exp = create_exporter ~config () in + Sdk.set ~traces:config.traces ~metrics:config.metrics ~logs:config.logs exp; - let config = config - end) - () - in - (module B : OT.Collector.BACKEND) + Option.iter + (fun min_level -> Opentelemetry.Self_debug.to_stderr ~min_level ()) + config.log_level; -let setup_ ?stop ?config () : unit = - let backend = create_backend ?stop ?config () in - OT.Collector.set_backend backend; + Opentelemetry.Self_debug.log Opentelemetry.Self_debug.Info (fun () -> + "opentelemetry: cohttp-lwt exporter installed"); + Opentelemetry_client.Self_trace.set_enabled config.self_trace; + if config.self_metrics then Opentelemetry.Sdk.setup_self_metrics (); () -let setup ?stop ?config ?(enable = true) () = - if enable then setup_ ?stop ?config () +let setup ?(config = Config.make ()) ?(enable = true) () = + if enable && not config.sdk_disabled then setup_ ~config () -let remove_backend () : unit Lwt.t = +let remove_exporter () : unit Lwt.t = let done_fut, done_u = Lwt.wait () in - OT.Collector.remove_backend ~on_done:(fun () -> Lwt.wakeup_later done_u ()) (); + (* Printf.eprintf "otel.client.cohttp-lwt: removing…\n%!"; *) + Sdk.remove + ~on_done:(fun () -> + (* Printf.eprintf "otel.client.cohttp-lwt: done removing\n%!"; *) + Lwt.wakeup_later done_u ()) + (); done_fut -let with_setup ?stop ?(config = Config.make ()) ?(enable = true) () f : _ Lwt.t - = - if enable then ( - let open Lwt.Syntax in - setup_ ?stop ~config (); +let remove_backend = remove_exporter + +let with_setup ?(config = Config.make ()) ?(enable = true) () f : _ Lwt.t = + if enable && not config.sdk_disabled then ( + setup_ ~config (); - Lwt.catch - (fun () -> - let* res = f () in - let+ () = remove_backend () in - res) - (fun exn -> - let* () = remove_backend () in - reraise exn) + Lwt.finalize f remove_exporter ) else f () diff --git a/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.mli b/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.mli index c57d96533..9198063b8 100644 --- a/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.mli +++ b/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.mli @@ -3,26 +3,19 @@ https://opentelemetry.io/docs/reference/specification/protocol/exporter/ *) -open Common_ - -val get_headers : unit -> (string * string) list - -val set_headers : (string * string) list -> unit -(** Set http headers that are sent on every http query to the collector. *) - module Config = Config -val create_backend : - ?stop:bool Atomic.t -> - ?config:Config.t -> - unit -> - (module Opentelemetry.Collector.BACKEND) -(** Create a new backend using lwt and cohttp +val create_consumer : + ?config:Config.t -> unit -> Opentelemetry_client.Consumer.any_signal_l_builder +(** Consumer that pulls from a queue *) + +val create_exporter : ?config:Config.t -> unit -> Opentelemetry.Exporter.t +(** Create a new backend using lwt and ezcurl-lwt *) - NOTE [after_cleanup] optional parameter removed @since 0.12 *) +val create_backend : ?config:Config.t -> unit -> Opentelemetry.Exporter.t +[@@deprecated "use create_exporter"] -val setup : - ?stop:bool Atomic.t -> ?config:Config.t -> ?enable:bool -> unit -> unit +val setup : ?config:Config.t -> ?enable:bool -> unit -> unit (** Setup endpoint. This modifies {!Opentelemetry.Collector.backend}. @param enable actually setup the backend (default true). This can be used to @@ -37,11 +30,6 @@ val remove_backend : unit -> unit Lwt.t @since 0.12 *) val with_setup : - ?stop:bool Atomic.t -> - ?config:Config.t -> - ?enable:bool -> - unit -> - (unit -> 'a Lwt.t) -> - 'a Lwt.t + ?config:Config.t -> ?enable:bool -> unit -> (unit -> 'a Lwt.t) -> 'a Lwt.t (** [with_setup () f] is like [setup(); f()] but takes care of cleaning up after [f()] returns See {!setup} for more details. *) diff --git a/src/client-ocurl-lwt/common_.ml b/src/client-ocurl-lwt/common_.ml new file mode 100644 index 000000000..fa371e4b5 --- /dev/null +++ b/src/client-ocurl-lwt/common_.ml @@ -0,0 +1,7 @@ +module Atomic = Opentelemetry_atomic.Atomic + +let[@inline] ( let@ ) f x = f x + +let spf = Printf.sprintf + +let tid () = Thread.id @@ Thread.self () diff --git a/src/client-ocurl-lwt/config.ml b/src/client-ocurl-lwt/config.ml new file mode 100644 index 000000000..ff3f0dfbd --- /dev/null +++ b/src/client-ocurl-lwt/config.ml @@ -0,0 +1,7 @@ +type t = Opentelemetry_client.Http_config.t + +module Env = Opentelemetry_client.Http_config.Env () + +let pp = Opentelemetry_client.Http_config.pp + +let make = Env.make (fun common () -> common) diff --git a/src/client-ocurl-lwt/config.mli b/src/client-ocurl-lwt/config.mli new file mode 100644 index 000000000..624c866ed --- /dev/null +++ b/src/client-ocurl-lwt/config.mli @@ -0,0 +1,12 @@ +type t = Opentelemetry_client.Http_config.t +(** Configuration. + + To build one, use {!make} below. This might be extended with more fields in + the future. *) + +val pp : Format.formatter -> t -> unit + +val make : (unit -> t) Opentelemetry_client.Http_config.make +(** Make a configuration {!t}. *) + +module Env : Opentelemetry_client.Http_config.ENV diff --git a/src/client-ocurl-lwt/dune b/src/client-ocurl-lwt/dune new file mode 100644 index 000000000..c68e82509 --- /dev/null +++ b/src/client-ocurl-lwt/dune @@ -0,0 +1,21 @@ +(library + (name opentelemetry_client_ocurl_lwt) + (public_name opentelemetry-client-ocurl-lwt) + (synopsis "Opentelemetry collector using ezcurl-lwt") + (preprocess + (pps lwt_ppx)) + (libraries + (re_export opentelemetry) + opentelemetry.atomic + (re_export opentelemetry-client) + (re_export opentelemetry-client.sync) + (re_export opentelemetry-client.lwt) + threads + pbrt + mtime + mtime.clock.os + (re_export curl) + (re_export ezcurl-lwt) + (re_export ezcurl.core) + (re_export lwt) + (re_export lwt.unix))) diff --git a/src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.ml b/src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.ml new file mode 100644 index 000000000..a7e7b5d98 --- /dev/null +++ b/src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.ml @@ -0,0 +1,133 @@ +(* + https://github.com/open-telemetry/oteps/blob/main/text/0035-opentelemetry-protocol.md + https://github.com/open-telemetry/oteps/blob/main/text/0099-otlp-http.md + *) + +module Config = Config +open Opentelemetry +open Opentelemetry_client +open Common_ + +type error = Export_error.t + +open struct + module IO = Opentelemetry_client_lwt.Io_lwt +end + +(** HTTP client *) +module Httpc : Generic_http_consumer.HTTPC with module IO = IO = struct + module IO = IO + open Lwt.Syntax + + type t = Ezcurl_core.t + + let create () : t = Ezcurl_lwt.make () + + let cleanup self = Ezcurl_lwt.delete self + + (** send the content to the remote endpoint/path *) + let send (self : t) ~attempt_descr ~url ~headers:user_headers ~decode + (bod : string) : ('a, error) result Lwt.t = + let* r = + let headers = user_headers in + Ezcurl_lwt.post ~client:self ~headers ~params:[] ~url + ~content:(`String bod) () + in + match r with + | Error (code, msg) -> + let err = + `Failure + (spf + "sending signals via http POST failed:\n\ + \ %s\n\ + \ curl code: %s\n\ + \ url: %s\n\ + %!" + msg (Curl.strerror code) url) + in + Lwt.return @@ Error err + | Ok { code; body; _ } when code >= 200 && code < 300 -> + (match decode with + | `Ret x -> Lwt.return @@ Ok x + | `Dec f -> + let dec = Pbrt.Decoder.of_string body in + let r = + try Ok (f dec) + with e -> + let bt = Printexc.get_backtrace () in + Error + (`Failure + (spf "decoding failed with:\n%s\n%s" (Printexc.to_string e) bt)) + in + Lwt.return r) + | Ok { code; body; _ } -> + let err = + Export_error.decode_invalid_http_response ~attempt_descr ~url ~code body + in + Lwt.return (Error err) +end + +module Consumer_impl = + Generic_http_consumer.Make (IO) (Opentelemetry_client_lwt.Notifier_lwt) + (Httpc) + +let create_consumer ?(config = Config.make ()) () = + Consumer_impl.consumer ~ticker_task:(Some 0.5) ~on_tick:OTEL.Sdk.tick ~config + () + +let create_exporter ?(config = Config.make ()) () = + let consumer = create_consumer ~config () in + let bq = + Opentelemetry_client_sync.Bounded_queue_sync.create + ~measure:OTEL.Any_signal_l.length + ~high_watermark:Bounded_queue.Defaults.high_watermark () + in + Exporter_queued.create ~clock:Clock.ptime_clock ~q:bq ~consumer () + +let create_backend = create_exporter + +let setup_ ~config () : Exporter.t = + Opentelemetry_client_lwt.Util_ambient_context.setup_ambient_context (); + let exp = create_exporter ~config () in + Sdk.set ~traces:config.traces ~metrics:config.metrics ~logs:config.logs exp; + + Option.iter + (fun min_level -> Opentelemetry.Self_debug.to_stderr ~min_level ()) + config.log_level; + + Opentelemetry.Self_debug.log Opentelemetry.Self_debug.Info (fun () -> + "opentelemetry: ocurl-lwt exporter installed"); + Opentelemetry_client.Self_trace.set_enabled config.self_trace; + if config.self_metrics then Opentelemetry.Sdk.setup_self_metrics (); + + exp + +let setup ?(config = Config.make ()) ?(enable = true) () = + if enable && not config.sdk_disabled then + ignore (setup_ ~config () : Exporter.t) + +let remove_exporter () : unit Lwt.t = + let done_fut, done_u = Lwt.wait () in + Sdk.remove ~on_done:(fun () -> Lwt.wakeup_later done_u ()) (); + done_fut + +let remove_backend = remove_exporter + +let with_setup ?(after_shutdown = ignore) ?(config = Config.make ()) + ?(enable = true) () f : _ Lwt.t = + if enable && not config.sdk_disabled then + let open Lwt.Syntax in + let exp = setup_ ~config () in + + Lwt.catch + (fun () -> + let* res = f () in + let+ () = remove_exporter () in + after_shutdown exp; + res) + (fun exn -> + let* () = remove_exporter () in + after_shutdown exp; + Lwt.reraise exn) + else + f () diff --git a/src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.mli b/src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.mli new file mode 100644 index 000000000..6228f212e --- /dev/null +++ b/src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.mli @@ -0,0 +1,37 @@ +(* + TODO: more options from + https://opentelemetry.io/docs/reference/specification/protocol/exporter/ + *) + +module Config = Config + +val create_consumer : + ?config:Config.t -> unit -> Opentelemetry_client.Consumer.any_signal_l_builder +(** Consumer that pulls from a queue *) + +val create_exporter : ?config:Config.t -> unit -> Opentelemetry.Exporter.t +(** Create a new backend using lwt and ezcurl-lwt *) + +val create_backend : ?config:Config.t -> unit -> Opentelemetry.Exporter.t +[@@deprecated "use create_exporter"] + +val setup : ?config:Config.t -> ?enable:bool -> unit -> unit +(** Setup endpoint. This modifies {!Opentelemetry.Collector.backend}. + @param enable + actually setup the backend (default true). This can be used to + enable/disable the setup depending on CLI arguments or environment. + @param config configuration to use *) + +val remove_backend : unit -> unit Lwt.t +(** Shutdown current backend + @since 0.90 *) + +val with_setup : + ?after_shutdown:(Opentelemetry.Exporter.t -> unit) -> + ?config:Config.t -> + ?enable:bool -> + unit -> + (unit -> 'a Lwt.t) -> + 'a Lwt.t +(** [with_setup () f] is like [setup(); f()] but takes care of cleaning up after + [f()] returns See {!setup} for more details. *) diff --git a/src/client-ocurl/batch.ml b/src/client-ocurl/batch.ml deleted file mode 100644 index 0be8b1b0f..000000000 --- a/src/client-ocurl/batch.ml +++ /dev/null @@ -1,24 +0,0 @@ -type 'a t = { - mutable len: int; - mutable l: 'a list list; - mutable started: Mtime.t; -} - -let create () = { len = 0; l = []; started = Mtime_clock.now () } - -let push self l = - if l != [] then ( - if self.l == [] then self.started <- Mtime_clock.now (); - self.l <- l :: self.l; - self.len <- self.len + List.length l - ) - -let[@inline] len self = self.len - -let[@inline] time_started self = self.started - -let pop_all self = - let l = self.l in - self.l <- []; - self.len <- 0; - l diff --git a/src/client-ocurl/batch.mli b/src/client-ocurl/batch.mli deleted file mode 100644 index 2b867b880..000000000 --- a/src/client-ocurl/batch.mli +++ /dev/null @@ -1,14 +0,0 @@ -(** List of lists with length *) - -type 'a t - -val create : unit -> 'a t - -val push : 'a t -> 'a list -> unit - -val len : _ t -> int - -val time_started : _ t -> Mtime.t -(** Time at which the batch most recently became non-empty *) - -val pop_all : 'a t -> 'a list list diff --git a/src/client-ocurl/common_.ml b/src/client-ocurl/common_.ml index 10df0c1d4..1ec6de25f 100644 --- a/src/client-ocurl/common_.ml +++ b/src/client-ocurl/common_.ml @@ -1,8 +1,8 @@ module Atomic = Opentelemetry_atomic.Atomic -include Opentelemetry.Lock +module Proto = Opentelemetry_proto let spf = Printf.sprintf let ( let@ ) = ( @@ ) -let tid () = Thread.id @@ Thread.self () +let[@inline] tid () = Thread.id @@ Thread.self () diff --git a/src/client-ocurl/config.ml b/src/client-ocurl/config.ml index 0954fbe65..be9085ea9 100644 --- a/src/client-ocurl/config.ml +++ b/src/client-ocurl/config.ml @@ -1,3 +1,5 @@ +open Opentelemetry_client + type t = { bg_threads: int; (** Are there background threads, and how many? Default [4]. This will be @@ -10,7 +12,7 @@ type t = { [ticker_thread] is [true]. This will be clamped between [2 ms] and some longer interval (maximum [60s] currently). Default 500. @since 0.7 *) - common: Opentelemetry_client.Config.t; + common: Http_config.t; (** Common configuration options @since 0.12*) } @@ -20,10 +22,9 @@ let pp out self = Format.fprintf out "{@[ bg_threads=%d;@ ticker_thread=%B;@ ticker_interval_ms=%d;@ common=%a \ @]}" - bg_threads ticker_thread ticker_interval_ms Opentelemetry_client.Config.pp - common + bg_threads ticker_thread ticker_interval_ms Http_config.pp common -module Env = Opentelemetry_client.Config.Env () +module Env = Http_config.Env () let make = Env.make diff --git a/src/client-ocurl/config.mli b/src/client-ocurl/config.mli index 514ecb3e6..c5b19e6d0 100644 --- a/src/client-ocurl/config.mli +++ b/src/client-ocurl/config.mli @@ -12,7 +12,7 @@ type t = { [ticker_thread] is [true]. This will be clamped between [2 ms] and some longer interval (maximum [60s] currently). Default 500. @since 0.7 *) - common: Opentelemetry_client.Config.t; + common: Opentelemetry_client.Http_config.t; (** Common configuration options @since 0.12*) } @@ -29,7 +29,7 @@ val make : ?ticker_interval_ms:int -> unit -> t) - Opentelemetry_client.Config.make + Opentelemetry_client.Http_config.make (** Make a configuration {!t}. *) -module Env : Opentelemetry_client.Config.ENV +module Env : Opentelemetry_client.Http_config.ENV diff --git a/src/client-ocurl/dune b/src/client-ocurl/dune index 9823b5bc7..62a77d6db 100644 --- a/src/client-ocurl/dune +++ b/src/client-ocurl/dune @@ -2,13 +2,15 @@ (name opentelemetry_client_ocurl) (public_name opentelemetry-client-ocurl) (libraries - opentelemetry + (re_export opentelemetry) opentelemetry.atomic - opentelemetry.client - curl + (re_export opentelemetry-client) + (re_export opentelemetry-client.sync) + (re_export curl) + unix pbrt threads mtime mtime.clock.os - ezcurl - ezcurl.core)) + (re_export ezcurl) + (re_export ezcurl.core))) diff --git a/src/client-ocurl/opentelemetry_client_ocurl.ml b/src/client-ocurl/opentelemetry_client_ocurl.ml index 55d4788c5..025a6a92a 100644 --- a/src/client-ocurl/opentelemetry_client_ocurl.ml +++ b/src/client-ocurl/opentelemetry_client_ocurl.ml @@ -3,471 +3,127 @@ https://github.com/open-telemetry/oteps/blob/main/text/0099-otlp-http.md *) -module OT = Opentelemetry module Config = Config -module Self_trace = Opentelemetry_client.Self_trace -module Signal = Opentelemetry_client.Signal -open Opentelemetry -include Common_ +module OTELC = Opentelemetry_client +module OTEL = Opentelemetry +open Common_ -let get_headers = Config.Env.get_headers +type error = OTELC.Export_error.t -let set_headers = Config.Env.set_headers - -let needs_gc_metrics = Atomic.make false - -let last_gc_metrics = Atomic.make (Mtime_clock.now ()) - -let timeout_gc_metrics = Mtime.Span.(20 * s) - -(** side channel for GC, appended to metrics batch data *) -let gc_metrics = AList.make () - -(** capture current GC metrics if {!needs_gc_metrics} is true or it has been a - long time since the last GC metrics collection, and push them into - {!gc_metrics} for later collection *) -let sample_gc_metrics_if_needed () = - let now = Mtime_clock.now () in - let alarm = Atomic.exchange needs_gc_metrics false in - let timeout () = - let elapsed = Mtime.span now (Atomic.get last_gc_metrics) in - Mtime.Span.compare elapsed timeout_gc_metrics > 0 - in - if alarm || timeout () then ( - Atomic.set last_gc_metrics now; - let l = - OT.Metrics.make_resource_metrics - ~attrs:(Opentelemetry.GC_metrics.get_runtime_attributes ()) - @@ Opentelemetry.GC_metrics.get_metrics () - in - AList.add gc_metrics l - ) - -let n_errors = Atomic.make 0 - -let n_dropped = Atomic.make 0 - -(** Something sent to the collector *) -module Event = struct - open Opentelemetry.Proto - - type t = - | E_metric of Metrics.resource_metrics list - | E_trace of Trace.resource_spans list - | E_logs of Logs.resource_logs list - | E_tick - | E_flush_all (** Flush all batches *) +open struct + module Notifier = Opentelemetry_client_sync.Notifier_sync + module IO = Opentelemetry_client_sync.Io_sync end -(** Something to be sent via HTTP *) -module To_send = struct - open Opentelemetry.Proto +module Httpc : OTELC.Generic_http_consumer.HTTPC with module IO = IO = struct + module IO = IO - type t = - | Send_metric of Metrics.resource_metrics list list - | Send_trace of Trace.resource_spans list list - | Send_logs of Logs.resource_logs list list -end + type t = Ezcurl_core.t -(** start a thread in the background, running [f()] *) -let start_bg_thread (f : unit -> unit) : Thread.t = - let unix_run () = - let signals = - [ - Sys.sigusr1; - Sys.sigusr2; - Sys.sigterm; - Sys.sigpipe; - Sys.sigalrm; - Sys.sigstop; - ] - in - ignore (Thread.sigmask Unix.SIG_BLOCK signals : _ list); - f () - in - (* no signals on Windows *) - let run () = - if Sys.win32 then - f () - else - unix_run () - in - Thread.create run () + let create () = Ezcurl.make () -let str_to_hex (s : string) : string = - let i_to_hex (i : int) = - if i < 10 then - Char.chr (i + Char.code '0') - else - Char.chr (i - 10 + Char.code 'a') - in + let cleanup = Ezcurl.delete - let res = Bytes.create (2 * String.length s) in - for i = 0 to String.length s - 1 do - let n = Char.code (String.get s i) in - Bytes.set res (2 * i) (i_to_hex ((n land 0xf0) lsr 4)); - Bytes.set res ((2 * i) + 1) (i_to_hex (n land 0x0f)) - done; - Bytes.unsafe_to_string res - -module Backend_impl : sig - type t - - val create : stop:bool Atomic.t -> config:Config.t -> unit -> t - - val send_event : t -> Event.t -> unit - - val shutdown : t -> on_done:(unit -> unit) -> unit -end = struct - open Opentelemetry.Proto - - type t = { - stop: bool Atomic.t; - cleaned: bool Atomic.t; (** True when we cleaned up after closing *) - config: Config.t; - q: Event.t B_queue.t; (** Queue to receive data from the user's code *) - mutable main_th: Thread.t option; (** Thread that listens on [q] *) - send_q: To_send.t B_queue.t; (** Queue for the send worker threads *) - mutable send_threads: Thread.t array; (** Threads that send data via http *) - } - - let send_http_ ~stop ~(config : Config.t) (client : Curl.t) ~url data : unit = - let@ _sc = - Self_trace.with_ ~kind:Span.Span_kind_producer "otel-ocurl.send-http" - in - - if Config.Env.get_debug () then - Printf.eprintf "opentelemetry: send http POST to %s (%dB)\n%!" url - (String.length data); - let headers = - ("Content-Type", "application/x-protobuf") :: config.common.headers + let send (self : t) ~attempt_descr ~url ~headers:user_headers ~decode + (bod : string) : ('a, error) result = + let r = + let headers = user_headers in + Ezcurl.post ~client:self ~headers ~params:[] ~url ~content:(`String bod) + () in - match - let@ _sc = - Self_trace.with_ ~kind:Span.Span_kind_internal "curl.post" - ~attrs:[ "sz", `Int (String.length data); "url", `String url ] + match r with + | Error (code, msg) -> + let err = + `Failure + (spf + "sending signals via http POST failed:\n\ + \ %s\n\ + \ curl code: %s\n\ + \ url: %s\n\ + %!" + msg (Curl.strerror code) url) in - Ezcurl.post ~headers ~client ~params:[] ~url ~content:(`String data) () - with - | Ok { code; _ } when code >= 200 && code < 300 -> - if Config.Env.get_debug () then - Printf.eprintf "opentelemetry: got response code=%d\n%!" code - | Ok { code; body; headers = _; info = _ } -> - Atomic.incr n_errors; - Self_trace.add_event _sc - @@ Opentelemetry.Event.make "error" ~attrs:[ "code", `Int code ]; - - if Config.Env.get_debug () then ( + Error err + | Ok { code; body; _ } when code >= 200 && code < 300 -> + (match decode with + | `Ret x -> Ok x + | `Dec f -> let dec = Pbrt.Decoder.of_string body in - let body = - try - let status = Status.decode_pb_status dec in - Format.asprintf "%a" Status.pp_status status - with _ -> - spf "(could not decode status)\nraw bytes: %s" (str_to_hex body) - in - Printf.eprintf - "opentelemetry: error while sending data to %s:\n code=%d\n %s\n%!" - url code body - ); - () - | exception Sys.Break -> - Printf.eprintf "ctrl-c captured, stopping\n%!"; - Atomic.set stop true - | Error (code, msg) -> - (* TODO: log error _via_ otel? *) - Atomic.incr n_errors; - - Printf.eprintf - "opentelemetry: export failed:\n %s\n curl code: %s\n url: %s\n%!" - msg (Curl.strerror code) url; - - (* avoid crazy error loop *) - Thread.delay 3. - - let[@inline] send_event (self : t) ev : unit = B_queue.push self.q ev - - (** Thread that, in a loop, reads from [q] to get the next message to send via - http *) - let bg_thread_loop (self : t) : unit = - Ezcurl.with_client ?set_opts:None @@ fun client -> - let config = self.config in - let stop = self.stop in - let send ~name ~url ~conv signals = - let l = List.fold_left (fun acc l -> List.rev_append l acc) [] signals in - let@ _sp = - Self_trace.with_ ~kind:Span_kind_producer name - ~attrs:[ "n", `Int (List.length l) ] + (try Ok (f dec) + with e -> + let bt = Printexc.get_backtrace () in + Error + (`Failure + (spf "decoding failed with:\n%s\n%s" (Printexc.to_string e) bt)))) + | Ok { code; body; _ } -> + let err = + OTELC.Export_error.decode_invalid_http_response ~attempt_descr ~url + ~code body in - conv l |> send_http_ ~stop ~config ~url client - in - try - while not (Atomic.get stop) do - let msg = B_queue.pop self.send_q in - match msg with - | To_send.Send_trace tr -> - send ~name:"send-traces" ~conv:Signal.Encode.traces - ~url:config.common.url_traces tr - | To_send.Send_metric ms -> - send ~name:"send-metrics" ~conv:Signal.Encode.metrics - ~url:config.common.url_metrics ms - | To_send.Send_logs logs -> - send ~name:"send-logs" ~conv:Signal.Encode.logs - ~url:config.common.url_logs logs - done - with B_queue.Closed -> () - - type batches = { - traces: Proto.Trace.resource_spans Batch.t; - logs: Proto.Logs.resource_logs Batch.t; - metrics: Proto.Metrics.resource_metrics Batch.t; - } - - let batch_max_size_ = 200 - - let should_send_batch_ ?(side = []) ~config ~now (b : _ Batch.t) : bool = - (Batch.len b > 0 || side != []) - && (Batch.len b >= batch_max_size_ - || - let timeout = Mtime.Span.(config.Config.common.batch_timeout_ms * ms) in - let elapsed = Mtime.span now (Batch.time_started b) in - Mtime.Span.compare elapsed timeout >= 0) - - let main_thread_loop (self : t) : unit = - let local_q = Queue.create () in - let config = self.config in - - (* keep track of batches *) - let batches = - { - traces = Batch.create (); - logs = Batch.create (); - metrics = Batch.create (); - } - in - - let send_metrics () = - let metrics = AList.pop_all gc_metrics :: Batch.pop_all batches.metrics in - B_queue.push self.send_q (To_send.Send_metric metrics) - in - - let send_logs () = - B_queue.push self.send_q (To_send.Send_logs (Batch.pop_all batches.logs)) - in - - let send_traces () = - B_queue.push self.send_q - (To_send.Send_trace (Batch.pop_all batches.traces)) - in - - try - while not (Atomic.get self.stop) do - (* read multiple events at once *) - B_queue.pop_all self.q local_q; - - (* are we asked to flush all events? *) - let must_flush_all = ref false in - - (* how to process a single event *) - let process_ev (ev : Event.t) : unit = - match ev with - | Event.E_metric m -> Batch.push batches.metrics m - | Event.E_trace tr -> Batch.push batches.traces tr - | Event.E_logs logs -> Batch.push batches.logs logs - | Event.E_tick -> - (* the only impact of "tick" is that it wakes us up regularly *) - () - | Event.E_flush_all -> must_flush_all := true - in - - Queue.iter process_ev local_q; - Queue.clear local_q; - - if !must_flush_all then ( - if Batch.len batches.metrics > 0 || not (AList.is_empty gc_metrics) - then - send_metrics (); - if Batch.len batches.logs > 0 then send_logs (); - if Batch.len batches.traces > 0 then send_traces () - ) else ( - let now = Mtime_clock.now () in - if - should_send_batch_ ~config ~now batches.metrics - ~side:(AList.get gc_metrics) - then - send_metrics (); - - if should_send_batch_ ~config ~now batches.traces then send_traces (); - if should_send_batch_ ~config ~now batches.logs then send_logs () - ) - done - with B_queue.Closed -> () - - let create ~stop ~config () : t = - let n_send_threads = max 2 config.Config.bg_threads in - let self = - { - stop; - config; - q = B_queue.create (); - send_threads = [||]; - send_q = B_queue.create (); - cleaned = Atomic.make false; - main_th = None; - } - in - - let main_th = start_bg_thread (fun () -> main_thread_loop self) in - self.main_th <- Some main_th; - - self.send_threads <- - Array.init n_send_threads (fun _i -> - start_bg_thread (fun () -> bg_thread_loop self)); - - self - - let shutdown self ~on_done : unit = - Atomic.set self.stop true; - if not (Atomic.exchange self.cleaned true) then ( - (* empty batches *) - send_event self Event.E_flush_all; - (* close the incoming queue, wait for the thread to finish - before we start cutting off the background threads, so that they - have time to receive the final batches *) - B_queue.close self.q; - Option.iter Thread.join self.main_th; - (* close send queues, then wait for all threads *) - B_queue.close self.send_q; - Array.iter Thread.join self.send_threads - ); - on_done () + Error err end -let create_backend ?(stop = Atomic.make false) - ?(config : Config.t = Config.make ()) () : (module Collector.BACKEND) = - let module M = struct - open Opentelemetry.Proto - open Opentelemetry.Collector - - let backend = Backend_impl.create ~stop ~config () - - let send_trace : Trace.resource_spans list sender = - { - send = - (fun l ~ret -> - Backend_impl.send_event backend (Event.E_trace l); - ret ()); - } - - let last_sent_metrics = Atomic.make (Mtime_clock.now ()) - - (* send metrics from time to time *) - let timeout_sent_metrics = Mtime.Span.(5 * s) - - let signal_emit_gc_metrics () = - if config.common.debug then - Printf.eprintf "opentelemetry: emit GC metrics requested\n%!"; - Atomic.set needs_gc_metrics true +module Consumer_impl = OTELC.Generic_http_consumer.Make (IO) (Notifier) (Httpc) - let additional_metrics () : Metrics.resource_metrics list = - (* add exporter metrics to the lot? *) - let last_emit = Atomic.get last_sent_metrics in - let now = Mtime_clock.now () in - let add_own_metrics = - let elapsed = Mtime.span last_emit now in - Mtime.Span.compare elapsed timeout_sent_metrics > 0 - in - - (* there is a possible race condition here, as several threads might update - metrics at the same time. But that's harmless. *) - if add_own_metrics then ( - Atomic.set last_sent_metrics now; - let open OT.Metrics in - let now_unix = OT.Timestamp_ns.now_unix_ns () in - [ - make_resource_metrics - [ - sum ~name:"otel.export.dropped" ~is_monotonic:true - [ - int ~start_time_unix_nano:now_unix ~now:now_unix - (Atomic.get n_dropped); - ]; - sum ~name:"otel.export.errors" ~is_monotonic:true - [ - int ~start_time_unix_nano:now_unix ~now:now_unix - (Atomic.get n_errors); - ]; - ]; - ] - ) else - [] - - let send_metrics : Metrics.resource_metrics list sender = - { - send = - (fun m ~ret -> - let m = List.rev_append (additional_metrics ()) m in - Backend_impl.send_event backend (Event.E_metric m); - ret ()); - } - - let send_logs : Logs.resource_logs list sender = - { - send = - (fun m ~ret -> - Backend_impl.send_event backend (Event.E_logs m); - ret ()); - } - - let on_tick_cbs_ = Atomic.make (AList.make ()) +let consumer ?(config = Config.make ()) () : + Opentelemetry_client.Consumer.any_signal_l_builder = + let n_workers = max 2 (min 32 config.bg_threads) in + let ticker_task = + if config.ticker_thread then + Some (float config.ticker_interval_ms /. 1000.) + else + None + in + Consumer_impl.consumer ~override_n_workers:n_workers ~on_tick:OTEL.Sdk.tick + ~ticker_task ~config:config.common () + +let create_exporter ?(config = Config.make ()) () : OTEL.Exporter.t = + let consumer = consumer ~config () in + let bq = + Opentelemetry_client_sync.Bounded_queue_sync.create + ~measure:OTEL.Any_signal_l.length + ~high_watermark:OTELC.Bounded_queue.Defaults.high_watermark () + in - let set_on_tick_callbacks = Atomic.set on_tick_cbs_ + OTELC.Exporter_queued.create ~clock:OTEL.Clock.ptime_clock ~q:bq ~consumer () - let tick () = - sample_gc_metrics_if_needed (); - Backend_impl.send_event backend Event.E_tick; - List.iter (fun f -> f ()) (AList.get @@ Atomic.get on_tick_cbs_) +let create_backend = create_exporter - let cleanup ~on_done () = Backend_impl.shutdown backend ~on_done - end in - (module M) +let setup_ ~config () : OTEL.Exporter.t = + let exporter = create_exporter ~config () in + OTEL.Sdk.set ~traces:config.common.traces ~metrics:config.common.metrics + ~logs:config.common.logs exporter; -(** thread that calls [tick()] regularly, to help enforce timeouts *) -let setup_ticker_thread ~stop ~sleep_ms (module B : Collector.BACKEND) () = - let sleep_s = float sleep_ms /. 1000. in - let tick_loop () = - try - while not @@ Atomic.get stop do - Thread.delay sleep_s; - B.tick () - done - with B_queue.Closed -> () - in - start_bg_thread tick_loop + Option.iter + (fun min_level -> OTEL.Self_debug.to_stderr ~min_level ()) + config.common.log_level; -let setup_ ?(stop = Atomic.make false) ?(config : Config.t = Config.make ()) () - : unit = - let backend = create_backend ~stop ~config () in - Opentelemetry.Collector.set_backend backend; + OTEL.Self_debug.log OTEL.Self_debug.Info (fun () -> + "opentelemetry: ocurl exporter installed"); - Self_trace.set_enabled config.common.self_trace; + OTELC.Self_trace.set_enabled config.common.self_trace; + if config.common.self_metrics then Opentelemetry.Sdk.setup_self_metrics (); + exporter - if config.ticker_thread then ( - (* at most a minute *) - let sleep_ms = min 60_000 (max 2 config.ticker_interval_ms) in - ignore (setup_ticker_thread ~stop ~sleep_ms backend () : Thread.t) - ) +let remove_exporter () : unit = + let open Opentelemetry_client_sync in + (* used to wait *) + let sq = Sync_queue.create () in + OTEL.Sdk.remove () ~on_done:(fun () -> Sync_queue.push sq ()); + Sync_queue.pop sq -let remove_backend () : unit = - (* we don't need the callback, this runs in the same thread *) - OT.Collector.remove_backend () ~on_done:ignore +let remove_backend = remove_exporter -let setup ?stop ?config ?(enable = true) () = - if enable then setup_ ?stop ?config () +let setup ?(config : Config.t = Config.make ()) ?(enable = true) () = + if enable && not config.common.sdk_disabled then + ignore (setup_ ~config () : OTEL.Exporter.t) -let with_setup ?stop ?config ?(enable = true) () f = - if enable then ( - setup_ ?stop ?config (); - Fun.protect ~finally:remove_backend f +let with_setup ?(after_shutdown = ignore) ?(config : Config.t = Config.make ()) + ?(enable = true) () f = + if enable && not config.common.sdk_disabled then ( + let exp = setup_ ~config () in + Fun.protect f ~finally:(fun () -> + remove_exporter (); + after_shutdown exp) ) else f () diff --git a/src/client-ocurl/opentelemetry_client_ocurl.mli b/src/client-ocurl/opentelemetry_client_ocurl.mli index 47daf805c..bc42c47c7 100644 --- a/src/client-ocurl/opentelemetry_client_ocurl.mli +++ b/src/client-ocurl/opentelemetry_client_ocurl.mli @@ -3,22 +3,19 @@ https://opentelemetry.io/docs/reference/specification/protocol/exporter/ *) -val get_headers : unit -> (string * string) list +module Config = Config -val set_headers : (string * string) list -> unit -(** Set http headers that are sent on every http query to the collector. *) +val consumer : + ?config:Config.t -> unit -> Opentelemetry_client.Consumer.any_signal_l_builder +(** Consumer that pulls from a queue *) -module Atomic = Opentelemetry_atomic.Atomic -module Config = Config +val create_exporter : ?config:Config.t -> unit -> Opentelemetry.Exporter.t +(** @since 0.90 *) -val create_backend : - ?stop:bool Atomic.t -> - ?config:Config.t -> - unit -> - (module Opentelemetry.Collector.BACKEND) +val create_backend : ?config:Config.t -> unit -> Opentelemetry.Exporter.t +[@@deprecated "use create_exporter"] -val setup : - ?stop:bool Atomic.t -> ?config:Config.t -> ?enable:bool -> unit -> unit +val setup : ?config:Config.t -> ?enable:bool -> unit -> unit (** Setup endpoint. This modifies {!Opentelemetry.Collector.backend}. @param enable actually setup the backend (default true). This can be used to @@ -28,11 +25,15 @@ val setup : an atomic boolean. When it becomes true, background threads will all stop after a little while. *) +val remove_exporter : unit -> unit +(** @since 0.90 *) + val remove_backend : unit -> unit +[@@deprecated "use remove_exporter"] (** @since 0.12 *) val with_setup : - ?stop:bool Atomic.t -> + ?after_shutdown:(Opentelemetry.Exporter.t -> unit) -> ?config:Config.t -> ?enable:bool -> unit -> diff --git a/src/client/batch.ml b/src/client/batch.ml deleted file mode 100644 index e508c09fb..000000000 --- a/src/client/batch.ml +++ /dev/null @@ -1,87 +0,0 @@ -module Otel = Opentelemetry - -type 'a t = { - mutable size: int; - mutable q: 'a list; - (** The queue is a FIFO represented as a list in reverse order *) - batch: int; (** Minimum size to batch before popping *) - high_watermark: int; (** Size above which we start dropping signals *) - timeout: Mtime.span option; - mutable start: Mtime.t; - mutex: Mutex.t; -} - -let default_high_watermark batch_size = - if batch_size = 1 then - 100 - else - batch_size * 10 - -let make ?(batch = 1) ?high_watermark ?now ?timeout () : _ t = - let high_watermark = - match high_watermark with - | Some x -> x - | None -> default_high_watermark batch - in - let start = - match now with - | Some x -> x - | None -> Mtime_clock.now () - in - let mutex = Mutex.create () in - assert (batch > 0); - { size = 0; q = []; start; batch; timeout; high_watermark; mutex } - -let timeout_expired_ ~now self : bool = - match self.timeout with - | Some t -> - let elapsed = Mtime.span now self.start in - Mtime.Span.compare elapsed t >= 0 - | None -> false - -(* Big enough to send a batch *) -let is_full_ self : bool = self.size >= self.batch - -let ready_to_pop ~force ~now self = - self.size > 0 && (force || is_full_ self || timeout_expired_ ~now self) - -let pop_if_ready ?(force = false) ~now (self : _ t) : _ list option = - let rev_batch_opt = - Otel.Util_mutex.protect self.mutex @@ fun () -> - if ready_to_pop ~force ~now self then ( - assert (self.q <> []); - let batch = self.q in - self.q <- []; - self.size <- 0; - Some batch - ) else - None - in - match rev_batch_opt with - | None -> None - | Some batch -> - (* Reverse the list to retrieve the FIFO order. *) - Some (List.rev batch) - -let rec push_unprotected (self : _ t) ~(elems : _ list) : unit = - match elems with - | [] -> () - | x :: xs -> - self.q <- x :: self.q; - self.size <- 1 + self.size; - push_unprotected self ~elems:xs - -let push (self : _ t) elems : [ `Dropped | `Ok ] = - Otel.Util_mutex.protect self.mutex @@ fun () -> - if self.size >= self.high_watermark then - (* drop this to prevent queue from growing too fast *) - `Dropped - else ( - if self.size = 0 && Option.is_some self.timeout then - (* current batch starts now *) - self.start <- Mtime_clock.now (); - - (* add to queue *) - push_unprotected self ~elems; - `Ok - ) diff --git a/src/client/bounded_queue.ml b/src/client/bounded_queue.ml new file mode 100644 index 000000000..e6ad93aba --- /dev/null +++ b/src/client/bounded_queue.ml @@ -0,0 +1,138 @@ +(** Interface for a thread-safe, bounded queue. + + After the high watermark is reached, pushing items into the queue will + instead discard them. *) + +exception Closed +(** Raised when pushing into a closed queue *) + +type 'a pop_result = + [ `Empty + | `Closed + | `Item of 'a + ] + +module Common = struct + type t = { + closed: unit -> bool; + (** Is the queue closed {b for writing}. Consumers should only use + [try_pop] because a queue that's closed-for-writing might still + contain straggler items that need to be consumed. + + This should be as fast and cheap as possible. *) + num_discarded: unit -> int; (** How many items were discarded? *) + size: unit -> int; + (** Snapshot of how many items are currently in the queue *) + high_watermark: unit -> int; (** Maximum size of the queue *) + } + + let[@inline] num_discarded self = self.num_discarded () + + let[@inline] closed (self : t) : bool = self.closed () + + let[@inline] size (self : t) : int = self.size () + + let[@inline] high_watermark self = self.high_watermark () +end + +(** Receiving side *) +module Recv = struct + type 'a t = { + on_non_empty: (unit -> unit) -> unit; + (** [on_non_empty f] registers [f] to be called whenever the queue + transitions from empty to non-empty. *) + try_pop: unit -> 'a pop_result; (** Try to pop an item right now. *) + common: Common.t; + } + + let[@inline] try_pop (self : _ t) : _ pop_result = self.try_pop () + + let[@inline] on_non_empty (self : _ t) f = self.on_non_empty f + + let[@inline] closed (self : _ t) : bool = self.common.closed () + + let[@inline] num_discarded self = self.common.num_discarded () + + let[@inline] size self = self.common.size () + + let[@inline] high_watermark self = self.common.high_watermark () + + let map (type a b) (f : a -> b) (self : a t) : b t = + { + self with + try_pop = + (fun () -> + match self.try_pop () with + | (`Closed | `Empty) as r -> r + | `Item x -> `Item (f x)); + } +end + +(** Sending side *) +module Send = struct + type 'a t = { + push: 'a list -> unit; + (** Push items. This might discard some of them. + @raise Closed if the queue is closed. *) + close: unit -> unit; + (** Close the queue. Items currently in the queue will still be + accessible to consumers until the queue is emptied out. Idempotent. + *) + common: Common.t; + } + + let[@inline] push (self : _ t) x : unit = self.push x + + let[@inline] close (self : _ t) : unit = self.close () + + let[@inline] closed (self : _ t) : bool = self.common.closed () + + let[@inline] num_discarded self = self.common.num_discarded () + + let[@inline] size self = self.common.size () + + let[@inline] high_watermark self = self.common.high_watermark () + + let map (type a b) (f : a list -> b list) (self : b t) : a t = + { + self with + push = + (fun xs -> + match f xs with + | [] -> () + | ys -> self.push ys); + } + + (** Turn the writing end of the queue into an emitter. + @param close_queue_on_close + if true, closing the emitter will close the queue *) + let to_emitter ~signal_name ~close_queue_on_close (self : 'a t) : + 'a Opentelemetry_emitter.Emitter.t = + let closed () = closed self in + let enabled () = not (closed ()) in + let emit x = if x <> [] then push self x in + let tick ~mtime:_ = () in + + (* the exporter will emit these, the queue is shared *) + let self_metrics ~now:_ () = [] in + + (* NOTE: we cannot actually flush, only close. Emptying the queue is + fundamentally asynchronous because it's done by consumers *) + let flush_and_close () = if close_queue_on_close then close self in + { signal_name; closed; enabled; emit; tick; flush_and_close; self_metrics } +end + +type 'a t = { + send: 'a Send.t; + recv: 'a Recv.t; +} +(** A bounded queue, with multiple producers and potentially multiple consumers. + + All functions must be thread-safe except for [try_pop] which might not have + to be depending on the context (e.g. a Lwt-specific queue implementation + will consume only from the Lwt thread). *) + +module Defaults = struct + (** The default high watermark *) + let high_watermark : int = 2048 +end diff --git a/src/client/client.ml b/src/client/client.ml deleted file mode 100644 index fa69c9831..000000000 --- a/src/client/client.ml +++ /dev/null @@ -1,8 +0,0 @@ -(** Utilities for writing clients - - These are used for implementing e.g., the [opentelemetry-client-cohttp-lwt] - and [opentelemetry-client-ocurl] packages package. *) - -module Config = Config -module Signal = Signal -module Self_trace = Self_trace diff --git a/src/client/common_.ml b/src/client/common_.ml new file mode 100644 index 000000000..b1872cd83 --- /dev/null +++ b/src/client/common_.ml @@ -0,0 +1,6 @@ +module OTEL = Opentelemetry +module Proto = Opentelemetry_proto + +let spf = Printf.sprintf + +let ( let@ ) = ( @@ ) diff --git a/src/client/config.ml b/src/client/config.ml deleted file mode 100644 index 6a832291c..000000000 --- a/src/client/config.ml +++ /dev/null @@ -1,169 +0,0 @@ -type t = { - debug: bool; - url_traces: string; - url_metrics: string; - url_logs: string; - headers: (string * string) list; - batch_traces: int option; - batch_metrics: int option; - batch_logs: int option; - batch_timeout_ms: int; - self_trace: bool; -} - -let pp out (self : t) : unit = - let ppiopt = Format.pp_print_option Format.pp_print_int in - let pp_header ppf (a, b) = Format.fprintf ppf "@[%s: @,%s@]@." a b in - let ppheaders = Format.pp_print_list pp_header in - let { - debug; - self_trace; - url_traces; - url_metrics; - url_logs; - headers; - batch_traces; - batch_metrics; - batch_logs; - batch_timeout_ms; - } = - self - in - Format.fprintf out - "{@[ debug=%B;@ self_trace=%B; url_traces=%S;@ url_metrics=%S;@ \ - url_logs=%S;@ headers=%a;@ batch_traces=%a;@ batch_metrics=%a;@ \ - batch_logs=%a;@ batch_timeout_ms=%d @]}" - debug self_trace url_traces url_metrics url_logs ppheaders headers ppiopt - batch_traces ppiopt batch_metrics ppiopt batch_logs batch_timeout_ms - -let default_url = "http://localhost:4318" - -type 'k make = - ?debug:bool -> - ?url:string -> - ?url_traces:string -> - ?url_metrics:string -> - ?url_logs:string -> - ?batch_traces:int option -> - ?batch_metrics:int option -> - ?batch_logs:int option -> - ?headers:(string * string) list -> - ?batch_timeout_ms:int -> - ?self_trace:bool -> - 'k - -module type ENV = sig - val get_debug : unit -> bool - - val set_debug : bool -> unit - - val get_headers : unit -> (string * string) list - - val set_headers : (string * string) list -> unit - - val make : (t -> 'a) -> 'a make -end - -module Env () : ENV = struct - let debug_ = - ref - (match Sys.getenv_opt "OTEL_OCAML_DEBUG" with - | Some ("1" | "true") -> true - | _ -> false) - - let get_debug () = !debug_ - - let set_debug b = debug_ := b - - let make_get_from_env env_name = - let value = ref None in - fun () -> - match !value with - | None -> - value := Sys.getenv_opt env_name; - !value - | Some value -> Some value - - let get_url_from_env = make_get_from_env "OTEL_EXPORTER_OTLP_ENDPOINT" - - let get_url_traces_from_env = - make_get_from_env "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" - - let get_url_metrics_from_env = - make_get_from_env "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT" - - let get_url_logs_from_env = - make_get_from_env "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT" - - let remove_trailing_slash url = - if url <> "" && String.get url (String.length url - 1) = '/' then - String.sub url 0 (String.length url - 1) - else - url - - let parse_headers s = - let parse_header s = - match String.split_on_char '=' s with - | [ key; value ] -> key, value - | _ -> failwith "Unexpected format for header" - in - String.split_on_char ',' s |> List.map parse_header - - let default_headers = [] - - let headers = - ref - (try parse_headers (Sys.getenv "OTEL_EXPORTER_OTLP_HEADERS") - with _ -> default_headers) - - let get_headers () = !headers - - let set_headers s = headers := s - - let make k ?(debug = get_debug ()) ?url ?url_traces ?url_metrics ?url_logs - ?(batch_traces = Some 400) ?(batch_metrics = Some 20) - ?(batch_logs = Some 400) ?(headers = get_headers ()) - ?(batch_timeout_ms = 2_000) ?(self_trace = false) = - (* Ensure the state is synced, in case these values are passed in explicitly *) - set_debug debug; - set_headers headers; - let url_traces, url_metrics, url_logs = - let base_url = - let base_url = - match get_url_from_env () with - | None -> Option.value url ~default:default_url - | Some url -> remove_trailing_slash url - in - remove_trailing_slash base_url - in - let url_traces = - match get_url_traces_from_env () with - | None -> Option.value url_traces ~default:(base_url ^ "/v1/traces") - | Some url -> url - in - let url_metrics = - match get_url_metrics_from_env () with - | None -> Option.value url_metrics ~default:(base_url ^ "/v1/metrics") - | Some url -> url - in - let url_logs = - match get_url_logs_from_env () with - | None -> Option.value url_logs ~default:(base_url ^ "/v1/logs") - | Some url -> url - in - url_traces, url_metrics, url_logs - in - k - { - debug; - url_traces; - url_metrics; - url_logs; - headers; - batch_traces; - batch_metrics; - batch_logs; - batch_timeout_ms; - self_trace; - } -end diff --git a/src/client/config.mli b/src/client/config.mli deleted file mode 100644 index b8d0238f9..000000000 --- a/src/client/config.mli +++ /dev/null @@ -1,130 +0,0 @@ -(** Constructing and managing the configuration needed in common by all clients -*) - -type t = private { - debug: bool; - url_traces: string; (** Url to send traces *) - url_metrics: string; (** Url to send metrics*) - url_logs: string; (** Url to send logs *) - headers: (string * string) list; - (** API headers sent to the endpoint. Default is none or - "OTEL_EXPORTER_OTLP_HEADERS" if set. *) - batch_traces: int option; - (** Batch traces? If [Some i], then this produces batches of (at most) [i] - items. If [None], there is no batching. - - Note that traces and metrics are batched separately. Default - [Some 400]. *) - batch_metrics: int option; - (** Batch metrics? If [Some i], then this produces batches of (at most) - [i] items. If [None], there is no batching. - - Note that traces and metrics are batched separately. Default [None]. - *) - batch_logs: int option; - (** Batch logs? See {!batch_metrics} for details. Default [Some 400] *) - batch_timeout_ms: int; - (** Number of milliseconds after which we will emit a batch, even - incomplete. Note that the batch might take longer than that, because - this is only checked when a new event occurs or when a tick is - emitted. Default 2_000. *) - self_trace: bool; - (** If true, the OTEL library will also emit its own spans. Default - [false]. - @since 0.7 *) -} -(** Configuration. - - To build one, use {!make} below. This might be extended with more fields in - the future. *) - -val default_url : string -(** The default base URL for the config. *) - -val pp : Format.formatter -> t -> unit - -type 'k make = - ?debug:bool -> - ?url:string -> - ?url_traces:string -> - ?url_metrics:string -> - ?url_logs:string -> - ?batch_traces:int option -> - ?batch_metrics:int option -> - ?batch_logs:int option -> - ?headers:(string * string) list -> - ?batch_timeout_ms:int -> - ?self_trace:bool -> - 'k -(** A function that gathers all the values needed to construct a {!t}, and - produces a ['k]. ['k] is typically a continuation used to construct a - configuration that includes a {!t}. - - @param url - base url used to construct per-signal urls. Per-signal url options take - precedence over this base url. If not provided, this defaults to - "OTEL_EXPORTER_OTLP_ENDPOINT" if set, or if not {!default_url}. - - Example of constructed per-signal urls with the base url - http://localhost:4318 - - Traces: http://localhost:4318/v1/traces - - Metrics: http://localhost:4318/v1/metrics - - Logs: http://localhost:4318/v1/logs - - Use per-signal url options if different urls are needed for each signal - type. - - @param url_traces - url to send traces, or "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" if set. The - url is used as-is without any modification. - - @param url_metrics - url to send metrics, or "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT" if set. The - url is used as-is without any modification. - - @param url_logs - url to send logs, or "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT" if set. The url is - used as-is without any modification. *) - -(** Construct, inspect, and update {!t} configurations, drawing defaults from - the environment and encapsulating state *) -module type ENV = sig - val get_debug : unit -> bool - - val set_debug : bool -> unit - - val get_headers : unit -> (string * string) list - - val set_headers : (string * string) list -> unit - - val make : (t -> 'a) -> 'a make - (** [make f] is a {!type:make} function that will give [f] a safely - constructed {!t}. - - Typically this is used to extend the constructor for {!t} with new - optional arguments. - - E.g., we can construct a configuration that includes a {!t} alongside a - more specific field like so: - - {[ - type extended_config = { - new_field: string; - common: t; - } - - let make : (new_field:string -> unit -> extended_config) make = - Env.make (fun common ~new_field () -> { new_field; common }) - - let _example : extended_config = - make ~new_field:"foo" ~url_traces:"foo/bar" ~debug:true () - ]} - - As a special case, we can get the simple constructor function for {!t} - with [Env.make (fun common () -> common)] *) -end - -(** A generative functor that produces a state-space that can read configuration - values from the environment, provide stateful configuration setting and - accessing operations, and a way to make a new {!t} configuration record *) -module Env : functor () -> ENV diff --git a/src/client/consumer.ml b/src/client/consumer.ml new file mode 100644 index 000000000..ec33befbb --- /dev/null +++ b/src/client/consumer.ml @@ -0,0 +1,49 @@ +(** Consumer that accepts items from a bounded queue and processes them. *) + +open Common_ + +type t = { + active: unit -> Aswitch.t; + shutdown: unit -> unit; + (** Shutdown the consumer as soon as possible. [active] will be turned off + once the consumer is fully shut down. *) + tick: unit -> unit; + (** Regularly called, eg to emit metrics, check timeouts, etc. Must be + thread safe. *) + self_metrics: clock:OTEL.Clock.t -> unit -> OTEL.Metrics.t list; + (** Self observing metrics *) +} +(** A consumer for signals of type ['a] *) + +type consumer = t + +let[@inline] active (self : t) : Aswitch.t = self.active () + +let[@inline] shutdown (self : t) : unit = self.shutdown () + +let[@inline] self_metrics ~clock self : _ list = self.self_metrics ~clock () + +(** [on_stop e f] calls [f()] when [e] stops, or now if it's already stopped *) +let on_stop self f = Aswitch.on_turn_off (self.active ()) f + +module Builder = struct + type 'a t = { start_consuming: 'a Bounded_queue.Recv.t -> consumer } + (** A builder that will create a consumer for a given queue, start the + consumer so it starts consuming from the queue, and return the consumer. + *) + + let start_consuming (self : _ t) bq = self.start_consuming bq + + let map (type a b) (f : a -> b) (self : b t) : a t = + { + start_consuming = + (fun q -> + let q = Bounded_queue.Recv.map f q in + self.start_consuming q); + } +end + +type any_signal_l_builder = OTEL.Any_signal_l.t Builder.t + +type resource_signal_builder = Resource_signal.t Builder.t +(** The type that's useful for HTTP backends *) diff --git a/src/client/dune b/src/client/dune index 095f71fa1..70e293132 100644 --- a/src/client/dune +++ b/src/client/dune @@ -1,5 +1,18 @@ (library (name opentelemetry_client) - (public_name opentelemetry.client) - (libraries opentelemetry pbrt mtime mtime.clock.os) - (synopsis "Common types and logic shared between client implementations")) + (public_name opentelemetry-client) + (flags :standard -open Opentelemetry_util -open Opentelemetry_atomic) + (libraries + opentelemetry + opentelemetry.util + opentelemetry.emitter + opentelemetry.proto + opentelemetry.domain + mtime + mtime.clock.os + unix + pbrt + yojson + threads.posix) + (synopsis + "Basic exporters, as well as common types and logic shared between exporters")) diff --git a/src/client/emitter_combine.ml b/src/client/emitter_combine.ml new file mode 100644 index 000000000..d6078bd39 --- /dev/null +++ b/src/client/emitter_combine.ml @@ -0,0 +1,43 @@ +(** Combine multiple emitters into one. *) + +open Opentelemetry_emitter.Emitter + +type closing_behavior = + [ `Close_when_all_closed + | `Close_when_one_closed + ] +(** When to close the combined emitter: + + - [`Close_when_all_closed]: closed when all the emitters that are combined + are closed + - [`Close_when_one_closed]: closed as soon as one of the emitters is closed +*) + +(** [combine_l es] is an emitter that sends signals to every emitter in [es]. + @param closing + when is this emitter closing. Default [`Close_when_all_closed]. *) +let combine_l ?(closing : closing_behavior = `Close_when_all_closed) + (es : 'a t list) : 'a t = + assert (es <> []); + let signal_name = (List.hd es).signal_name in + let closed = + fun () -> + match closing with + | `Close_when_all_closed -> List.for_all closed es + | `Close_when_one_closed -> List.exists closed es + in + let self_metrics ~now () = + List.flatten @@ List.map (fun e -> e.self_metrics ~now ()) es + in + let enabled () = not (closed ()) in + let emit x = if x <> [] then List.iter (fun e -> emit e x) es in + let tick ~mtime = List.iter (tick ~mtime) es in + let flush_and_close () = List.iter flush_and_close es in + { signal_name; self_metrics; closed; enabled; emit; tick; flush_and_close } + +let combine_l ?closing es : _ t = + match es with + | [] -> dummy + | _ -> combine_l ?closing es + +let combine e1 e2 : _ t = combine_l [ e1; e2 ] diff --git a/src/client/emitter_limit_interval.ml b/src/client/emitter_limit_interval.ml new file mode 100644 index 000000000..be6bc91a1 --- /dev/null +++ b/src/client/emitter_limit_interval.ml @@ -0,0 +1,8 @@ +open Common_.OTEL + +let add_interval_limiter il (e : _ Emitter.t) : _ Emitter.t = + let emit xs = if Interval_limiter.make_attempt il then Emitter.emit e xs in + { e with emit } + +let limit_interval ~min_interval (e : _ Emitter.t) : _ Emitter.t = + add_interval_limiter (Interval_limiter.create ~min_interval ()) e diff --git a/src/client/emitter_limit_interval.mli b/src/client/emitter_limit_interval.mli new file mode 100644 index 000000000..2777ed4c7 --- /dev/null +++ b/src/client/emitter_limit_interval.mli @@ -0,0 +1,25 @@ +(** Limit frequency at which the emitter emits. + + This puts a hard floor on the interval between two consecutive successful + [emit]. Attempts to emit too early are simply discarded. + + The use case for this is metrics: it's possible, for a gauge, to just drop + some entries if we've been emitting them too frequently. + + {b NOTE}: it's better to do [limit_interval ~min_interval (add_batching e)] + than [add_batching (limit_interval ~min_interval e)], because in the later + case we might be dismissing a whole large batch at ine + + @since 0.90 *) + +open Common_.OTEL + +val add_interval_limiter : Interval_limiter.t -> 'a Emitter.t -> 'a Emitter.t +(** [add_interval_limiter il e] is a new emitter [e'] that can only emit signals + less frequently than [Interval_limiter.min_interval il]. + + Trying to emit too early will simply drop the signal. *) + +val limit_interval : min_interval:Mtime.span -> 'a Emitter.t -> 'a Emitter.t +(** [limit_interval ~min_interval e] is + [add_interval_limiter (Interval_limiter.create ~min_interval ()) e] *) diff --git a/src/client/emitter_sample.ml b/src/client/emitter_sample.ml new file mode 100644 index 000000000..cd15ce9a0 --- /dev/null +++ b/src/client/emitter_sample.ml @@ -0,0 +1,34 @@ +open Opentelemetry_emitter + +let add_sampler (self : Sampler.t) (e : _ Emitter.t) : _ Emitter.t = + let signal_name = e.signal_name in + let enabled () = e.enabled () in + let closed () = Emitter.closed e in + let flush_and_close () = Emitter.flush_and_close e in + let tick ~mtime = Emitter.tick e ~mtime in + + let m_rate = Printf.sprintf "otel.sdk.%s.sampler.actual-rate" signal_name in + let self_metrics ~now () = + Opentelemetry_core.Metrics.( + gauge ~name:m_rate [ float ~now (Sampler.actual_rate self) ]) + :: e.self_metrics ~now () + in + + let emit l = + if l <> [] && e.enabled () then ( + let accepted = List.filter (fun _x -> Sampler.accept self) l in + if accepted <> [] then Emitter.emit e accepted + ) + in + + { + Emitter.closed; + self_metrics; + signal_name; + enabled; + flush_and_close; + tick; + emit; + } + +let sample ~proba_accept e = add_sampler (Sampler.create ~proba_accept ()) e diff --git a/src/client/emitter_sample.mli b/src/client/emitter_sample.mli new file mode 100644 index 000000000..6a0d295fd --- /dev/null +++ b/src/client/emitter_sample.mli @@ -0,0 +1,10 @@ +open Opentelemetry_emitter + +val add_sampler : Sampler.t -> 'a Emitter.t -> 'a Emitter.t +(** [add_sampler sampler e] is a new emitter that uses the [sampler] on each + individual signal before passing them to [e]. This means only + [Sampler.proba_accept sampler] of the signals will actually be emitted. *) + +val sample : proba_accept:float -> 'a Emitter.t -> 'a Emitter.t +(** [sample ~proba_accept e] is + [add_sampler (Sampler.create ~proba_accept ()) e] *) diff --git a/src/client/export_error.ml b/src/client/export_error.ml new file mode 100644 index 000000000..1522716e6 --- /dev/null +++ b/src/client/export_error.ml @@ -0,0 +1,67 @@ +(** Error that can occur during export *) + +type attempt_descr = string + +type t = + [ `Status of int * Opentelemetry.Proto.Status.status * attempt_descr + | `Failure of string + | `Sysbreak + ] + +let str_to_hex (s : string) : string = + Opentelemetry_util.Util_bytes_.bytes_to_hex (Bytes.unsafe_of_string s) + +(** Report the error on stderr. *) +let report_err ~level:(provided_level : [ `Debug | `Warning | `Auto ]) (err : t) + : unit = + let compute_level lvl = + match provided_level with + | `Debug -> Opentelemetry.Self_debug.Debug + | `Warning -> Opentelemetry.Self_debug.Warning + | `Auto -> lvl + in + match err with + | `Sysbreak -> + Opentelemetry.Self_debug.log (compute_level Info) (fun () -> + "opentelemetry: ctrl-c captured, stopping") + | `Failure msg -> + Opentelemetry.Self_debug.log (compute_level Error) (fun () -> + Printf.sprintf "opentelemetry: export failed:\n%s" msg) + | `Status + ( code, + { + Opentelemetry.Proto.Status.code = scode; + message; + details; + _presence = _; + }, + descr ) -> + Opentelemetry.Self_debug.log (compute_level Error) (fun () -> + let pp_details out l = + List.iter + (fun s -> Format.fprintf out "%S;@ " (Bytes.unsafe_to_string s)) + l + in + + Format.asprintf + "@[<2>opentelemetry: export failed with@ http code=%d@ attempt: %s@ \ + status {@[code=%ld;@ message=%S;@ details=[@[%a@]]@]}@]" + code descr scode + (Bytes.unsafe_to_string message) + pp_details details) + +let decode_invalid_http_response ~attempt_descr ~code ~url (body : string) : t = + try + let dec = Pbrt.Decoder.of_string body in + let status = Opentelemetry.Proto.Status.decode_pb_status dec in + `Status (code, status, attempt_descr) + with e -> + let bt = Printexc.get_backtrace () in + `Failure + (Printf.sprintf + "http server at %s returned code %d;\n\ + trying to decode the body as protobuf failed:\n\ + %s\n\ + raw HTTP body (hex): %s\n\ + %s" + url code (Printexc.to_string e) (str_to_hex body) bt) diff --git a/src/client/exporter_combine.ml b/src/client/exporter_combine.ml new file mode 100644 index 000000000..e715a0a51 --- /dev/null +++ b/src/client/exporter_combine.ml @@ -0,0 +1,30 @@ +(** Combine multiple exporters into one *) + +open Common_ + +let combine_l (es : OTEL.Exporter.t list) : OTEL.Exporter.t = + match es with + | [] -> OTEL.Exporter.dummy () + | _ -> + (* active turns off once all constituent exporters are off *) + let active, trigger = Aswitch.create () in + let remaining = Atomic.make (List.length es) in + List.iter + (fun e -> + Aswitch.on_turn_off (OTEL.Exporter.active e) (fun () -> + if Atomic.fetch_and_add remaining (-1) = 1 then + Aswitch.turn_off trigger)) + es; + { + OTEL.Exporter.export = + (fun sig_ -> List.iter (fun e -> e.OTEL.Exporter.export sig_) es); + active = (fun () -> active); + shutdown = (fun () -> List.iter OTEL.Exporter.shutdown es); + self_metrics = + (fun () -> + List.flatten @@ List.map (fun e -> e.OTEL.Exporter.self_metrics ()) es); + } + +(** [combine exp1 exp2] is the exporter that emits signals to both [exp1] and + [exp2]. *) +let combine exp1 exp2 : OTEL.Exporter.t = combine_l [ exp1; exp2 ] diff --git a/src/client/exporter_config.ml b/src/client/exporter_config.ml new file mode 100644 index 000000000..07e23e8f7 --- /dev/null +++ b/src/client/exporter_config.ml @@ -0,0 +1,390 @@ +type protocol = + | Http_protobuf + | Http_json + +type log_level = Opentelemetry.Self_debug.level option + +type rest = unit + +type t = { + debug: bool; + log_level: log_level; + sdk_disabled: bool; + url_traces: string; + url_metrics: string; + url_logs: string; + headers: (string * string) list; + headers_traces: (string * string) list; + headers_metrics: (string * string) list; + headers_logs: (string * string) list; + protocol: protocol; + timeout_ms: int; + timeout_traces_ms: int; + timeout_metrics_ms: int; + timeout_logs_ms: int; + traces: Opentelemetry.Provider_config.t; + metrics: Opentelemetry.Provider_config.t; + logs: Opentelemetry.Provider_config.t; + self_trace: bool; + self_metrics: bool; + http_concurrency_level: int option; + retry_max_attempts: int; + retry_initial_delay_ms: float; + retry_max_delay_ms: float; + retry_backoff_multiplier: float; + _rest: rest; +} + +open struct + let ppiopt out i = + match i with + | None -> Format.fprintf out "None" + | Some i -> Format.fprintf out "%d" i + + let pp_header ppf (a, b) = Format.fprintf ppf "@[%s: @,%s@]@." a b + + let ppheaders out l = + Format.fprintf out "[@[%a@]]" (Format.pp_print_list pp_header) l + + let pp_protocol out = function + | Http_protobuf -> Format.fprintf out "http/protobuf" + | Http_json -> Format.fprintf out "http/json" + + let pp_log_level out = function + | None -> Format.fprintf out "none" + | Some level -> + Format.fprintf out "%s" (Opentelemetry.Self_debug.string_of_level level) + + let pp_provider_config out (c : Opentelemetry.Provider_config.t) = + Format.fprintf out "{batch=%a;@ timeout=%a}" ppiopt c.batch Mtime.Span.pp + c.timeout +end + +let pp out (self : t) : unit = + let { + debug; + log_level; + sdk_disabled; + self_trace; + self_metrics; + url_traces; + url_metrics; + url_logs; + headers; + headers_traces; + headers_metrics; + headers_logs; + protocol; + timeout_ms; + timeout_traces_ms; + timeout_metrics_ms; + timeout_logs_ms; + traces; + metrics; + logs; + http_concurrency_level; + retry_max_attempts; + retry_initial_delay_ms; + retry_max_delay_ms; + retry_backoff_multiplier; + _rest = _; + } = + self + in + Format.fprintf out + "{@[ debug=%B;@ log_level=%a;@ sdk_disabled=%B;@ self_trace=%B;@ \ + self_metrics=%B;@ url_traces=%S;@ url_metrics=%S;@ url_logs=%S;@ \ + @[<2>headers=@,\ + %a@];@ @[<2>headers_traces=@,\ + %a@];@ @[<2>headers_metrics=@,\ + %a@];@ @[<2>headers_logs=@,\ + %a@];@ protocol=%a;@ timeout_ms=%d;@ timeout_traces_ms=%d;@ \ + timeout_metrics_ms=%d;@ timeout_logs_ms=%d;@ traces=%a;@ metrics=%a;@ \ + logs=%a;@ http_concurrency_level=%a;@ retry_max_attempts=%d;@ \ + retry_initial_delay_ms=%.0f;@ retry_max_delay_ms=%.0f;@ \ + retry_backoff_multiplier=%.1f @]}" + debug pp_log_level log_level sdk_disabled self_trace self_metrics url_traces + url_metrics url_logs ppheaders headers ppheaders headers_traces ppheaders + headers_metrics ppheaders headers_logs pp_protocol protocol timeout_ms + timeout_traces_ms timeout_metrics_ms timeout_logs_ms pp_provider_config + traces pp_provider_config metrics pp_provider_config logs ppiopt + http_concurrency_level retry_max_attempts retry_initial_delay_ms + retry_max_delay_ms retry_backoff_multiplier + +let default_url = "http://localhost:4318" + +type 'k make = + ?debug:bool -> + ?log_level:log_level -> + ?sdk_disabled:bool -> + ?url:string -> + ?url_traces:string -> + ?url_metrics:string -> + ?url_logs:string -> + ?batch_traces:int -> + ?batch_metrics:int -> + ?batch_logs:int -> + ?batch_timeout_ms:int -> + ?traces:Opentelemetry.Provider_config.t -> + ?metrics:Opentelemetry.Provider_config.t -> + ?logs:Opentelemetry.Provider_config.t -> + ?headers:(string * string) list -> + ?headers_traces:(string * string) list -> + ?headers_metrics:(string * string) list -> + ?headers_logs:(string * string) list -> + ?protocol:protocol -> + ?timeout_ms:int -> + ?timeout_traces_ms:int -> + ?timeout_metrics_ms:int -> + ?timeout_logs_ms:int -> + ?self_trace:bool -> + ?self_metrics:bool -> + ?http_concurrency_level:int -> + ?retry_max_attempts:int -> + ?retry_initial_delay_ms:float -> + ?retry_max_delay_ms:float -> + ?retry_backoff_multiplier:float -> + 'k + +module type ENV = sig + val make : (t -> 'a) -> 'a make +end + +open struct + let get_debug_from_env () = + match Sys.getenv_opt "OTEL_OCAML_DEBUG" with + | Some ("1" | "true") -> true + | _ -> false + + let get_log_level_from_env () : log_level = + match Sys.getenv_opt "OTEL_LOG_LEVEL" with + | Some "none" -> None + | Some "error" -> Some Error + | Some "warn" -> Some Warning + | Some "info" -> Some Info + | Some "debug" -> Some Debug + | Some s -> + Opentelemetry.Self_debug.log Warning (fun () -> + Printf.sprintf "unknown log level %S, defaulting to info" s); + Some Info + | None -> + if get_debug_from_env () then + Some Debug + else + Some Info + + let get_sdk_disabled_from_env () = + match Sys.getenv_opt "OTEL_SDK_DISABLED" with + | Some ("true" | "1") -> true + | _ -> false + + let get_protocol_from_env env_name = + match Sys.getenv_opt env_name with + | Some "http/protobuf" -> Http_protobuf + | Some "http/json" -> Http_json + | _ -> Http_protobuf + + let get_timeout_from_env env_name default = + match Sys.getenv_opt env_name with + | Some s -> (try int_of_string s with _ -> default) + | None -> default + + let make_get_from_env env_name = + let value = ref None in + fun () -> + match !value with + | None -> + value := Sys.getenv_opt env_name; + !value + | Some value -> Some value + + let get_url_from_env = make_get_from_env "OTEL_EXPORTER_OTLP_ENDPOINT" + + let get_url_traces_from_env = + make_get_from_env "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" + + let get_url_metrics_from_env = + make_get_from_env "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT" + + let get_url_logs_from_env = + make_get_from_env "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT" + + let remove_trailing_slash url = + if url <> "" && String.get url (String.length url - 1) = '/' then + String.sub url 0 (String.length url - 1) + else + url + + let parse_headers s = + let parse_header s = + match String.split_on_char '=' s with + | [ key; value ] -> key, value + | _ -> failwith "Unexpected format for header" + in + String.split_on_char ',' s |> List.map parse_header + + let get_headers_from_env env_name = + try parse_headers (Sys.getenv env_name) with _ -> [] + + let get_general_headers_from_env () = + try parse_headers (Sys.getenv "OTEL_EXPORTER_OTLP_HEADERS") with _ -> [] +end + +module Env () : ENV = struct + let merge_headers base specific = + (* Signal-specific headers override generic ones *) + let specific_keys = List.map fst specific in + let filtered_base = + List.filter (fun (k, _) -> not (List.mem k specific_keys)) base + in + List.rev_append specific filtered_base + + let make k ?(debug = get_debug_from_env ()) + ?(log_level = get_log_level_from_env ()) + ?(sdk_disabled = get_sdk_disabled_from_env ()) ?url ?url_traces + ?url_metrics ?url_logs ?batch_traces ?batch_metrics ?batch_logs + ?(batch_timeout_ms = 2_000) ?traces ?metrics ?logs + ?(headers = get_general_headers_from_env ()) ?headers_traces + ?headers_metrics ?headers_logs + ?(protocol = get_protocol_from_env "OTEL_EXPORTER_OTLP_PROTOCOL") + ?(timeout_ms = get_timeout_from_env "OTEL_EXPORTER_OTLP_TIMEOUT" 10_000) + ?timeout_traces_ms ?timeout_metrics_ms ?timeout_logs_ms + ?(self_trace = false) ?(self_metrics = false) ?http_concurrency_level + ?(retry_max_attempts = 3) ?(retry_initial_delay_ms = 100.) + ?(retry_max_delay_ms = 5000.) ?(retry_backoff_multiplier = 2.0) = + let batch_timeout_ = Mtime.Span.(batch_timeout_ms * ms) in + let traces = + match traces with + | Some t -> t + | None -> + let batch = + match batch_traces with + | Some b -> b + | None -> get_timeout_from_env "OTEL_BSP_MAX_EXPORT_BATCH_SIZE" 400 + in + Opentelemetry.Provider_config.make ~batch ~timeout:batch_timeout_ () + in + let metrics = + match metrics with + | Some m -> m + | None -> + let batch = + match batch_metrics with + | Some b -> b + | None -> get_timeout_from_env "OTEL_METRIC_EXPORT_INTERVAL" 200 + in + Opentelemetry.Provider_config.make ~batch ~timeout:batch_timeout_ () + in + let logs = + match logs with + | Some l -> l + | None -> + let batch = Option.value batch_logs ~default:400 in + Opentelemetry.Provider_config.make ~batch ~timeout:batch_timeout_ () + in + + let url_traces, url_metrics, url_logs = + let base_url = + let base_url = + match get_url_from_env () with + | None -> Option.value url ~default:default_url + | Some url -> remove_trailing_slash url + in + remove_trailing_slash base_url + in + let url_traces = + match get_url_traces_from_env () with + | None -> Option.value url_traces ~default:(base_url ^ "/v1/traces") + | Some url -> url + in + let url_metrics = + match get_url_metrics_from_env () with + | None -> Option.value url_metrics ~default:(base_url ^ "/v1/metrics") + | Some url -> url + in + let url_logs = + match get_url_logs_from_env () with + | None -> Option.value url_logs ~default:(base_url ^ "/v1/logs") + | Some url -> url + in + url_traces, url_metrics, url_logs + in + + (* Get per-signal headers from env vars *) + let env_headers_traces = + get_headers_from_env "OTEL_EXPORTER_OTLP_TRACES_HEADERS" + in + let env_headers_metrics = + get_headers_from_env "OTEL_EXPORTER_OTLP_METRICS_HEADERS" + in + let env_headers_logs = + get_headers_from_env "OTEL_EXPORTER_OTLP_LOGS_HEADERS" + in + + (* Merge with provided headers, env-specific takes precedence *) + let headers_traces = + match headers_traces with + | Some h -> h + | None -> merge_headers headers env_headers_traces + in + let headers_metrics = + match headers_metrics with + | Some h -> h + | None -> merge_headers headers env_headers_metrics + in + let headers_logs = + match headers_logs with + | Some h -> h + | None -> merge_headers headers env_headers_logs + in + + (* Get per-signal timeouts from env vars with fallback to general timeout *) + let timeout_traces_ms = + match timeout_traces_ms with + | Some t -> t + | None -> + get_timeout_from_env "OTEL_EXPORTER_OTLP_TRACES_TIMEOUT" timeout_ms + in + let timeout_metrics_ms = + match timeout_metrics_ms with + | Some t -> t + | None -> + get_timeout_from_env "OTEL_EXPORTER_OTLP_METRICS_TIMEOUT" timeout_ms + in + let timeout_logs_ms = + match timeout_logs_ms with + | Some t -> t + | None -> + get_timeout_from_env "OTEL_EXPORTER_OTLP_LOGS_TIMEOUT" timeout_ms + in + + k + { + debug; + log_level; + sdk_disabled; + url_traces; + url_metrics; + url_logs; + headers; + headers_traces; + headers_metrics; + headers_logs; + protocol; + timeout_ms; + timeout_traces_ms; + timeout_metrics_ms; + timeout_logs_ms; + traces; + metrics; + logs; + self_trace; + self_metrics; + http_concurrency_level; + retry_max_attempts; + retry_initial_delay_ms; + retry_max_delay_ms; + retry_backoff_multiplier; + _rest = (); + } +end diff --git a/src/client/exporter_config.mli b/src/client/exporter_config.mli new file mode 100644 index 000000000..2567e72dc --- /dev/null +++ b/src/client/exporter_config.mli @@ -0,0 +1,200 @@ +(** Constructing and managing the configuration common to many (most?) + HTTP-based clients. + + This is extended and reused by concrete client implementations that exports + signals over HTTP, depending on their needs. *) + +type protocol = + | Http_protobuf + | Http_json + +type log_level = Opentelemetry.Self_debug.level option +(** [None] disables internal diagnostic logging; [Some level] enables it at that + level and above. Maps to [OTEL_LOG_LEVEL] env var. *) + +type rest +(** opaque type to force using {!make} while allowing record updates *) + +type t = { + debug: bool; [@alert deprecated "Use log_level instead"] + (** @deprecated Use {!log_level} instead. Debug the client itself? *) + log_level: log_level; + (** Log level for internal diagnostics. Read from OTEL_LOG_LEVEL or falls + back to OTEL_OCAML_DEBUG for compatibility. *) + sdk_disabled: bool; + (** If true, the SDK is completely disabled and no-ops. Read from + OTEL_SDK_DISABLED. Default false. *) + url_traces: string; (** Url to send traces/spans *) + url_metrics: string; (** Url to send metrics*) + url_logs: string; (** Url to send logs *) + headers: (string * string) list; + (** Global API headers sent to all endpoints. Default is none or + "OTEL_EXPORTER_OTLP_HEADERS" if set. Signal-specific headers can + override these. *) + headers_traces: (string * string) list; + (** Headers for traces endpoint. Merges OTEL_EXPORTER_OTLP_HEADERS with + OTEL_EXPORTER_OTLP_TRACES_HEADERS (signal-specific takes precedence). + *) + headers_metrics: (string * string) list; + (** Headers for metrics endpoint. Merges OTEL_EXPORTER_OTLP_HEADERS with + OTEL_EXPORTER_OTLP_METRICS_HEADERS (signal-specific takes precedence). + *) + headers_logs: (string * string) list; + (** Headers for logs endpoint. Merges OTEL_EXPORTER_OTLP_HEADERS with + OTEL_EXPORTER_OTLP_LOGS_HEADERS (signal-specific takes precedence). *) + protocol: protocol; + (** Wire protocol to use. Read from OTEL_EXPORTER_OTLP_PROTOCOL. Default + Http_protobuf. *) + timeout_ms: int; + (** General timeout in milliseconds for exporter operations. Read from + OTEL_EXPORTER_OTLP_TIMEOUT. Default 10_000. *) + timeout_traces_ms: int; + (** Timeout for trace exports. Read from + OTEL_EXPORTER_OTLP_TRACES_TIMEOUT, falls back to timeout_ms. *) + timeout_metrics_ms: int; + (** Timeout for metric exports. Read from + OTEL_EXPORTER_OTLP_METRICS_TIMEOUT, falls back to timeout_ms. *) + timeout_logs_ms: int; + (** Timeout for log exports. Read from OTEL_EXPORTER_OTLP_LOGS_TIMEOUT, + falls back to timeout_ms. *) + traces: Opentelemetry.Provider_config.t; + (** Per-provider batching config for traces. Default: batch=400, + timeout=2s. The batch size is read from OTEL_BSP_MAX_EXPORT_BATCH_SIZE + if set. *) + metrics: Opentelemetry.Provider_config.t; + (** Per-provider batching config for metrics. Default: batch=200, + timeout=2s. The batch size is read from OTEL_METRIC_EXPORT_INTERVAL if + set. *) + logs: Opentelemetry.Provider_config.t; + (** Per-provider batching config for logs. Default: batch=400, timeout=2s. + *) + self_trace: bool; + (** If true, the OTEL library will perform some self-instrumentation. + Default [false]. + @since 0.7 *) + self_metrics: bool; + (** If true, the OTEL library will regularly emit metrics about itself. + Default [false]. + @since 0.90 *) + http_concurrency_level: int option; + (** How many HTTP requests can be done simultaneously (at most)? This can + be used to represent the size of a pool of workers where each worker + gets a batch to send, send it, and repeats. + @since 0.90 *) + retry_max_attempts: int; + (** Maximum number of retry attempts for failed exports. 0 means no retry, + 1 means one retry after initial failure. Default 3. *) + retry_initial_delay_ms: float; + (** Initial delay in milliseconds before first retry. Default 100ms. *) + retry_max_delay_ms: float; + (** Maximum delay in milliseconds between retries. Default 5000ms. *) + retry_backoff_multiplier: float; + (** Multiplier for exponential backoff. Default 2.0. *) + _rest: rest; +} +(** Configuration. + + To build one, use {!make} below. This might be extended with more fields in + the future. *) + +val default_url : string +(** The default base URL for the config. *) + +val pp : Format.formatter -> t -> unit + +type 'k make = + ?debug:bool -> + ?log_level:log_level -> + ?sdk_disabled:bool -> + ?url:string -> + ?url_traces:string -> + ?url_metrics:string -> + ?url_logs:string -> + ?batch_traces:int -> + ?batch_metrics:int -> + ?batch_logs:int -> + ?batch_timeout_ms:int -> + ?traces:Opentelemetry.Provider_config.t -> + ?metrics:Opentelemetry.Provider_config.t -> + ?logs:Opentelemetry.Provider_config.t -> + ?headers:(string * string) list -> + ?headers_traces:(string * string) list -> + ?headers_metrics:(string * string) list -> + ?headers_logs:(string * string) list -> + ?protocol:protocol -> + ?timeout_ms:int -> + ?timeout_traces_ms:int -> + ?timeout_metrics_ms:int -> + ?timeout_logs_ms:int -> + ?self_trace:bool -> + ?self_metrics:bool -> + ?http_concurrency_level:int -> + ?retry_max_attempts:int -> + ?retry_initial_delay_ms:float -> + ?retry_max_delay_ms:float -> + ?retry_backoff_multiplier:float -> + 'k +(** A function that gathers all the values needed to construct a {!t}, and + produces a ['k]. ['k] is typically a continuation used to construct a + configuration that includes a {!t}. + + @param url + base url used to construct per-signal urls. Per-signal url options take + precedence over this base url. If not provided, this defaults to + "OTEL_EXPORTER_OTLP_ENDPOINT" if set, or if not {!default_url}. + + Example of constructed per-signal urls with the base url + http://localhost:4318 + - Traces: http://localhost:4318/v1/traces + - Metrics: http://localhost:4318/v1/metrics + - Logs: http://localhost:4318/v1/logs + + Use per-signal url options if different urls are needed for each signal + type. + + @param url_traces + url to send traces, or "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" if set. The + url is used as-is without any modification. + + @param url_metrics + url to send metrics, or "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT" if set. The + url is used as-is without any modification. + + @param url_logs + url to send logs, or "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT" if set. The url is + used as-is without any modification. *) + +(** Construct, inspect, and update {!t} configurations, drawing defaults from + the environment *) +module type ENV = sig + val make : (t -> 'a) -> 'a make + (** [make f] is a {!type:make} function that will give [f] a safely + constructed {!t}. + + Typically this is used to extend the constructor for {!t} with new + optional arguments. + + E.g., we can construct a configuration that includes a {!t} alongside a + more specific field like so: + + {[ + type extended_config = { + new_field: string; + common: t; + } + + let make : (new_field:string -> unit -> extended_config) make = + Env.make (fun common ~new_field () -> { new_field; common }) + + let _example : extended_config = + make ~new_field:"foo" ~url_traces:"foo/bar" ~debug:true () + ]} + + As a special case, we can get the simple constructor function for {!t} + with [Env.make (fun common () -> common)] *) +end + +(** A generative functor that produces a state-space that can read configuration + values from the environment, provide stateful configuration setting and + accessing operations, and a way to make a new {!t} configuration record *) +module Env : functor () -> ENV diff --git a/src/client/exporter_debug.ml b/src/client/exporter_debug.ml new file mode 100644 index 000000000..047ac9302 --- /dev/null +++ b/src/client/exporter_debug.ml @@ -0,0 +1,32 @@ +(** Basic debug exporter, prints signals on stdout/stderr/... + + As the name says, it's not intended for production but as a quick way to + export signals and eyeball them. *) + +open Common_ + +(** [debug ?out ()] is an exporter that pretty-prints signals on [out]. + @param out the formatter into which to print, default [stderr]. *) +let debug ?(clock = OTEL.Clock.ptime_clock) ?(out = Format.err_formatter) () : + OTEL.Exporter.t = + ignore clock; + let open Proto in + { + OTEL.Exporter.export = + (fun sig_ -> + match sig_ with + | OTEL.Any_signal_l.Spans sp -> + List.iter (Format.fprintf out "SPAN: %a@." Trace.pp_span) sp + | OTEL.Any_signal_l.Metrics ms -> + List.iter (Format.fprintf out "METRIC: %a@." Metrics.pp_metric) ms + | OTEL.Any_signal_l.Logs logs -> + List.iter + (Format.fprintf out "LOG: %a@." Proto.Logs.pp_log_record) + logs); + active = (fun () -> Aswitch.dummy); + shutdown = + (fun () -> + Format.fprintf out "CLEANUP@."; + ()); + self_metrics = (fun () -> []); + } diff --git a/src/client/exporter_queued.ml b/src/client/exporter_queued.ml new file mode 100644 index 000000000..9956c9a04 --- /dev/null +++ b/src/client/exporter_queued.ml @@ -0,0 +1,60 @@ +(** Build an exporter from a queue and a consumer. + + The exporter will send signals into the queue (possibly dropping them if the + queue is full), and the consumer is responsible for actually exporting the + signals it reads from the other end of the queue. + + At shutdown time, the queue is closed for writing, but only once it's empty + will the consumer properly shutdown. *) + +open Common_ +module BQ = Bounded_queue + +(** Pair a queue with a consumer to build an exporter. + + The resulting exporter will emit logs, spans, and traces directly into the + bounded queue; while the consumer takes them from the queue to forward them + somewhere else, store them, etc. + @param resource_attributes attributes added to every "resource" batch *) +let create ~clock ~(q : OTEL.Any_signal_l.t Bounded_queue.t) + ~(consumer : Consumer.any_signal_l_builder) () : OTEL.Exporter.t = + let shutdown_started = Atomic.make false in + let active, trigger = Aswitch.create () in + let consumer = consumer.start_consuming q.recv in + + let self_metrics () : _ list = + let now = OTEL.Clock.now clock in + let m_size = + OTEL.Metrics.gauge ~name:"otel.sdk.exporter.queue.size" + [ OTEL.Metrics.int ~now (Bounded_queue.Recv.size q.recv) ] + and m_cap = + OTEL.Metrics.gauge ~name:"otel.sdk.exporter.queue.capacity" + [ OTEL.Metrics.int ~now (Bounded_queue.Recv.high_watermark q.recv) ] + and m_discarded = + OTEL.Metrics.sum ~is_monotonic:true + ~name:"otel.sdk.exporter_queue.discarded" + [ OTEL.Metrics.int ~now (Bounded_queue.Recv.num_discarded q.recv) ] + in + m_size :: m_cap :: m_discarded :: Consumer.self_metrics consumer ~clock + in + + let export (sig_ : OTEL.Any_signal_l.t) = + if Aswitch.is_on active then BQ.Send.push q.send [ sig_ ] + in + + let shutdown () = + if Aswitch.is_on active && not (Atomic.exchange shutdown_started true) then ( + (* first, prevent further pushes to the queue. Consumer workers + can still drain it. *) + Bounded_queue.Send.close q.send; + + (* shutdown consumer; once it's down it'll turn our switch off too *) + Aswitch.link (Consumer.active consumer) trigger; + Consumer.shutdown consumer + ) + in + + (* if consumer shuts down for some reason, we also must *) + Aswitch.on_turn_off (Consumer.active consumer) shutdown; + + { OTEL.Exporter.export; active = (fun () -> active); self_metrics; shutdown } diff --git a/src/client/exporter_stdout.ml b/src/client/exporter_stdout.ml new file mode 100644 index 000000000..25a900a6d --- /dev/null +++ b/src/client/exporter_stdout.ml @@ -0,0 +1,63 @@ +(** A simple exporter that prints on stdout. *) + +open Common_ + +open struct + let pp_span out (sp : OTEL.Span.t) = + let open OTEL in + Format.fprintf out + "@[<2>SPAN {@ trace_id: %a@ span_id: %a@ name: %S@ start: %a@ end: %a@ \ + dur: %.6fs@]}" + Trace_id.pp + (Trace_id.of_bytes sp.trace_id) + Span_id.pp + (Span_id.of_bytes sp.span_id) + sp.name Timestamp_ns.pp_debug sp.start_time_unix_nano + Timestamp_ns.pp_debug sp.end_time_unix_nano + ((Int64.to_float sp.end_time_unix_nano + -. Int64.to_float sp.start_time_unix_nano) + /. 1e9) + + let pp_log out l = + Format.fprintf out "@[<2>LOG %a@]" Proto.Logs.pp_log_record l + + let pp_metric out m = + Format.fprintf out "@[<2>METRICS %a@]" Proto.Metrics.pp_metric m + + let pp_vlist mutex pp out l = + if l != [] then ( + let@ () = Util_mutex.protect mutex in + Format.fprintf out "@["; + List.iteri + (fun i x -> + if i > 0 then Format.fprintf out "@,"; + pp out x) + l; + Format.fprintf out "@]@." + ) +end + +let stdout ?(clock = OTEL.Clock.ptime_clock) () : OTEL.Exporter.t = + let open Opentelemetry_util in + ignore clock; + let out = Format.std_formatter in + let mutex = Mutex.create () in + + let export (sig_ : OTEL.Any_signal_l.t) = + match sig_ with + | OTEL.Any_signal_l.Spans sp -> pp_vlist mutex pp_span out sp + | OTEL.Any_signal_l.Logs logs -> pp_vlist mutex pp_log out logs + | OTEL.Any_signal_l.Metrics ms -> pp_vlist mutex pp_metric out ms + in + + let shutdown () = + let@ () = Util_mutex.protect mutex in + Format.pp_print_flush out () + in + + { + OTEL.Exporter.export; + active = (fun () -> Aswitch.dummy); + shutdown; + self_metrics = (fun () -> []); + } diff --git a/src/client/generic_consumer.ml b/src/client/generic_consumer.ml new file mode 100644 index 000000000..eadf09865 --- /dev/null +++ b/src/client/generic_consumer.ml @@ -0,0 +1,254 @@ +(** A consumer: pulls signals from a queue, sends them somewhere else *) + +open Common_ + +type error = Export_error.t + +(** Number of errors met during export *) +let n_errors = Atomic.make 0 + +module type IO = Generic_io.S_WITH_CONCURRENCY + +(** Generic sender: where to send signals *) +module type SENDER = sig + module IO : IO + + type t + (** Sender state *) + + type config + + val create : config:config -> unit -> t + + val cleanup : t -> unit + (** Cleanup resources once we are done. The sender cannot be used anymore + after this is called on it *) + + val send : t -> OTEL.Any_signal_l.t -> (unit, error) result IO.t +end + +module Make + (IO : IO) + (Notifier : Generic_notifier.S with type 'a IO.t = 'a IO.t) + (Sender : SENDER with type 'a IO.t = 'a IO.t) : sig + val consumer : + sender_config:Sender.config -> + n_workers:int -> + ticker_task:float option -> + ?on_tick:(unit -> unit) -> + unit -> + Consumer.any_signal_l_builder + (** Make a consumer builder, ie. a builder function that will take a bounded + queue of signals, and start a consumer to process these signals and send + them somewhere using HTTP. *) +end = struct + open IO + + type config = { + n_workers: int; + ticker_task: float option; + on_tick: unit -> unit; + } + + type status = + | Active + | Shutting_down + | Stopped + + type state = { + active: Aswitch.t; (** Public facing switch *) + q: OTEL.Any_signal_l.t Bounded_queue.Recv.t; + status: status Atomic.t; + (** Internal status, including the shutting down process *) + notify: Notifier.t; + n_workers: int Atomic.t; (** Current number of workers *) + active_trigger: Aswitch.trigger; + config: config; + sender_config: Sender.config; + m_spans: int Atomic.t; + m_logs: int Atomic.t; + } + + let shutdown self : unit = + let old_status = + Util_atomic.update_cas self.status @@ fun status -> + match status with + | Stopped -> status, status + | Shutting_down -> status, status + | Active -> status, Shutting_down + in + + match old_status with + | Stopped -> () + | Shutting_down -> + (* last worker to stop will call [on_done] *) + () + | Active -> + (* notify potentially asleep workers *) + Notifier.trigger self.notify; + Notifier.delete self.notify + + let tick (self : state) = + if Aswitch.is_on self.active then Notifier.trigger self.notify + + (** Shutdown one worker, when the queue is closed *) + let shutdown_worker (self : state) : unit = + if Atomic.fetch_and_add self.n_workers (-1) = 1 then ( + (* we were the last worker, we can shut down the whole consumer *) + Atomic.set self.status Stopped; + Aswitch.turn_off self.active_trigger; + + (* sanity check about the queue, which should be drained *) + let size_q = Bounded_queue.Recv.size self.q in + if size_q > 0 then + OTEL.Self_debug.log OTEL.Self_debug.Warning (fun () -> + Printf.sprintf + "otel: warning: workers exited but work queue still contains %d \ + elements" + size_q) + ) + + let send_signals (self : state) (sender : Sender.t) ~backoff + (sigs : OTEL.Any_signal_l.t) : unit IO.t = + (match sigs with + | Spans l -> + ignore (Atomic.fetch_and_add self.m_spans (List.length l) : int) + | Logs l -> ignore (Atomic.fetch_and_add self.m_logs (List.length l) : int) + | Metrics _l -> ()); + + let* r = Sender.send sender sigs in + match r with + | Ok () -> + Util_net_backoff.on_success backoff; + IO.return () + | Error `Sysbreak -> + OTEL.Self_debug.log OTEL.Self_debug.Info (fun () -> + "ctrl-c captured, stopping"); + shutdown self; + IO.return () + | Error err -> + Atomic.incr n_errors; + Export_error.report_err ~level:`Auto err; + (* avoid crazy error loop *) + let dur_s = Util_net_backoff.on_error backoff in + IO.sleep_s (dur_s +. Random.float (dur_s /. 10.)) + + let start_worker (self : state) : unit = + let sender = Sender.create ~config:self.sender_config () in + let backoff = Util_net_backoff.create () in + OTEL.Self_debug.log OTEL.Self_debug.Debug (fun () -> "otel worker started"); + + (* loop on [q] *) + let rec loop () : unit IO.t = + (* first look at the queue, to drain it *) + match Bounded_queue.Recv.try_pop self.q with + | `Closed -> + (* this worker shuts down, others might still be busy *) + shutdown_worker self; + IO.return () + | `Item sigs -> + let* () = send_signals ~backoff self sender sigs in + loop () + | `Empty -> + (* Printf.eprintf "worker %d: empty queue\n%!" tid; *) + (match Atomic.get self.status with + | Stopped -> + assert false + (* shouldn't happen without us going through [Shutting_down] *) + | Shutting_down -> + shutdown_worker self; + IO.return () + | Active -> + let* () = + Notifier.wait self.notify ~should_keep_waiting:(fun () -> + Bounded_queue.Recv.size self.q = 0 + && Atomic.get self.status = Active) + in + loop ()) + in + + IO.spawn (fun () -> + IO.protect loop ~finally:(fun () -> + Sender.cleanup sender; + IO.return ())) + + let start_ticker (self : state) ~(interval_s : float) : unit = + let rec loop () : unit IO.t = + match Atomic.get self.status with + | Stopped | Shutting_down -> IO.return () + | Active -> + let* () = IO.sleep_s interval_s in + if Aswitch.is_on self.active then ( + tick self; + self.config.on_tick () + ); + loop () + in + IO.spawn loop + + let create_state ~sender_config ~n_workers ~ticker_task ~on_tick ~q () : state + = + let active, active_trigger = Aswitch.create () in + let config = { n_workers; ticker_task; on_tick } in + let self = + { + active; + active_trigger; + status = Atomic.make Active; + n_workers = Atomic.make 0; + q; + notify = Notifier.create (); + config; + sender_config; + m_spans = Atomic.make 0; + m_logs = Atomic.make 0; + } + in + + (* start workers *) + let n_workers = max 2 (min 500 self.config.n_workers) in + + ignore (Atomic.fetch_and_add self.n_workers n_workers : int); + for _i = 1 to n_workers do + start_worker self + done; + + Notifier.register_bounded_queue self.notify q; + + (* start ticker *) + (match self.config.ticker_task with + | None -> () + | Some interval_s -> start_ticker self ~interval_s); + + self + + let self_metrics ~clock (self : state) : OTEL.Metrics.t list = + let open OTEL.Metrics in + let now = OTEL.Clock.now clock in + let attrs = [ "otel.component.name", `String "otel_ocaml" ] in + [ + sum ~name:"otel.sdk.exporter.errors" ~is_monotonic:true + [ int ~now (Atomic.get n_errors) ~attrs ]; + sum ~name:"otel.sdk.exporter.span.exported" ~is_monotonic:true + [ int ~now (Atomic.get self.m_spans) ~attrs ]; + sum ~name:"otel.sdk.exporter.log.exported" ~is_monotonic:true + [ int ~now (Atomic.get self.m_logs) ~attrs ]; + ] + + let to_consumer (self : state) : Consumer.t = + let shutdown () = shutdown self in + let tick () = tick self in + let self_metrics ~clock () = self_metrics self ~clock in + { active = (fun () -> self.active); tick; shutdown; self_metrics } + + let consumer ~sender_config ~n_workers ~ticker_task ?(on_tick = ignore) () : + Consumer.any_signal_l_builder = + { + start_consuming = + (fun q -> + let st = + create_state ~sender_config ~n_workers ~ticker_task ~on_tick ~q () + in + to_consumer st); + } +end diff --git a/src/client/generic_consumer_exporter.ml b/src/client/generic_consumer_exporter.ml new file mode 100644 index 000000000..10355dc62 --- /dev/null +++ b/src/client/generic_consumer_exporter.ml @@ -0,0 +1,131 @@ +(** A consumer that just calls another exporter. + + This is useful to introduce queueing behavior using {!Exporter_queued}, but + simply forwarding to another (presumably non-queue) exporter. + + It is generic because we need some sort of threading/concurrency to run the + consumer. *) + +open Common_ + +module type IO = Generic_io.S_WITH_CONCURRENCY + +module Make + (IO : IO) + (Notifier : Generic_notifier.S with type 'a IO.t = 'a IO.t) : sig + val consumer : OTEL.Exporter.t -> OTEL.Any_signal_l.t Consumer.Builder.t +end = struct + open IO + + type status = + | Active + | Shutting_down + | Stopped + + type state = { + active: Aswitch.t; (** Public facing switch *) + active_trigger: Aswitch.trigger; + status: status Atomic.t; (** Internal state, including shutdown *) + q: OTEL.Any_signal_l.t Bounded_queue.Recv.t; + notify: Notifier.t; + exp: OTEL.Exporter.t; + } + + let shutdown self : unit = + let old_status = + Util_atomic.update_cas self.status @@ fun status -> + match status with + | Stopped -> status, status + | Shutting_down -> status, status + | Active -> status, Shutting_down + in + + match old_status with + | Stopped -> () + | Shutting_down -> + (* when the worker stops it will call [on_done] *) + () + | Active -> + (* notify potentially asleep workers *) + Notifier.trigger self.notify; + Notifier.delete self.notify + + let tick (self : state) = Notifier.trigger self.notify + + (** Shutdown worker *) + let shutdown_worker (self : state) : unit = + (* only one worker, so, turn off exporter *) + OTEL.Exporter.shutdown self.exp; + + (* and we are shut down! *) + Atomic.set self.status Stopped; + Aswitch.turn_off self.active_trigger + + let start_worker (self : state) : unit = + (* loop on [q] *) + let rec loop () : unit IO.t = + match Bounded_queue.Recv.try_pop self.q with + | `Closed -> + shutdown_worker self; + IO.return () + | `Item sig_ -> + self.exp.OTEL.Exporter.export sig_; + loop () + | `Empty -> + (match Atomic.get self.status with + | Stopped -> + assert false + (* shouldn't happen without us going through [Shutting_down] *) + | Shutting_down -> + shutdown_worker self; + IO.return () + | Active -> + let* () = + Notifier.wait self.notify ~should_keep_waiting:(fun () -> + Bounded_queue.Recv.size self.q = 0 + && Atomic.get self.status = Active) + in + loop ()) + in + + IO.spawn loop + + let create_state ~q ~exporter () : state = + let active, active_trigger = Aswitch.create () in + let self = + { + active; + active_trigger; + status = Atomic.make Active; + q; + exp = exporter; + notify = Notifier.create (); + } + in + + start_worker self; + self + + let self_metrics (self : state) ~clock : OTEL.Metrics.t list = + let open OTEL.Metrics in + let now = OTEL.Clock.now clock in + [ + sum ~name:"otel_ocaml.export.batches_discarded_by_bounded_queue" + ~is_monotonic:true + [ int ~now (Bounded_queue.Recv.num_discarded self.q) ]; + ] + + let to_consumer (self : state) : Consumer.t = + let shutdown () = shutdown self in + let tick () = tick self in + let self_metrics ~clock () = self_metrics self ~clock in + { active = (fun () -> self.active); tick; shutdown; self_metrics } + + let consumer exporter : _ Consumer.Builder.t = + { + start_consuming = + (fun q -> + let st = create_state ~q ~exporter () in + to_consumer st); + } +end diff --git a/src/client/generic_http_consumer.ml b/src/client/generic_http_consumer.ml new file mode 100644 index 000000000..f33b8be6f --- /dev/null +++ b/src/client/generic_http_consumer.ml @@ -0,0 +1,152 @@ +open Common_ + +type error = Export_error.t + +module type IO = Generic_io.S_WITH_CONCURRENCY + +module type HTTPC = sig + module IO : IO + + type t + + val create : unit -> t + + val cleanup : t -> unit + + val send : + t -> + attempt_descr:string -> + url:string -> + headers:(string * string) list -> + decode:[ `Dec of Pbrt.Decoder.t -> 'a | `Ret of 'a ] -> + string -> + ('a, error) result IO.t + (** Send a HTTP request. + @param attempt_descr included in error message if this fails *) +end + +module Make + (IO : IO) + (Notifier : Generic_notifier.S with type 'a IO.t = 'a IO.t) + (Httpc : HTTPC with type 'a IO.t = 'a IO.t) : sig + val consumer : + ?override_n_workers:int -> + ticker_task:float option -> + ?on_tick:(unit -> unit) -> + config:Http_config.t -> + unit -> + Consumer.any_signal_l_builder + (** Make a consumer builder, ie. a builder function that will take a bounded + queue of signals, and start a consumer to process these signals and send + them somewhere using HTTP. + @param ticker_task + controls whether we start a task to call [tick] at the given interval in + seconds, or [None] to not start such a task at all. *) +end = struct + module Sender : + Generic_consumer.SENDER with module IO = IO and type config = Http_config.t = + struct + module IO = IO + + type config = Http_config.t + + type t = { + config: config; + encoder: Pbrt.Encoder.t; + http: Httpc.t; + } + + let create ~config () : t = + { config; http = Httpc.create (); encoder = Pbrt.Encoder.create () } + + let cleanup self = Httpc.cleanup self.http + + (** Should we retry, based on the HTTP response code? *) + let should_retry = function + | `Failure _ -> true (* Network errors, connection issues *) + | `Status (code, _, _) -> + (* Retry on server errors, rate limits, timeouts *) + code >= 500 || code = 429 || code = 408 + | `Sysbreak -> false (* User interrupt, don't retry *) + + (** Retry loop over [f()] with exponential backoff *) + let rec retry_loop_ (self : t) attempt delay_ms + ~(f : attempt_descr:string -> unit -> _ result IO.t) : _ result IO.t = + let open IO in + let attempt_descr = + spf "try(%d/%d)" attempt self.config.retry_max_attempts + in + let* result = f ~attempt_descr () in + match result with + | Ok x -> return (Ok x) + | Error err + when should_retry err && attempt < self.config.retry_max_attempts -> + let delay_s = delay_ms /. 1000. in + Export_error.report_err ~level:`Warning err; + + let* () = sleep_s delay_s in + let next_delay = + min self.config.retry_max_delay_ms + (delay_ms *. self.config.retry_backoff_multiplier) + in + retry_loop_ self (attempt + 1) next_delay ~f + | Error _ as err -> return err + + let send (self : t) (sigs : OTEL.Any_signal_l.t) : (unit, error) result IO.t + = + let res = Resource_signal.of_signal_l sigs in + let url, signal_headers = + match res with + | Logs _ -> self.config.url_logs, self.config.headers_logs + | Traces _ -> self.config.url_traces, self.config.headers_traces + | Metrics _ -> self.config.url_metrics, self.config.headers_metrics + in + (* Merge general headers with signal-specific ones (signal-specific takes precedence) *) + let signal_keys = List.map fst signal_headers in + let filtered_general = + List.filter + (fun (k, _) -> not (List.mem k signal_keys)) + self.config.headers + in + let content_type = + match self.config.protocol with + | Http_protobuf -> "application/x-protobuf" + | Http_json -> "application/json" + in + let headers = + ("Content-Type", content_type) + :: ("Accept", content_type) + :: List.rev_append signal_headers filtered_general + in + let data = + Resource_signal.Encode.any ~encoder:self.encoder + ~protocol:self.config.protocol res + in + + let do_once ~attempt_descr () = + Httpc.send self.http ~attempt_descr ~url ~headers ~decode:(`Ret ()) data + in + + if self.config.retry_max_attempts > 0 then + retry_loop_ self 0 self.config.retry_initial_delay_ms ~f:do_once + else + do_once ~attempt_descr:"single_attempt" () + end + + module C = Generic_consumer.Make (IO) (Notifier) (Sender) + + let default_n_workers = 50 + + let consumer ?override_n_workers ~ticker_task ?(on_tick = ignore) + ~(config : Http_config.t) () : Consumer.any_signal_l_builder = + let n_workers = + max 2 + (min 500 + (match override_n_workers, config.http_concurrency_level with + | Some n, _ -> n + | None, Some n -> n + | None, None -> default_n_workers)) + in + + C.consumer ~sender_config:config ~n_workers ~ticker_task ~on_tick () +end diff --git a/src/client/generic_io.ml b/src/client/generic_io.ml new file mode 100644 index 000000000..fba94580d --- /dev/null +++ b/src/client/generic_io.ml @@ -0,0 +1,31 @@ +(** Generic IO monad. + + This factors out some logic between various concurrency frameworks. *) + +module type S = sig + type 'a t + + val return : 'a -> 'a t + + val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t + + val protect : finally:(unit -> unit t) -> (unit -> 'a t) -> 'a t +end + +module type S_WITH_CONCURRENCY = sig + include S + + val sleep_s : float -> unit t + + val spawn : (unit -> unit t) -> unit +end + +module Direct_style : S with type 'a t = 'a = struct + type 'a t = 'a + + let[@inline] return x = x + + let[@inline] ( let* ) x f = f x + + let protect = Fun.protect +end diff --git a/src/client/generic_notifier.ml b/src/client/generic_notifier.ml new file mode 100644 index 000000000..5b74830b7 --- /dev/null +++ b/src/client/generic_notifier.ml @@ -0,0 +1,19 @@ +(** Generic notifier (used to signal when a bounded queue is empty) *) + +module type IO = Generic_io.S + +module type S = sig + module IO : IO + + type t + + val create : unit -> t + + val delete : t -> unit + + val trigger : t -> unit + + val wait : t -> should_keep_waiting:(unit -> bool) -> unit IO.t + + val register_bounded_queue : t -> _ Bounded_queue.Recv.t -> unit +end diff --git a/src/client/http_config.ml b/src/client/http_config.ml new file mode 100644 index 000000000..ff2b3f0a1 --- /dev/null +++ b/src/client/http_config.ml @@ -0,0 +1,3 @@ +(** @deprecated Use {!Exporter_config} instead *) + +include Exporter_config diff --git a/src/client/http_config.mli b/src/client/http_config.mli new file mode 100644 index 000000000..95132d871 --- /dev/null +++ b/src/client/http_config.mli @@ -0,0 +1,5 @@ +(** @deprecated Use {!Exporter_config} instead *) + +[@@@deprecated "use Exporter_config instead"] + +include module type of Exporter_config diff --git a/src/client/lwt/common_.ml b/src/client/lwt/common_.ml new file mode 100644 index 000000000..6a337b5c5 --- /dev/null +++ b/src/client/lwt/common_.ml @@ -0,0 +1 @@ +module OTEL = Opentelemetry diff --git a/src/client/lwt/dune b/src/client/lwt/dune new file mode 100644 index 000000000..297a4fcb8 --- /dev/null +++ b/src/client/lwt/dune @@ -0,0 +1,39 @@ +(library + (name opentelemetry_client_lwt) + (public_name opentelemetry-client.lwt) + (flags + :standard + -open + Opentelemetry_util + -open + Opentelemetry_client + -open + Opentelemetry_atomic) + (modules :standard \ gen_types_) + (optional) ; lwt + (libraries + opentelemetry.util + opentelemetry.atomic + opentelemetry.emitter + (re_export opentelemetry.core) + (re_export opentelemetry) + (re_export opentelemetry.ambient-context) + ambient-context-lwt + (re_export opentelemetry-client) + (re_export lwt) + threads + mtime + mtime.clock.os + lwt.unix) + (synopsis "Lwt-specific helpers for opentelemetry-client")) + +(executable + (name gen_types_) + (modules gen_types_)) + +(rule + (enabled_if %{lib-available:lwt}) + (deps types_.ml.5 types_.ml.6) + (target types_.ml) + (action + (run ./gen_types_.exe %{version:lwt}))) diff --git a/src/client/lwt/gen_types_.ml b/src/client/lwt/gen_types_.ml new file mode 100644 index 000000000..771f0e974 --- /dev/null +++ b/src/client/lwt/gen_types_.ml @@ -0,0 +1,23 @@ +let copy_file src dst = + let ic = open_in src in + let oc = open_out dst in + let buf = Bytes.create 1024 in + (try + while true do + let n = input ic buf 0 (Bytes.length buf) in + if n = 0 then raise End_of_file; + output oc buf 0 n + done + with End_of_file -> ()); + close_in ic; + close_out oc + +let () = + let version = Sys.argv.(1) in + let major = + try Scanf.sscanf version "%d.%s" (fun maj _ -> maj) with _ -> 0 + in + if major >= 6 then + copy_file "types_.ml.6" "types_.ml" + else + copy_file "types_.ml.5" "types_.ml" diff --git a/src/client/lwt/io_lwt.ml b/src/client/lwt/io_lwt.ml new file mode 100644 index 000000000..d8dcece97 --- /dev/null +++ b/src/client/lwt/io_lwt.ml @@ -0,0 +1,11 @@ +type 'a t = 'a Lwt.t + +let return = Lwt.return + +let ( let* ) = Lwt.Syntax.( let* ) + +let sleep_s = Lwt_unix.sleep + +let spawn = Lwt.async + +let[@inline] protect ~finally f = Lwt.finalize f finally diff --git a/src/client/lwt/io_lwt.mli b/src/client/lwt/io_lwt.mli new file mode 100644 index 000000000..ec0831762 --- /dev/null +++ b/src/client/lwt/io_lwt.mli @@ -0,0 +1 @@ +include Generic_io.S_WITH_CONCURRENCY with type 'a t = 'a Lwt.t diff --git a/src/client/lwt/notifier_lwt.ml b/src/client/lwt/notifier_lwt.ml new file mode 100644 index 000000000..c9a241aa2 --- /dev/null +++ b/src/client/lwt/notifier_lwt.ml @@ -0,0 +1,49 @@ +(** Notification that can be used on the consumer side of a bounded queue *) + +module IO = Io_lwt + +type t = { + notified: bool Atomic.t; + cond: unit Lwt_condition.t; + notification: Types_.notification; + lwt_tid: int; (** thread ID where lwt runs *) + deleted: bool Atomic.t; +} + +let create () : t = + let notified = Atomic.make false in + let cond = Lwt_condition.create () in + let notification = + Lwt_unix.make_notification (fun () -> + Atomic.set notified false; + Lwt_condition.broadcast cond ()) + in + let lwt_tid = Thread.id @@ Thread.self () in + { notified; notification; cond; lwt_tid; deleted = Atomic.make false } + +let delete self : unit = + if not (Atomic.exchange self.deleted true) then + Lwt_unix.stop_notification self.notification + +let trigger (self : t) : unit = + let tid = Thread.id @@ Thread.self () in + + if tid = self.lwt_tid then + (* in lwt thread, directly use the condition *) + Lwt_condition.broadcast self.cond () + else if not (Atomic.exchange self.notified true) then + Lwt_unix.send_notification self.notification + +let wait (self : t) ~should_keep_waiting : unit Lwt.t = + let open Lwt.Syntax in + let rec loop () = + if should_keep_waiting () then + let* () = Lwt_condition.wait self.cond in + loop () + else + Lwt.return_unit + in + loop () + +let register_bounded_queue (self : t) (q : _ Bounded_queue.Recv.t) : unit = + Bounded_queue.Recv.on_non_empty q (fun () -> trigger self) diff --git a/src/client/lwt/notifier_lwt.mli b/src/client/lwt/notifier_lwt.mli new file mode 100644 index 000000000..c16ae9929 --- /dev/null +++ b/src/client/lwt/notifier_lwt.mli @@ -0,0 +1 @@ +include Generic_notifier.S with module IO = Io_lwt diff --git a/src/client/lwt/types_.ml.5 b/src/client/lwt/types_.ml.5 new file mode 100644 index 000000000..c34ffc815 --- /dev/null +++ b/src/client/lwt/types_.ml.5 @@ -0,0 +1,2 @@ + +type notification = int diff --git a/src/client/lwt/types_.ml.6 b/src/client/lwt/types_.ml.6 new file mode 100644 index 000000000..bff82f730 --- /dev/null +++ b/src/client/lwt/types_.ml.6 @@ -0,0 +1,2 @@ + +type notification = Lwt_unix.notification diff --git a/src/client/lwt/util_ambient_context.ml b/src/client/lwt/util_ambient_context.ml new file mode 100644 index 000000000..3e6eb4804 --- /dev/null +++ b/src/client/lwt/util_ambient_context.ml @@ -0,0 +1,3 @@ +(** Setup Lwt as the ambient context *) +let setup_ambient_context () = + Opentelemetry_ambient_context.set_current_storage Ambient_context_lwt.storage diff --git a/src/client/lwt/util_ticker.ml b/src/client/lwt/util_ticker.ml new file mode 100644 index 000000000..426bcaf90 --- /dev/null +++ b/src/client/lwt/util_ticker.ml @@ -0,0 +1,17 @@ +open Lwt.Syntax + +(** Lwt task that calls [tick()] regularly, to help enforce timeouts. + @param frequency_s how often in seconds does the tick tock? *) +let start_ticker_thread ?(finally = ignore) ~(stop : bool Atomic.t) + ~(frequency_s : float) ~(tick : unit -> unit) () : unit = + let frequency_s = max frequency_s 0.5 in + let rec tick_loop () = + if Atomic.get stop then ( + finally (); + Lwt.return () + ) else + let* () = Lwt_unix.sleep frequency_s in + tick (); + tick_loop () + in + Lwt.async tick_loop diff --git a/src/client/resource_signal.ml b/src/client/resource_signal.ml new file mode 100644 index 000000000..5dc70001b --- /dev/null +++ b/src/client/resource_signal.ml @@ -0,0 +1,204 @@ +open Common_ +module Trace_service = Opentelemetry.Proto.Trace_service +module Metrics_service = Opentelemetry.Proto.Metrics_service +module Logs_service = Opentelemetry.Proto.Logs_service +module Span = Opentelemetry.Span + +open struct + let of_x_or_empty ?service_name ?attrs ~f l = + if l = [] then + [] + else + [ f ?service_name ?attrs l ] +end + +type t = + | Traces of Proto.Trace.resource_spans list + | Metrics of Proto.Metrics.resource_metrics list + | Logs of Proto.Logs.resource_logs list + +let of_logs ?service_name ?attrs logs : t = + Logs [ Util_resources.make_resource_logs ?service_name ?attrs logs ] + +let of_logs_or_empty ?service_name ?attrs logs = + of_x_or_empty ?service_name ?attrs ~f:of_logs logs + +let of_spans ?service_name ?attrs spans : t = + Traces [ Util_resources.make_resource_spans ?service_name ?attrs spans ] + +let of_spans_or_empty ?service_name ?attrs spans = + of_x_or_empty ?service_name ?attrs ~f:of_spans spans + +let of_metrics ?service_name ?attrs m : t = + Metrics [ Util_resources.make_resource_metrics ?service_name ?attrs m ] + +let of_metrics_or_empty ?service_name ?attrs ms = + of_x_or_empty ?service_name ?attrs ~f:of_metrics ms + +let to_traces = function + | Traces xs -> Some xs + | _ -> None + +let to_metrics = function + | Metrics xs -> Some xs + | _ -> None + +let to_logs = function + | Logs xs -> Some xs + | _ -> None + +let is_traces = function + | Traces _ -> true + | _ -> false + +let is_metrics = function + | Metrics _ -> true + | _ -> false + +let is_logs = function + | Logs _ -> true + | _ -> false + +let of_signal_l ?service_name ?attrs (s : OTEL.Any_signal_l.t) : t = + match s with + | Logs logs -> of_logs ?service_name ?attrs logs + | Spans sp -> of_spans ?service_name ?attrs sp + | Metrics ms -> of_metrics ?service_name ?attrs ms + +type protocol = Exporter_config.protocol = + | Http_protobuf + | Http_json + +module Encode = struct + let resource_to_pb_string ~encoder ~ctor ~enc resource : string = + let encoder = + match encoder with + | Some e -> + Pbrt.Encoder.reset e; + e + | None -> Pbrt.Encoder.create () + in + let x = ctor resource in + let data = + let@ _sc = + Self_trace.with_ ~kind:Span.Span_kind_internal "encode-proto" + in + enc x encoder; + let data = Pbrt.Encoder.to_string encoder in + Span.add_attrs _sc [ "size", `Int (String.length data) ]; + Pbrt.Encoder.reset encoder; + data + in + data + + let resource_to_json_string ~ctor ~enc resource : string = + let x = ctor resource in + let data = + let@ _sc = Self_trace.with_ ~kind:Span.Span_kind_internal "encode-json" in + let json = enc x in + let data = Yojson.Basic.to_string json in + Span.add_attrs _sc [ "size", `Int (String.length data) ]; + data + in + data + + let logs_pb ?encoder resource_logs = + resource_to_pb_string ~encoder resource_logs + ~ctor:(fun r -> + Logs_service.make_export_logs_service_request ~resource_logs:r ()) + ~enc:Logs_service.encode_pb_export_logs_service_request + + let logs_json resource_logs = + resource_to_json_string resource_logs + ~ctor:(fun r -> + Logs_service.make_export_logs_service_request ~resource_logs:r ()) + ~enc:Logs_service.encode_json_export_logs_service_request + + let metrics_pb ?encoder resource_metrics = + resource_to_pb_string ~encoder resource_metrics + ~ctor:(fun r -> + Metrics_service.make_export_metrics_service_request ~resource_metrics:r + ()) + ~enc:Metrics_service.encode_pb_export_metrics_service_request + + let metrics_json resource_metrics = + resource_to_json_string resource_metrics + ~ctor:(fun r -> + Metrics_service.make_export_metrics_service_request ~resource_metrics:r + ()) + ~enc:Metrics_service.encode_json_export_metrics_service_request + + let traces_pb ?encoder resource_spans = + resource_to_pb_string ~encoder resource_spans + ~ctor:(fun r -> + Trace_service.make_export_trace_service_request ~resource_spans:r ()) + ~enc:Trace_service.encode_pb_export_trace_service_request + + let traces_json resource_spans = + resource_to_json_string resource_spans + ~ctor:(fun r -> + Trace_service.make_export_trace_service_request ~resource_spans:r ()) + ~enc:Trace_service.encode_json_export_trace_service_request + + let logs ?encoder ?(protocol = Http_protobuf) resource_logs = + match protocol with + | Http_protobuf -> logs_pb ?encoder resource_logs + | Http_json -> logs_json resource_logs + + let metrics ?encoder ?(protocol = Http_protobuf) resource_metrics = + match protocol with + | Http_protobuf -> metrics_pb ?encoder resource_metrics + | Http_json -> metrics_json resource_metrics + + let traces ?encoder ?(protocol = Http_protobuf) resource_spans = + match protocol with + | Http_protobuf -> traces_pb ?encoder resource_spans + | Http_json -> traces_json resource_spans + + let any ?encoder ?(protocol = Http_protobuf) (r : t) : string = + match r with + | Logs l -> logs ?encoder ~protocol l + | Traces sp -> traces ?encoder ~protocol sp + | Metrics ms -> metrics ?encoder ~protocol ms +end + +module Decode = struct + let resource_of_string ~dec s = Pbrt.Decoder.of_string s |> dec + + let logs data = + (resource_of_string ~dec:Logs_service.decode_pb_export_logs_service_request + data) + .resource_logs + + let metrics data = + (resource_of_string + ~dec:Metrics_service.decode_pb_export_metrics_service_request data) + .resource_metrics + + let traces data = + (resource_of_string + ~dec:Trace_service.decode_pb_export_trace_service_request data) + .resource_spans +end + +module Pp = struct + let pp_sep fmt () = Format.fprintf fmt ",@." + + let pp_signal pp fmt t = + Format.fprintf fmt "[@ @["; + Format.pp_print_list ~pp_sep pp fmt t; + Format.fprintf fmt "@ ]@]@." + + let logs = pp_signal Proto.Logs.pp_resource_logs + + let metrics = pp_signal Proto.Metrics.pp_resource_metrics + + let traces = pp_signal Proto.Trace.pp_resource_spans + + let pp fmt = function + | Logs ls -> logs fmt ls + | Metrics ms -> metrics fmt ms + | Traces ts -> traces fmt ts +end + +let pp = Pp.pp diff --git a/src/client/signal.mli b/src/client/resource_signal.mli similarity index 56% rename from src/client/signal.mli rename to src/client/resource_signal.mli index a10f9e000..cf65f3c5a 100644 --- a/src/client/signal.mli +++ b/src/client/resource_signal.mli @@ -1,5 +1,8 @@ (** Constructing and managing OTel - {{:https://opentelemetry.io/docs/concepts/signals/} signals} *) + {{:https://opentelemetry.io/docs/concepts/signals/} signals} at the resource + (batch) level *) + +open Common_ (** The type of signals @@ -11,6 +14,47 @@ type t = | Metrics of Opentelemetry_proto.Metrics.resource_metrics list | Logs of Opentelemetry_proto.Logs.resource_logs list +val pp : Format.formatter -> t -> unit + +val of_logs : + ?service_name:string -> + ?attrs:OTEL.Key_value.t list -> + Proto.Logs.log_record list -> + t + +val of_logs_or_empty : + ?service_name:string -> + ?attrs:OTEL.Key_value.t list -> + Proto.Logs.log_record list -> + t list + +val of_spans : + ?service_name:string -> ?attrs:OTEL.Key_value.t list -> OTEL.Span.t list -> t + +val of_spans_or_empty : + ?service_name:string -> + ?attrs:OTEL.Key_value.t list -> + OTEL.Span.t list -> + t list + +val of_metrics : + ?service_name:string -> + ?attrs:OTEL.Key_value.t list -> + Proto.Metrics.metric list -> + t + +val of_metrics_or_empty : + ?service_name:string -> + ?attrs:OTEL.Key_value.t list -> + Proto.Metrics.metric list -> + t list + +val of_signal_l : + ?service_name:string -> + ?attrs:OTEL.Key_value.t list -> + OTEL.Any_signal_l.t -> + t + val to_traces : t -> Opentelemetry_proto.Trace.resource_spans list option val to_metrics : t -> Opentelemetry_proto.Metrics.resource_metrics list option @@ -23,31 +67,44 @@ val is_metrics : t -> bool val is_logs : t -> bool -(** Encode signals to protobuf encoded strings, ready to be sent over the wire -*) +type protocol = Exporter_config.protocol = + | Http_protobuf + | Http_json + +(** Encode signals to protobuf or JSON encoded strings, ready to be sent over + the wire *) module Encode : sig val logs : ?encoder:Pbrt.Encoder.t -> + ?protocol:protocol -> Opentelemetry_proto.Logs.resource_logs list -> string - (** [logs ls] is a protobuf encoded string of the logs [ls] + (** [logs ls] is an encoded string of the logs [ls]. - @param encoder provide an encoder state to reuse *) + @param encoder provide an encoder state to reuse (protobuf only) + @param protocol encoding protocol to use (default: Http_protobuf) *) val metrics : ?encoder:Pbrt.Encoder.t -> + ?protocol:protocol -> Opentelemetry_proto.Metrics.resource_metrics list -> string - (** [metrics ms] is a protobuf encoded string of the metrics [ms] - @param encoder provide an encoder state to reuse *) + (** [metrics ms] is an encoded string of the metrics [ms]. + + @param encoder provide an encoder state to reuse (protobuf only) + @param protocol encoding protocol to use (default: Http_protobuf) *) val traces : ?encoder:Pbrt.Encoder.t -> + ?protocol:protocol -> Opentelemetry_proto.Trace.resource_spans list -> string - (** [traces ts] is a protobuf encoded string of the traces [ts] + (** [traces ts] is an encoded string of the traces [ts]. + + @param encoder provide an encoder state to reuse (protobuf only) + @param protocol encoding protocol to use (default: Http_protobuf) *) - @param encoder provide an encoder state to reuse *) + val any : ?encoder:Pbrt.Encoder.t -> ?protocol:protocol -> t -> string end (** Decode signals from protobuf encoded strings, received over the wire *) diff --git a/src/client/sampler.ml b/src/client/sampler.ml new file mode 100644 index 000000000..b62418842 --- /dev/null +++ b/src/client/sampler.ml @@ -0,0 +1,39 @@ +type t = { + proba_accept: float; + rng: Random.State.t; + n_seen: int Atomic.t; + n_accepted: int Atomic.t; +} + +let create ~proba_accept () : t = + if proba_accept < 0. || proba_accept > 1. then + invalid_arg "sampler: proba_accept must be in [0., 1.]"; + { + proba_accept; + rng = Random.State.make_self_init (); + n_seen = Atomic.make 0; + n_accepted = Atomic.make 0; + } + +let[@inline] proba_accept self = self.proba_accept + +let actual_rate (self : t) : float = + let accept = Atomic.get self.n_accepted in + let total = Atomic.get self.n_seen in + + if total = 0 then + 1. + else + float accept /. float total + +let accept (self : t) : bool = + Atomic.incr self.n_seen; + + (* WARNING: Random.State.float is not safe to call concurrently on the + same state from multiple domains. If a sampler is shared across domains, + consider creating one sampler per domain. *) + let n = Random.State.float self.rng 1. in + let res = n < self.proba_accept in + + if res then Atomic.incr self.n_accepted; + res diff --git a/src/client/sampler.mli b/src/client/sampler.mli new file mode 100644 index 000000000..ac45eab89 --- /dev/null +++ b/src/client/sampler.mli @@ -0,0 +1,20 @@ +(** Basic random sampling. *) + +type t + +val create : proba_accept:float -> unit -> t +(** [create ~proba_accept:n ()] makes a new sampler. + + The sampler will accept signals with probability [n] (must be between 0 and + 1). + @raise Invalid_argument if [n] is not between 0 and 1. *) + +val accept : t -> bool +(** Do we accept a sample? This returns [true] with probability [proba_accept]. +*) + +val proba_accept : t -> float + +val actual_rate : t -> float +(** The ratio of signals we actually accepted so far. This should asymptotically + be equal to {!proba_accept} if the random generator is good. *) diff --git a/src/client/self_trace.ml b/src/client/self_trace.ml index 62d04cae6..0aac592a7 100644 --- a/src/client/self_trace.ml +++ b/src/client/self_trace.ml @@ -1,22 +1,13 @@ -module OT = Opentelemetry +open Common_ -let enabled = Atomic.make true +let enabled = Atomic.make false -let add_event (scope : OT.Scope.t) ev = OT.Scope.add_event scope (fun () -> ev) +let[@inline] add_event (scope : OTEL.Span.t) ev = OTEL.Span.add_event scope ev -let dummy_trace_id_ = OT.Trace_id.dummy - -let dummy_span_id = OT.Span_id.dummy +let set_enabled b = Atomic.set enabled b let with_ ?kind ?attrs name f = if Atomic.get enabled then - OT.Trace.with_ ?kind ?attrs name f - else ( - (* A new scope is needed here because it might be modified *) - let scope = - OT.Scope.make ~trace_id:dummy_trace_id_ ~span_id:dummy_span_id () - in - f scope - ) - -let set_enabled b = Atomic.set enabled b + OTEL.Tracer.with_ ~tracer:(OTEL.Trace_provider.get ()) ?kind ?attrs name f + else + f OTEL.Span.dummy diff --git a/src/client/self_trace.mli b/src/client/self_trace.mli index d0690f02b..832ad76ee 100644 --- a/src/client/self_trace.mli +++ b/src/client/self_trace.mli @@ -1,12 +1,20 @@ -(** Mini tracing module (disabled if [config.self_trace=false]) *) +(** Mini tracing module for OTEL itself. -val add_event : Opentelemetry.Scope.t -> Opentelemetry.Event.t -> unit + When enabled via {!set_enabled}, emits spans via the current + {!OTEL.Trace_provider}. Disabled by default. *) + +open Common_ + +val add_event : OTEL.Span.t -> OTEL.Event.t -> unit val with_ : - ?kind:Opentelemetry.Span_kind.t -> - ?attrs:(string * Opentelemetry.value) list -> + ?kind:OTEL.Span_kind.t -> + ?attrs:(string * OTEL.value) list -> string -> - (Opentelemetry.Scope.t -> 'a) -> + (OTEL.Span.t -> 'a) -> 'a +(** Instrument a section of SDK code with a span. No-ops when disabled. *) val set_enabled : bool -> unit +(** Enable or disable self-tracing. When enabled, uses the current + {!OTEL.Trace_provider} to emit spans. *) diff --git a/src/client/signal.ml b/src/client/signal.ml deleted file mode 100644 index 7a2eddd5a..000000000 --- a/src/client/signal.ml +++ /dev/null @@ -1,114 +0,0 @@ -module Trace_service = Opentelemetry.Proto.Trace_service -module Metrics_service = Opentelemetry.Proto.Metrics_service -module Logs_service = Opentelemetry.Proto.Logs_service -module Span = Opentelemetry.Span - -let ( let@ ) = ( @@ ) - -module Proto = Opentelemetry.Proto - -type t = - | Traces of Proto.Trace.resource_spans list - | Metrics of Proto.Metrics.resource_metrics list - | Logs of Proto.Logs.resource_logs list - -let to_traces = function - | Traces xs -> Some xs - | _ -> None - -let to_metrics = function - | Metrics xs -> Some xs - | _ -> None - -let to_logs = function - | Logs xs -> Some xs - | _ -> None - -let is_traces = function - | Traces _ -> true - | _ -> false - -let is_metrics = function - | Metrics _ -> true - | _ -> false - -let is_logs = function - | Logs _ -> true - | _ -> false - -module Encode = struct - let resource_to_string ~encoder ~ctor ~enc resource = - let encoder = - match encoder with - | Some e -> - Pbrt.Encoder.reset e; - e - | None -> Pbrt.Encoder.create () - in - let x = ctor resource in - let@ _sc = Self_trace.with_ ~kind:Span.Span_kind_internal "encode-proto" in - enc x encoder; - Pbrt.Encoder.to_string encoder - - let logs ?encoder resource_logs = - resource_logs - |> resource_to_string ~encoder - ~ctor:(fun r -> - Logs_service.default_export_logs_service_request ~resource_logs:r ()) - ~enc:Logs_service.encode_pb_export_logs_service_request - - let metrics ?encoder resource_metrics = - resource_metrics - |> resource_to_string ~encoder - ~ctor:(fun r -> - Metrics_service.default_export_metrics_service_request - ~resource_metrics:r ()) - ~enc:Metrics_service.encode_pb_export_metrics_service_request - - let traces ?encoder resource_spans = - resource_spans - |> resource_to_string ~encoder - ~ctor:(fun r -> - Trace_service.default_export_trace_service_request ~resource_spans:r - ()) - ~enc:Trace_service.encode_pb_export_trace_service_request -end - -module Decode = struct - let resource_of_string ~dec s = Pbrt.Decoder.of_string s |> dec - - let logs data = - (resource_of_string ~dec:Logs_service.decode_pb_export_logs_service_request - data) - .resource_logs - - let metrics data = - (resource_of_string - ~dec:Metrics_service.decode_pb_export_metrics_service_request data) - .resource_metrics - - let traces data = - (resource_of_string - ~dec:Trace_service.decode_pb_export_trace_service_request data) - .resource_spans -end - -module Pp = struct - let pp_sep fmt () = Format.fprintf fmt ",@." - - let pp_signal pp fmt t = - Format.fprintf fmt "[@ @["; - Format.pp_print_list ~pp_sep pp fmt t; - Format.fprintf fmt "@ ]@]@." - - let logs = pp_signal Proto.Logs.pp_resource_logs - - let metrics = pp_signal Proto.Metrics.pp_resource_metrics - - let traces = pp_signal Proto.Trace.pp_resource_spans - - let pp fmt = function - | Logs ls -> logs fmt ls - | Metrics ms -> metrics fmt ms - | Traces ts -> traces fmt ts -end diff --git a/src/client/sync/bounded_queue_sync.ml b/src/client/sync/bounded_queue_sync.ml new file mode 100644 index 000000000..8b9edf79c --- /dev/null +++ b/src/client/sync/bounded_queue_sync.ml @@ -0,0 +1,148 @@ +module BQ = Bounded_queue + +type push_res = + | Closed + | Pushed of { num_discarded: int } + +(* a variant of {!Sync_queue} with more bespoke pushing behavior *) +module Q : sig + type 'a t + + val create : unit -> 'a t + + val close : _ t -> unit + + val size : _ t -> int + + val closed : _ t -> bool + + val try_pop : 'a t -> 'a BQ.pop_result + + val push_while_not_full : high_watermark:int -> 'a t -> 'a list -> push_res + (** [push_while_not_full q ~high_watermark xs] tries to push each item of [x] + into [q]. + + An item is not pushed if the queue is "full" (size >= high_watermark). + + This returns a pair [num_discarded, old_size] where [num_discarded] is the + number of items that could not be pushed, and [old_size] is the size + before anything was pushed. *) +end = struct + module UM = Util_mutex + + type 'a t = { + mutex: Mutex.t; + q: 'a Queue.t; + mutable closed: bool; + } + + let create () : _ t = + { mutex = Mutex.create (); q = Queue.create (); closed = false } + + (* NOTE: the race condition here is benign, assuming no tearing of + a value of type [bool] which OCaml's memory model should guarantee. *) + let[@inline] closed self = self.closed + + let[@inline] size self = UM.protect self.mutex (fun () -> Queue.length self.q) + + let close (self : _ t) = + UM.protect self.mutex @@ fun () -> + if not self.closed then self.closed <- true + + let try_pop (self : 'a t) : 'a BQ.pop_result = + UM.protect self.mutex @@ fun () -> + (* first, try to pop the queue. We want to drain it even if it's closed. *) + try `Item (Queue.pop self.q) + with Queue.Empty -> + if self.closed then + `Closed + else + `Empty + + let push_while_not_full ~high_watermark (self : 'a t) (xs : 'a list) : + push_res = + UM.protect self.mutex @@ fun () -> + if self.closed then + Closed + else ( + let to_push = ref xs in + + let continue = ref true in + while !continue && Queue.length self.q < high_watermark do + match !to_push with + | [] -> continue := false + | x :: tl_xs -> + to_push := tl_xs; + Queue.push x self.q + done; + + let num_discarded = List.length !to_push in + (* Printf.eprintf "bq: pushed %d items (discarded: %d)\n%!" (List.length xs - num_discarded) num_discarded; *) + + Pushed { num_discarded } + ) +end + +type 'a state = { + n_discarded: int Atomic.t; + high_watermark: int; + q: 'a Q.t; + on_non_empty: Cb_set.t; + measure: 'a -> int; +} + +let measure_all_ measure xs = List.fold_left (fun acc x -> acc + measure x) 0 xs + +let push (self : _ state) x = + if x <> [] then ( + match + Q.push_while_not_full self.q ~high_watermark:self.high_watermark x + with + | Closed -> + let n = measure_all_ self.measure x in + ignore (Atomic.fetch_and_add self.n_discarded n : int) + | Pushed { num_discarded } -> + if num_discarded > 0 then ( + let n_signals = measure_all_ self.measure x in + let total = Atomic.fetch_and_add self.n_discarded n_signals in + Opentelemetry.Self_debug.log Warning (fun () -> + Printf.sprintf + "otel: dropped %d signals (queue full: %d/%d, total dropped: %d)" + n_signals (Q.size self.q) self.high_watermark (total + n_signals)) + ); + (* wake up potentially asleep consumers *) + Cb_set.trigger self.on_non_empty + ) + +let[@inline] try_pop (self : _ state) : _ BQ.pop_result = Q.try_pop self.q + +let to_bounded_queue (self : 'a state) : 'a BQ.t = + let closed () = Q.closed self.q in + let num_discarded () = Atomic.get self.n_discarded in + let push x = push self x in + let on_non_empty = Cb_set.register self.on_non_empty in + let try_pop () = try_pop self in + let size () = Q.size self.q in + let high_watermark () = self.high_watermark in + let close () = + Q.close self.q; + (* waiters will want to know *) + Cb_set.trigger self.on_non_empty + in + let common = { BQ.Common.closed; num_discarded; size; high_watermark } in + { + BQ.send = { push; close; common }; + recv = { try_pop; on_non_empty; common }; + } + +let create ?(measure = fun _ -> 1) ~high_watermark () : _ BQ.t = + let st = + { + high_watermark; + q = Q.create (); + n_discarded = Atomic.make 0; + on_non_empty = Cb_set.create (); + measure; + } + in + to_bounded_queue st diff --git a/src/client/sync/bounded_queue_sync.mli b/src/client/sync/bounded_queue_sync.mli new file mode 100644 index 000000000..de1a5377c --- /dev/null +++ b/src/client/sync/bounded_queue_sync.mli @@ -0,0 +1,12 @@ +(** Bounded queue based on simple synchronization primitives. + + This is not the fastest queue but it should be versatile. *) + +val create : + ?measure:('a -> int) -> high_watermark:int -> unit -> 'a Bounded_queue.t +(** [create ~high_watermark ()] creates a new bounded queue based on + {!Sync_queue}. + @param measure + maps each item to its signal count (e.g. number of spans in a batch). Used + to report accurate signal counts when items are dropped. Default: + [fun _ -> 1]. *) diff --git a/src/client/sync/common_.ml b/src/client/sync/common_.ml new file mode 100644 index 000000000..6a337b5c5 --- /dev/null +++ b/src/client/sync/common_.ml @@ -0,0 +1 @@ +module OTEL = Opentelemetry diff --git a/src/client/sync/dune b/src/client/sync/dune new file mode 100644 index 000000000..d9bd07319 --- /dev/null +++ b/src/client/sync/dune @@ -0,0 +1,23 @@ +(library + (name opentelemetry_client_sync) + (public_name opentelemetry-client.sync) + (flags + :standard + -open + Opentelemetry_util + -open + Opentelemetry_client + -open + Opentelemetry_atomic) + (libraries + opentelemetry.util + opentelemetry.atomic + opentelemetry.emitter + (re_export opentelemetry.core) + (re_export opentelemetry) + (re_export opentelemetry-client) + (re_export threads) + mtime + mtime.clock.os + unix) + (synopsis "Synchronous/threading-related helpers for opentelemetry-client")) diff --git a/src/client/sync/io_sync.ml b/src/client/sync/io_sync.ml new file mode 100644 index 000000000..884c8fd12 --- /dev/null +++ b/src/client/sync/io_sync.ml @@ -0,0 +1,5 @@ +include Generic_io.Direct_style + +let sleep_s = Thread.delay + +let[@inline] spawn f = ignore (Util_thread.start_bg_thread f : Thread.t) diff --git a/src/client/sync/io_sync.mli b/src/client/sync/io_sync.mli new file mode 100644 index 000000000..883efaa0e --- /dev/null +++ b/src/client/sync/io_sync.mli @@ -0,0 +1,4 @@ +(** Synchronous IOs, with threads for concurrency *) + +include Generic_io.S_WITH_CONCURRENCY with type 'a t = 'a +(** Generic IO with [spawn] starting a background thread *) diff --git a/src/client/sync/notifier_sync.ml b/src/client/sync/notifier_sync.ml new file mode 100644 index 000000000..7fd1fca5a --- /dev/null +++ b/src/client/sync/notifier_sync.ml @@ -0,0 +1,23 @@ +module IO = Generic_io.Direct_style + +type t = { + mutex: Mutex.t; + cond: Condition.t; +} + +let create () : t = { mutex = Mutex.create (); cond = Condition.create () } + +let[@inline] trigger self = Condition.broadcast self.cond + +let delete = ignore + +let wait self ~should_keep_waiting = + Mutex.lock self.mutex; + while should_keep_waiting () do + Condition.wait self.cond self.mutex + done; + Mutex.unlock self.mutex + +(** Ensure we get signalled when the queue goes from empty to non-empty *) +let register_bounded_queue (self : t) (bq : _ Bounded_queue.Recv.t) : unit = + Bounded_queue.Recv.on_non_empty bq (fun () -> trigger self) diff --git a/src/client/sync/notifier_sync.mli b/src/client/sync/notifier_sync.mli new file mode 100644 index 000000000..f896ccb2b --- /dev/null +++ b/src/client/sync/notifier_sync.mli @@ -0,0 +1 @@ +include Generic_notifier.S with type 'a IO.t = 'a diff --git a/src/client/sync/shutdown_sync.ml b/src/client/sync/shutdown_sync.ml new file mode 100644 index 000000000..29e2418c3 --- /dev/null +++ b/src/client/sync/shutdown_sync.ml @@ -0,0 +1,10 @@ +open Common_ + +(** Shutdown this exporter and block the thread until it's done. + + With the new Exporter.t interface, shutdown is synchronous. This function is + kept for backwards compatibility. *) +let shutdown (exp : OTEL.Exporter.t) : unit = OTEL.Exporter.shutdown exp + +(** Shutdown main exporter and wait *) +let shutdown_main () : unit = Option.iter shutdown (OTEL.Sdk.get ()) diff --git a/src/client-ocurl/b_queue.ml b/src/client/sync/sync_queue.ml similarity index 87% rename from src/client-ocurl/b_queue.ml rename to src/client/sync/sync_queue.ml index 98f43876e..25d83588f 100644 --- a/src/client-ocurl/b_queue.ml +++ b/src/client/sync/sync_queue.ml @@ -1,4 +1,4 @@ -open Opentelemetry.Util_mutex +module UM = Util_mutex type 'a t = { mutex: Mutex.t; @@ -18,14 +18,14 @@ let create () : _ t = } let close (self : _ t) = - protect self.mutex @@ fun () -> + UM.protect self.mutex @@ fun () -> if not self.closed then ( self.closed <- true; Condition.broadcast self.cond (* awake waiters so they fail *) ) let push (self : _ t) x : unit = - protect self.mutex @@ fun () -> + UM.protect self.mutex @@ fun () -> if self.closed then raise Closed else ( @@ -45,7 +45,7 @@ let pop (self : 'a t) : 'a = x ) in - protect self.mutex loop + UM.protect self.mutex loop let pop_all (self : 'a t) into : unit = let rec loop () = @@ -56,4 +56,4 @@ let pop_all (self : 'a t) into : unit = ) else Queue.transfer self.q into in - protect self.mutex loop + UM.protect self.mutex loop diff --git a/src/client-ocurl/b_queue.mli b/src/client/sync/sync_queue.mli similarity index 81% rename from src/client-ocurl/b_queue.mli rename to src/client/sync/sync_queue.mli index d020dfb3b..d64296d7c 100644 --- a/src/client-ocurl/b_queue.mli +++ b/src/client/sync/sync_queue.mli @@ -1,4 +1,4 @@ -(** Basic Blocking Queue *) +(** Simple blocking queue *) type 'a t @@ -15,8 +15,9 @@ val pop : 'a t -> 'a @raise Closed if the queue was closed before a new element was available. *) val pop_all : 'a t -> 'a Queue.t -> unit -(** [pop_all q into] pops all the elements of [q] and moves them into [into]. It - might block until an element comes. +(** [pop_all q into] pops all the elements of [q] and moves them into [into]. if + no element is available, it will block until it successfully transfers at + least one item to [into]. @raise Closed if the queue was closed before a new element was available. *) val close : _ t -> unit diff --git a/src/client/sync/util_thread.ml b/src/client/sync/util_thread.ml new file mode 100644 index 000000000..d7e5b24f4 --- /dev/null +++ b/src/client/sync/util_thread.ml @@ -0,0 +1,46 @@ +(** start a thread in the background, running [f()], blocking signals *) +let start_bg_thread (f : unit -> unit) : Thread.t = + let unix_run () = + let signals = + [ + Sys.sigusr1; + Sys.sigusr2; + Sys.sigterm; + Sys.sigpipe; + Sys.sigalrm; + Sys.sigstop; + ] + in + ignore (Thread.sigmask Unix.SIG_BLOCK signals : _ list); + f () + in + (* no signals on Windows *) + let run () = + if Sys.win32 then + f () + else + unix_run () + in + Thread.create run () + +(** thread that calls [tick()] regularly, to help enforce timeouts *) +let setup_ticker_thread ~(active : Aswitch.t) ~sleep_ms ~(tick : unit -> unit) + () = + let sleep_s = float sleep_ms /. 1000. in + let tick_loop () = + try + while Aswitch.is_on active do + Thread.delay sleep_s; + + if Aswitch.is_on active then tick () + done + with + | Sync_queue.Closed -> () + | exn -> + (* print and ignore *) + let bt = Printexc.get_raw_backtrace () in + Printf.eprintf "otel: background thread: uncaught exn:\n%s\n%s\n%!" + (Printexc.to_string exn) + (Printexc.raw_backtrace_to_string bt) + in + start_bg_thread tick_loop diff --git a/src/client/util_net_backoff.ml b/src/client/util_net_backoff.ml new file mode 100644 index 000000000..914856f93 --- /dev/null +++ b/src/client/util_net_backoff.ml @@ -0,0 +1,14 @@ +type t = { + mutable delay_s: float; + min_delay_s: float; + max_delay_s: float; +} + +let create () = { delay_s = 0.001; min_delay_s = 0.001; max_delay_s = 20. } + +let on_success self = self.delay_s <- max self.min_delay_s (self.delay_s /. 10.) + +let on_error self = + let cur = self.delay_s in + self.delay_s <- min self.max_delay_s (self.delay_s *. 2.); + cur diff --git a/src/client/util_net_backoff.mli b/src/client/util_net_backoff.mli new file mode 100644 index 000000000..af734c31f --- /dev/null +++ b/src/client/util_net_backoff.mli @@ -0,0 +1,13 @@ +(** Backoff behavior in case of errors *) + +type t +(** Backoff state for networking operations. Not thread safe. Do remember to add + a bit of jitter. *) + +val create : unit -> t + +val on_success : t -> unit +(** Reset backoff to its baseline. *) + +val on_error : t -> float +(** Increase backoff, returning the current delay in seconds *) diff --git a/src/client/util_resources.ml b/src/client/util_resources.ml new file mode 100644 index 000000000..b0ae954f3 --- /dev/null +++ b/src/client/util_resources.ml @@ -0,0 +1,37 @@ +(** Group signals into [resource_xxx] objects *) + +open Common_ + +open struct + let mk_resources ?service_name ?attrs () = + let attributes = OTEL.Globals.mk_attributes ?service_name ?attrs () in + Proto.Resource.make_resource ~attributes () +end + +let make_resource_logs ?service_name ?attrs (logs : Proto.Logs.log_record list) + : Proto.Logs.resource_logs = + let ll = + Proto.Logs.make_scope_logs ~scope:OTEL.Globals.instrumentation_library + ~log_records:logs () + in + let resource = mk_resources ?service_name ?attrs () in + Proto.Logs.make_resource_logs ~resource ~scope_logs:[ ll ] () + +let make_resource_spans ?service_name ?attrs spans : Proto.Trace.resource_spans + = + let ils = + Proto.Trace.make_scope_spans ~scope:OTEL.Globals.instrumentation_library + ~spans () + in + let resource = mk_resources ?service_name ?attrs () in + Proto.Trace.make_resource_spans ~resource ~scope_spans:[ ils ] () + +(** Aggregate metrics into a {!Proto.Metrics.resource_metrics} *) +let make_resource_metrics ?service_name ?attrs (l : OTEL.Metrics.t list) : + Proto.Metrics.resource_metrics = + let open Proto.Metrics in + let lm = + make_scope_metrics ~scope:OTEL.Globals.instrumentation_library ~metrics:l () + in + let resource = mk_resources ?service_name ?attrs () in + Proto.Metrics.make_resource_metrics ~scope_metrics:[ lm ] ~resource () diff --git a/src/core/any_signal.ml b/src/core/any_signal.ml new file mode 100644 index 000000000..4b3ec102c --- /dev/null +++ b/src/core/any_signal.ml @@ -0,0 +1,13 @@ +(** Any kind of signal *) + +open Common_ + +type t = + | Span of Span.t + | Metric of Metrics.t + | Log of Log_record.t + +let pp out = function + | Span s -> Proto.Trace.pp_span out s + | Metric m -> Proto.Metrics.pp_metric out m + | Log l -> Proto.Logs.pp_log_record out l diff --git a/src/core/any_signal_l.ml b/src/core/any_signal_l.ml new file mode 100644 index 000000000..7406c3559 --- /dev/null +++ b/src/core/any_signal_l.ml @@ -0,0 +1,37 @@ +(** Any kind of lists of signals *) + +open Common_ + +type t = + | Spans of Span.t list + | Metrics of Metrics.t list + | Logs of Log_record.t list + +open struct + let pp_sep out () = Format.fprintf out ";@ " + + let pp_list ppx out l = + Format.fprintf out "[@[%a@]]" (Format.pp_print_list ~pp_sep ppx) l +end + +let pp out = function + | Spans s -> pp_list Proto.Trace.pp_span out s + | Metrics m -> pp_list Proto.Metrics.pp_metric out m + | Logs l -> pp_list Proto.Logs.pp_log_record out l + +let length = function + | Spans l -> List.length l + | Metrics l -> List.length l + | Logs l -> List.length l + +let of_logs_or_empty = function + | [] -> [] + | l -> [ Logs l ] + +let of_metrics_or_empty = function + | [] -> [] + | l -> [ Metrics l ] + +let of_spans_or_empty = function + | [] -> [] + | l -> [ Spans l ] diff --git a/src/core/clock.ml b/src/core/clock.ml new file mode 100644 index 000000000..4ba17f538 --- /dev/null +++ b/src/core/clock.ml @@ -0,0 +1,40 @@ +open Opentelemetry_atomic + +type t = { now: unit -> Timestamp_ns.t } [@@unboxed] +(** A clock: can get the current timestamp, with nanoseconds precision *) + +let[@inline] now (self : t) : Timestamp_ns.t = self.now () + +open struct + module TS = Timestamp_ns + + let ns_in_a_day = Int64.(mul 1_000_000_000L (of_int (24 * 3600))) + + (** Current unix timestamp in nanoseconds *) + let[@inline] now_ptime_ () : TS.t = + let d, ps = Ptime_clock.now_d_ps () in + let d = Int64.(mul (of_int d) ns_in_a_day) in + let ns = Int64.(div ps 1_000L) in + Int64.(add d ns) +end + +(** Clock that uses ptime. *) +let ptime_clock : t = { now = now_ptime_ } + +(** Same as [now ptime_clock] *) +let now_ptime = now_ptime_ + +(** Singleton clock *) +module Main = struct + open struct + let main : t Atomic.t = Atomic.make ptime_clock + end + + let[@inline] get () = Atomic.get main + + (** Set the current clock *) + let set t : unit = Util_atomic.update_cas main (fun _ -> (), t) +end + +(** Timestamp using the main clock *) +let[@inline] now_main () = now (Main.get ()) diff --git a/src/core/common_.ml b/src/core/common_.ml new file mode 100644 index 000000000..c6544d5dd --- /dev/null +++ b/src/core/common_.ml @@ -0,0 +1,4 @@ +let spf = Printf.sprintf + +module Proto = Opentelemetry_proto +module Atomic = Opentelemetry_atomic.Atomic diff --git a/src/core/context.ml b/src/core/context.ml new file mode 100644 index 000000000..883f646e5 --- /dev/null +++ b/src/core/context.ml @@ -0,0 +1,17 @@ +(** The context used in OTEL operations, to carry the current trace, etc. + + https://opentelemetry.io/docs/specs/otel/context/ *) + +type t = Hmap.t +(** The context type. We use [Hmap.t] as it's standard and widely used. *) + +type 'a key = 'a Hmap.key + +let set = Hmap.add + +(** @raise Invalid_argument if not present *) +let get_exn : 'a key -> t -> 'a = Hmap.get + +let get : 'a key -> t -> 'a option = Hmap.find + +let[@inline] new_key () : 'a key = Hmap.Key.create () diff --git a/src/core/dune b/src/core/dune index 248e3aff7..b30ab7506 100644 --- a/src/core/dune +++ b/src/core/dune @@ -1,14 +1,23 @@ (library - (name opentelemetry) - (synopsis "API for opentelemetry instrumentation") - (flags :standard -warn-error -a+8) + (name opentelemetry_core) + (public_name opentelemetry.core) + (synopsis "Core types and definitions for opentelemetry") + (flags + :standard + -warn-error + -a+8 + -open + Opentelemetry_util + -open + Opentelemetry_atomic) (libraries - opentelemetry.proto - opentelemetry.ambient-context - ptime - ptime.clock.os + (re_export opentelemetry.proto) + opentelemetry.util + (re_export opentelemetry.atomic) + (re_export opentelemetry.emitter) pbrt threads - opentelemetry.atomic - hmap) - (public_name opentelemetry)) + ptime + ptime.clock.os + mtime + hmap)) diff --git a/src/core/event.ml b/src/core/event.ml new file mode 100644 index 000000000..34915e2e7 --- /dev/null +++ b/src/core/event.ml @@ -0,0 +1,9 @@ +open Common_ +open Proto.Trace + +type t = span_event + +let make ?(time_unix_nano = Clock.now_main ()) ?(attrs = []) (name : string) : t + = + let attrs = List.map Key_value.conv attrs in + make_span_event ~time_unix_nano ~name ~attributes:attrs () diff --git a/src/core/event.mli b/src/core/event.mli new file mode 100644 index 000000000..8b90f641e --- /dev/null +++ b/src/core/event.mli @@ -0,0 +1,12 @@ +(** Events. + + Events occur at a given time and can carry attributes. They always belong in + a span. *) + +open Common_ +open Proto.Trace + +type t = span_event + +val make : + ?time_unix_nano:Timestamp_ns.t -> ?attrs:Key_value.t list -> string -> t diff --git a/src/core/exporter.ml b/src/core/exporter.ml new file mode 100644 index 000000000..a26e03658 --- /dev/null +++ b/src/core/exporter.ml @@ -0,0 +1,39 @@ +(** Exporter. + + This is the pluggable component that actually sends signals to a OTEL + collector, or prints them, or saves them somewhere. + + This is part of the SDK, not just the API, so most real implementations live + in their own library. *) + +type t = { + export: Any_signal_l.t -> unit; + (** Export a batch of signals. Called by the provider when signals are + ready to be sent. *) + active: unit -> Aswitch.t; + (** Lifecycle switch: turns off when the exporter has fully shut down + (i.e. the consumer queue is drained). *) + shutdown: unit -> unit; + (** [shutdown ()] initiates shutdown: flushes remaining batches, closes + the queue, etc. Watch [active] to know when it's complete. + @since 0.12 *) + self_metrics: unit -> Metrics.t list; (** metrics about the exporter itself *) +} +(** Main exporter interface. *) + +(** Dummy exporter, does nothing *) +let dummy () : t = + { + export = ignore; + active = (fun () -> Aswitch.dummy); + shutdown = ignore; + self_metrics = (fun () -> []); + } + +let[@inline] active (self : t) : Aswitch.t = self.active () + +let[@inline] shutdown (self : t) : unit = self.shutdown () + +let (cleanup [@deprecated "use shutdown instead"]) = shutdown + +let[@inline] self_metrics (self : t) : _ list = self.self_metrics () diff --git a/src/core/instrument.ml b/src/core/instrument.ml new file mode 100644 index 000000000..953259b79 --- /dev/null +++ b/src/core/instrument.ml @@ -0,0 +1,221 @@ +type 'a t = { + kind: string; + name: string; + emit: clock:Clock.t -> unit -> Metrics.t list; + update: 'a -> unit; +} + +let all : (clock:Clock.t -> unit -> Metrics.t list) Alist.t = Alist.make () + +let register (instr : 'a t) : unit = Alist.add all instr.emit + +module Internal = struct + let iter_all f = Alist.get all |> List.iter f +end + +let float_add (a : float Atomic.t) (delta : float) : unit = + while + let cur = Atomic.get a in + not (Atomic.compare_and_set a cur (cur +. delta)) + do + () + done + +module type CUSTOM_IMPL = sig + type data + + type state + + val kind : string + + val init : unit -> state + + val update : state -> data -> unit + + val to_metrics : + state -> + name:string -> + ?description:string -> + ?unit_:string -> + clock:Clock.t -> + unit -> + Metrics.t list +end + +module Make (I : CUSTOM_IMPL) = struct + let create ~name ?description ?unit_ () : I.data t = + let state = I.init () in + let emit ~clock () = + I.to_metrics state ~name ?description ?unit_ ~clock () + in + let instrument = + { kind = I.kind; name; emit; update = I.update state } [@warning "-45"] + in + register instrument; + instrument +end + +module Int_counter = struct + include Make (struct + type data = int + + type state = int Atomic.t + + let kind = "counter" + + let init () = Atomic.make 0 + + let update state delta = ignore (Atomic.fetch_and_add state delta : int) + + let to_metrics state ~name ?description ?unit_ ~clock () = + let now = Clock.now clock in + [ + Metrics.sum ~name ?description ?unit_ ~is_monotonic:true + [ Metrics.int ~now (Atomic.get state) ]; + ] + end) + + let add (instrument : int t) delta = instrument.update delta +end + +module Float_counter = struct + include Make (struct + type data = float + + type state = float Atomic.t + + let kind = "counter" + + let init () = Atomic.make 0. + + let update state delta = float_add state delta + + let to_metrics state ~name ?description ?unit_ ~clock () = + let now = Clock.now clock in + [ + Metrics.sum ~name ?description ?unit_ ~is_monotonic:true + [ Metrics.float ~now (Atomic.get state) ]; + ] + end) + + let add (instrument : float t) delta = instrument.update delta +end + +module Int_gauge = struct + include Make (struct + type data = int + + type state = int Atomic.t + + let kind = "gauge" + + let init () = Atomic.make 0 + + let update state v = Atomic.set state v + + let to_metrics state ~name ?description ?unit_ ~clock () = + let now = Clock.now clock in + [ + Metrics.gauge ~name ?description ?unit_ + [ Metrics.int ~now (Atomic.get state) ]; + ] + end) + + let record (instrument : int t) v = instrument.update v +end + +module Float_gauge = struct + include Make (struct + type data = float + + type state = float Atomic.t + + let kind = "gauge" + + let init () = Atomic.make 0. + + let update state v = Atomic.set state v + + let to_metrics state ~name ?description ?unit_ ~clock () = + let now = Clock.now clock in + [ + Metrics.gauge ~name ?description ?unit_ + [ Metrics.float ~now (Atomic.get state) ]; + ] + end) + + let record (instrument : float t) v = instrument.update v +end + +module Histogram = struct + let default_bounds = + [ + 0.005; + 0.01; + 0.025; + 0.05; + 0.075; + 0.1; + 0.25; + 0.5; + 0.75; + 1.; + 2.5; + 5.; + 7.5; + 10.; + ] + + (* Find the index of the first bucket whose upper bound >= v. + Returns Array.length bounds if v exceeds all bounds (overflow bucket). *) + let find_bucket (bounds : float array) (v : float) : int = + let n = Array.length bounds in + let lo = ref 0 and hi = ref (n - 1) in + while !lo < !hi do + let mid = (!lo + !hi) / 2 in + if bounds.(mid) < v then + lo := mid + 1 + else + hi := mid + done; + if !lo < n && v <= bounds.(!lo) then + !lo + else + n + + let create ~name ?description ?unit_ ?(bounds = default_bounds) () : float t = + let bounds_arr = Array.of_list bounds in + let n_buckets = Array.length bounds_arr + 1 in + let bucket_counts = Array.init n_buckets (fun _ -> Atomic.make 0) in + let sum = Atomic.make 0. in + let count = Atomic.make 0 in + let update v = + let bucket = find_bucket bounds_arr v in + ignore (Atomic.fetch_and_add bucket_counts.(bucket) 1 : int); + float_add sum v; + ignore (Atomic.fetch_and_add count 1 : int) + in + let emit ~clock () = + let now = Clock.now clock in + let count_v = Int64.of_int (Atomic.get count) in + let sum_v = Atomic.get sum in + let bc = + Array.to_list + (Array.map (fun a -> Int64.of_int (Atomic.get a)) bucket_counts) + in + [ + Metrics.histogram ~name ?description ?unit_ + [ + Metrics.histogram_data_point ~now ~count:count_v ~sum:sum_v + ~bucket_counts:bc ~explicit_bounds:bounds (); + ]; + ] + in + let instrument = + { kind = "histogram"; name; emit; update } [@warning "-45"] + in + register instrument; + instrument + + let record (instrument : float t) v = instrument.update v +end diff --git a/src/core/instrument.mli b/src/core/instrument.mli new file mode 100644 index 000000000..e28201c1f --- /dev/null +++ b/src/core/instrument.mli @@ -0,0 +1,99 @@ +(** Global registry of metric instruments. + + Instruments are stateful accumulators (counters, gauges, histograms, …). + [update] is called at any time to record a value; [emit] is called at + collection time by a {!Meter.t}, which supplies the clock. + + All instruments register themselves into a global list on creation via + {!register}, so any meter can collect the full set in one pass. Make sure to + only create instruments at the toplevel so that the list doesn't grow + forever. *) + +type 'a t = { + kind: string; (** "counter", "gauge", "histogram", … *) + name: string; + emit: clock:Clock.t -> unit -> Metrics.t list; + (** Snapshot current accumulated state into metrics. *) + update: 'a -> unit; (** Record a new value. *) +} + +val register : 'a t -> unit +(** Add an instrument's [emit] to {!all}. Called automatically by the standard + instrument-creation functions. *) + +(** Implementation details for a custom stateful instrument. Pass to {!Make} to + obtain a [create] function. *) +module type CUSTOM_IMPL = sig + type data + + type state + + val kind : string + + val init : unit -> state + + val update : state -> data -> unit + + val to_metrics : + state -> + name:string -> + ?description:string -> + ?unit_:string -> + clock:Clock.t -> + unit -> + Metrics.t list +end + +(** Build a custom instrument type from a {!CUSTOM_IMPL}. The returned [create] + registers the instrument into {!all} automatically. *) +module Make (I : CUSTOM_IMPL) : sig + val create : + name:string -> ?description:string -> ?unit_:string -> unit -> I.data t +end + +module Int_counter : sig + val create : + name:string -> ?description:string -> ?unit_:string -> unit -> int t + + val add : int t -> int -> unit +end + +module Float_counter : sig + val create : + name:string -> ?description:string -> ?unit_:string -> unit -> float t + + val add : float t -> float -> unit +end + +module Int_gauge : sig + val create : + name:string -> ?description:string -> ?unit_:string -> unit -> int t + + val record : int t -> int -> unit +end + +module Float_gauge : sig + val create : + name:string -> ?description:string -> ?unit_:string -> unit -> float t + + val record : float t -> float -> unit +end + +module Histogram : sig + val default_bounds : float list + + val create : + name:string -> + ?description:string -> + ?unit_:string -> + ?bounds:float list -> + unit -> + float t + + val record : float t -> float -> unit +end + +module Internal : sig + val iter_all : ((clock:Clock.t -> unit -> Metrics.t list) -> unit) -> unit + (** Access all the instruments *) +end diff --git a/src/core/key_value.ml b/src/core/key_value.ml new file mode 100644 index 000000000..36ee087ce --- /dev/null +++ b/src/core/key_value.ml @@ -0,0 +1,11 @@ +open Common_ + +type t = string * Value.t + +let conv (k, v) = + let open Proto.Common in + let value = Value.conv v in + make_key_value ~key:k ?value () + +let of_otel (kv : Proto.Common.key_value) : t = + kv.key, Value.of_otel_opt kv.value diff --git a/src/core/lock.ml b/src/core/lock.ml deleted file mode 100644 index 6ce295bbc..000000000 --- a/src/core/lock.ml +++ /dev/null @@ -1,17 +0,0 @@ -let lock_ : (unit -> unit) ref = ref ignore - -let unlock_ : (unit -> unit) ref = ref ignore - -let set_mutex ~lock ~unlock : unit = - lock_ := lock; - unlock_ := unlock - -let[@inline] with_lock f = - !lock_ (); - match f () with - | x -> - !unlock_ (); - x - | exception e -> - !unlock_ (); - Printexc.raise_with_backtrace e (Printexc.get_raw_backtrace ()) diff --git a/src/core/lock.mli b/src/core/lock.mli deleted file mode 100644 index 2040bd1b6..000000000 --- a/src/core/lock.mli +++ /dev/null @@ -1,9 +0,0 @@ -(** A global lock, modifiable by the user *) - -val set_mutex : lock:(unit -> unit) -> unlock:(unit -> unit) -> unit -(** Set a pair of lock/unlock functions that are used to protect access to - global state, if needed. By default these do nothing. *) - -val with_lock : (unit -> 'a) -> 'a -(** Call [f()] while holding the mutex defined {!set_mutex}, then release the - mutex. *) diff --git a/src/core/log_record.ml b/src/core/log_record.ml new file mode 100644 index 000000000..438776c8e --- /dev/null +++ b/src/core/log_record.ml @@ -0,0 +1,83 @@ +(** Logs. + + See + {{:https://opentelemetry.io/docs/reference/specification/overview/#log-signal} + the spec} *) + +open Common_ +open Proto.Logs + +type t = Proto.Logs.log_record + +(** Severity level of a log event *) +type severity = Proto.Logs.severity_number = + | Severity_number_unspecified + | Severity_number_trace + | Severity_number_trace2 + | Severity_number_trace3 + | Severity_number_trace4 + | Severity_number_debug + | Severity_number_debug2 + | Severity_number_debug3 + | Severity_number_debug4 + | Severity_number_info + | Severity_number_info2 + | Severity_number_info3 + | Severity_number_info4 + | Severity_number_warn + | Severity_number_warn2 + | Severity_number_warn3 + | Severity_number_warn4 + | Severity_number_error + | Severity_number_error2 + | Severity_number_error3 + | Severity_number_error4 + | Severity_number_fatal + | Severity_number_fatal2 + | Severity_number_fatal3 + | Severity_number_fatal4 + +let pp_severity = pp_severity_number + +type flags = Proto.Logs.log_record_flags = + | Log_record_flags_do_not_use + | Log_record_flags_trace_flags_mask + +let pp_flags = Proto.Logs.pp_log_record_flags + +let pp = Proto.Logs.pp_log_record + +(** Make a single log entry. *) +let make ?time ?severity ?log_level ?flags ?trace_id ?span_id ?(attrs = []) + ~(observed_time_unix_nano : Timestamp_ns.t) (body : Value.t) : t = + let time_unix_nano = + match time with + | None -> observed_time_unix_nano + | Some t -> t + in + let trace_id = Option.map Trace_id.to_bytes trace_id in + let span_id = Option.map Span_id.to_bytes span_id in + let body = Value.conv body in + let attributes = List.map Key_value.conv attrs in + make_log_record ~time_unix_nano ~observed_time_unix_nano + ?severity_number:severity ?severity_text:log_level ?flags ?trace_id ?span_id + ~attributes ?body () + +(** Make a log entry whose body is a string *) +let make_str ?time ?severity ?log_level ?flags ?trace_id ?span_id ?attrs + ~observed_time_unix_nano (body : string) : t = + make ?time ~observed_time_unix_nano ?severity ?log_level ?flags ?trace_id + ?span_id ?attrs (`String body) + +(** Make a log entry with format *) +let make_strf ?time ?severity ?log_level ?flags ?trace_id ?span_id ?attrs + ~observed_time_unix_nano fmt = + Format.kasprintf + (fun bod -> + make_str ?time ~observed_time_unix_nano ?severity ?log_level ?flags + ?trace_id ?span_id ?attrs bod) + fmt + +let add_attrs (self : t) (attrs : Key_value.t list) : unit = + let attrs = List.map Key_value.conv attrs in + Proto.Logs.log_record_set_attributes self (attrs @ self.attributes) diff --git a/src/core/metrics.ml b/src/core/metrics.ml new file mode 100644 index 000000000..f9701d6dc --- /dev/null +++ b/src/core/metrics.ml @@ -0,0 +1,110 @@ +(** Metrics. + + See + {{:https://opentelemetry.io/docs/reference/specification/overview/#metric-signal} + the spec} *) + +open Common_ +open Proto +open Proto.Metrics + +type t = Metrics.metric +(** A single metric, measuring some time-varying quantity or statistical + distribution. It is composed of one or more data points that have precise + values and time stamps. Each distinct metric should have a distinct name. *) + +let pp = Proto.Metrics.pp_metric + +(** Number data point, as a float *) +let float ?start_time_unix_nano ?(attrs = []) ?(now = Clock.now_main ()) + (d : float) : number_data_point = + let attributes = attrs |> List.map Key_value.conv in + make_number_data_point ?start_time_unix_nano ~time_unix_nano:now ~attributes + ~value:(As_double d) () + +(** Number data point, as an int *) +let int ?start_time_unix_nano ?(attrs = []) ?(now = Clock.now_main ()) (i : int) + : number_data_point = + let attributes = attrs |> List.map Key_value.conv in + make_number_data_point ?start_time_unix_nano ~time_unix_nano:now ~attributes + ~value:(As_int (Int64.of_int i)) + () + +(** Aggregation of a scalar metric, always with the current value *) +let gauge ~name ?description ?unit_ (l : number_data_point list) : t = + let data = Gauge (make_gauge ~data_points:l ()) in + make_metric ~name ?description ?unit_ ~data () + +type aggregation_temporality = Metrics.aggregation_temporality = + | Aggregation_temporality_unspecified + | Aggregation_temporality_delta + | Aggregation_temporality_cumulative + +(** Sum of all reported measurements over a time interval *) +let sum ~name ?description ?unit_ + ?(aggregation_temporality = Aggregation_temporality_cumulative) + ?is_monotonic (l : number_data_point list) : t = + let data = + Sum (make_sum ~data_points:l ?is_monotonic ~aggregation_temporality ()) + in + make_metric ~name ?description ?unit_ ~data () + +type histogram_data_point = Metrics.histogram_data_point + +(** Histogram data + @param count number of values in population (non negative) + @param sum sum of values in population (0 if count is 0) + @param now the timestamp for this data point + @param bucket_counts + count value of histogram for each bucket. Sum of the counts must be equal + to [count]. length must be [1+length explicit_bounds] (unless both have + length 0) + @param explicit_bounds strictly increasing list of bounds for the buckets *) +let histogram_data_point ?start_time_unix_nano ?(attrs = []) ?(exemplars = []) + ~explicit_bounds ?sum ?(now = Clock.now_main ()) ~bucket_counts ~count () : + histogram_data_point = + let attributes = attrs |> List.map Key_value.conv in + make_histogram_data_point ?start_time_unix_nano ~time_unix_nano:now + ~attributes ~exemplars ~bucket_counts ~explicit_bounds ~count ?sum () + +let histogram ~name ?description ?unit_ ?aggregation_temporality + (l : histogram_data_point list) : t = + let data = + Histogram (make_histogram ~data_points:l ?aggregation_temporality ()) + in + make_metric ~name ?description ?unit_ ~data () + +let add_attrs (m : t) (attrs : Key_value.t list) : unit = + let attrs = List.map Key_value.conv attrs in + match m.data with + | None -> () + | Some (Gauge g) -> + List.iter + (fun (dp : number_data_point) -> + number_data_point_set_attributes dp (attrs @ dp.attributes)) + g.data_points + | Some (Sum s) -> + List.iter + (fun (dp : number_data_point) -> + number_data_point_set_attributes dp (attrs @ dp.attributes)) + s.data_points + | Some (Histogram h) -> + List.iter + (fun (dp : histogram_data_point) -> + histogram_data_point_set_attributes dp (attrs @ dp.attributes)) + h.data_points + | Some (Exponential_histogram eh) -> + List.iter + (fun (dp : exponential_histogram_data_point) -> + exponential_histogram_data_point_set_attributes dp + (attrs @ dp.attributes)) + eh.data_points + | Some (Summary s) -> + List.iter + (fun (dp : summary_data_point) -> + summary_data_point_set_attributes dp (attrs @ dp.attributes)) + s.data_points + +(* TODO: exponential history *) +(* TODO: summary *) +(* TODO: exemplar *) diff --git a/src/core/opentelemetry.ml b/src/core/opentelemetry.ml deleted file mode 100644 index ffac42b7d..000000000 --- a/src/core/opentelemetry.ml +++ /dev/null @@ -1,1687 +0,0 @@ -(** Opentelemetry types and instrumentation *) - -open struct - let spf = Printf.sprintf - - module Atomic = Opentelemetry_atomic.Atomic - module Ambient_context = Opentelemetry_ambient_context -end - -module Lock = Lock -(** Global lock. *) - -module Rand_bytes = Rand_bytes -(** Generation of random identifiers. *) - -module AList = AList -(** Atomic list, for internal usage - @since 0.7 *) - -module Util_mutex = Util_mutex -(** Utilities for internal usage. - @since NEXT_RELEASE *) - -(** {2 Wire format} *) - -module Proto = Opentelemetry_proto -(** Protobuf types. - - This is mostly useful internally. Users should not need to touch it. *) - -(** {2 Timestamps} *) - -(** Unix timestamp. - - These timestamps measure time since the Unix epoch (jan 1, 1970) UTC in - nanoseconds. *) -module Timestamp_ns = struct - type t = int64 - - let ns_in_a_day = Int64.(mul 1_000_000_000L (of_int (24 * 3600))) - - (** Current unix timestamp in nanoseconds *) - let[@inline] now_unix_ns () : t = - let span = Ptime_clock.now () |> Ptime.to_span in - let d, ps = Ptime.Span.to_d_ps span in - let d = Int64.(mul (of_int d) ns_in_a_day) in - let ns = Int64.(div ps 1_000L) in - Int64.(add d ns) -end - -(** {2 Interface to data collector} *) - -(** Collector types - - These types are used by backend implementations, to send events to - collectors such as Jaeger. - - Note: most users will not need to touch this module *) -module Collector = struct - open Opentelemetry_proto - - type 'msg sender = { send: 'a. 'msg -> ret:(unit -> 'a) -> 'a } - (** Sender interface for a message of type [msg]. Inspired from Logs' reporter - (see - {{:https://erratique.ch/software/logs/doc/Logs/index.html#sync} its doc}) - but without [over] as it doesn't make much sense in presence of batching. - - The [ret] callback is used to return the desired type (unit, or a Lwt - promise, or anything else) once the event has been transferred to the - backend. It doesn't mean the event has been collected yet, it could sit in - a batch queue for a little while. *) - - (** Collector client interface. *) - module type BACKEND = sig - val send_trace : Trace.resource_spans list sender - - val send_metrics : Metrics.resource_metrics list sender - - val send_logs : Logs.resource_logs list sender - - val signal_emit_gc_metrics : unit -> unit - (** Signal the backend that it should emit GC metrics when it has the - chance. This should be installed in a GC alarm or another form of - regular trigger. *) - - val tick : unit -> unit - (** Should be called regularly for background processing, timeout checks, - etc. *) - - val set_on_tick_callbacks : (unit -> unit) AList.t -> unit - (** Give the collector the list of callbacks to be executed when [tick()] is - called. Each such callback should be short and reentrant. Depending on - the collector's implementation, it might be called from a thread that is - not the one that called [on_tick]. *) - - val cleanup : on_done:(unit -> unit) -> unit -> unit - (** [cleanup ~on_done ()] is called when the collector is shut down, and is - responsible for sending remaining batches, flushing sockets, etc. - @param on_done - callback invoked after the cleanup is done. @since 0.12 *) - end - - type backend = (module BACKEND) - - module Noop_backend : BACKEND = struct - let noop_sender _ ~ret = ret () - - let send_trace : Trace.resource_spans list sender = { send = noop_sender } - - let send_metrics : Metrics.resource_metrics list sender = - { send = noop_sender } - - let send_logs : Logs.resource_logs list sender = { send = noop_sender } - - let signal_emit_gc_metrics () = () - - let tick () = () - - let set_on_tick_callbacks _cbs = () - - let cleanup ~on_done () = - on_done (); - () - end - - module Debug_backend (B : BACKEND) : BACKEND = struct - open Proto - - let send_trace : Trace.resource_spans list sender = - { - send = - (fun l ~ret -> - Format.eprintf "SPANS: %a@." - (Format.pp_print_list Trace.pp_resource_spans) - l; - B.send_trace.send l ~ret); - } - - let send_metrics : Metrics.resource_metrics list sender = - { - send = - (fun l ~ret -> - Format.eprintf "METRICS: %a@." - (Format.pp_print_list Metrics.pp_resource_metrics) - l; - B.send_metrics.send l ~ret); - } - - let send_logs : Logs.resource_logs list sender = - { - send = - (fun l ~ret -> - Format.eprintf "LOGS: %a@." - (Format.pp_print_list Logs.pp_resource_logs) - l; - B.send_logs.send l ~ret); - } - - let signal_emit_gc_metrics () = B.signal_emit_gc_metrics () - - let tick () = B.tick () - - let set_on_tick_callbacks cbs = B.set_on_tick_callbacks cbs - - let cleanup ~on_done () = B.cleanup ~on_done () - end - - let debug_backend : backend = (module Debug_backend (Noop_backend)) - - (* hidden *) - open struct - let on_tick_cbs_ = AList.make () - - let backend : backend option Atomic.t = Atomic.make None - end - - (** Set collector backend *) - let set_backend (b : backend) : unit = - let (module B) = b in - B.set_on_tick_callbacks on_tick_cbs_; - Atomic.set backend (Some b) - - (** Remove current backend, if any. - @since 0.11 - @param on_done see {!BACKEND.cleanup}, @since 0.12 *) - let remove_backend ~on_done () : unit = - match Atomic.exchange backend None with - | None -> () - | Some (module B) -> - B.tick (); - B.cleanup ~on_done () - - (** Is there a configured backend? *) - let[@inline] has_backend () : bool = Atomic.get backend != None - - (** Current backend, if any *) - let[@inline] get_backend () : backend option = Atomic.get backend - - let send_trace (l : Trace.resource_spans list) ~ret = - match Atomic.get backend with - | None -> ret () - | Some (module B) -> B.send_trace.send l ~ret - - let send_metrics (l : Metrics.resource_metrics list) ~ret = - match Atomic.get backend with - | None -> ret () - | Some (module B) -> B.send_metrics.send l ~ret - - let send_logs (l : Logs.resource_logs list) ~ret = - match Atomic.get backend with - | None -> ret () - | Some (module B) -> B.send_logs.send l ~ret - - let[@inline] rand_bytes_16 () = !Rand_bytes.rand_bytes_16 () - - let[@inline] rand_bytes_8 () = !Rand_bytes.rand_bytes_8 () - - let[@inline] on_tick f = AList.add on_tick_cbs_ f - - (** Do background work. Call this regularly if the collector doesn't already - have a ticker thread or internal timer. *) - let tick () = - match Atomic.get backend with - | None -> () - | Some (module B) -> B.tick () - - let with_setup_debug_backend ?(on_done = ignore) b ?(enable = true) () f = - let (module B : BACKEND) = b in - if enable then ( - set_backend b; - Fun.protect ~finally:(B.cleanup ~on_done) f - ) else - f () -end - -(**/**) - -module Util_ = struct - let int_to_hex (i : int) = - if i < 10 then - Char.chr (i + Char.code '0') - else - Char.chr (i - 10 + Char.code 'a') - - let bytes_to_hex_into b res off : unit = - for i = 0 to Bytes.length b - 1 do - let n = Char.code (Bytes.get b i) in - Bytes.set res ((2 * i) + off) (int_to_hex ((n land 0xf0) lsr 4)); - Bytes.set res ((2 * i) + 1 + off) (int_to_hex (n land 0x0f)) - done - - let bytes_to_hex (b : bytes) : string = - let res = Bytes.create (2 * Bytes.length b) in - bytes_to_hex_into b res 0; - Bytes.unsafe_to_string res - - let int_of_hex = function - | '0' .. '9' as c -> Char.code c - Char.code '0' - | 'a' .. 'f' as c -> 10 + Char.code c - Char.code 'a' - | c -> raise (Invalid_argument (spf "invalid hex char: %C" c)) - - let bytes_of_hex_substring (s : string) off len = - if len mod 2 <> 0 then - raise (Invalid_argument "hex sequence must be of even length"); - let res = Bytes.make (len / 2) '\x00' in - for i = 0 to (len / 2) - 1 do - let n1 = int_of_hex (String.get s (off + (2 * i))) in - let n2 = int_of_hex (String.get s (off + (2 * i) + 1)) in - let n = (n1 lsl 4) lor n2 in - Bytes.set res i (Char.chr n) - done; - res - - let bytes_of_hex (s : string) : bytes = - bytes_of_hex_substring s 0 (String.length s) - - let bytes_non_zero (self : bytes) : bool = - try - for i = 0 to Bytes.length self - 1 do - if Char.code (Bytes.unsafe_get self i) <> 0 then raise_notrace Exit - done; - false - with Exit -> true -end - -(**/**) - -(** {2 Identifiers} *) - -(** Trace ID. - - This 16 bytes identifier is shared by all spans in one trace. *) -module Trace_id : sig - type t - - val create : unit -> t - - val dummy : t - - val pp : Format.formatter -> t -> unit - - val is_valid : t -> bool - - val to_bytes : t -> bytes - - val of_bytes : bytes -> t - - val to_hex : t -> string - - val to_hex_into : t -> bytes -> int -> unit - - val of_hex : string -> t - - val of_hex_substring : string -> int -> t -end = struct - type t = bytes - - let[@inline] to_bytes self = self - - let dummy : t = Bytes.make 16 '\x00' - - let create () : t = - let b = Collector.rand_bytes_16 () in - assert (Bytes.length b = 16); - (* make sure the identifier is not all 0, which is a dummy identifier. *) - Bytes.set b 0 (Char.unsafe_chr (Char.code (Bytes.get b 0) lor 1)); - b - - let[@inline] of_bytes b = - if Bytes.length b = 16 then - b - else - raise (Invalid_argument "trace ID must be 16 bytes in length") - - let is_valid = Util_.bytes_non_zero - - let to_hex = Util_.bytes_to_hex - - let to_hex_into = Util_.bytes_to_hex_into - - let[@inline] of_hex s = of_bytes (Util_.bytes_of_hex s) - - let[@inline] of_hex_substring s off = - of_bytes (Util_.bytes_of_hex_substring s off 32) - - let pp fmt t = Format.fprintf fmt "%s" (to_hex t) -end - -(** Hmap key to carry around a {!Trace_id.t}, to remember what the current trace - is. - @since 0.8 *) -let k_trace_id : Trace_id.t Hmap.key = Hmap.Key.create () - -(** Unique ID of a span. *) -module Span_id : sig - type t - - val create : unit -> t - - val dummy : t - - val pp : Format.formatter -> t -> unit - - val is_valid : t -> bool - - val to_bytes : t -> bytes - - val of_bytes : bytes -> t - - val to_hex : t -> string - - val to_hex_into : t -> bytes -> int -> unit - - val of_hex : string -> t - - val of_hex_substring : string -> int -> t -end = struct - type t = bytes - - let[@inline] to_bytes self = self - - let dummy : t = Bytes.make 8 '\x00' - - let create () : t = - let b = Collector.rand_bytes_8 () in - assert (Bytes.length b = 8); - (* make sure the identifier is not all 0, which is a dummy identifier. *) - Bytes.set b 0 (Char.unsafe_chr (Char.code (Bytes.get b 0) lor 1)); - b - - let is_valid = Util_.bytes_non_zero - - let of_bytes b = - if Bytes.length b = 8 then - b - else - raise (Invalid_argument "span IDs must be 8 bytes in length") - - let to_hex = Util_.bytes_to_hex - - let to_hex_into = Util_.bytes_to_hex_into - - let[@inline] of_hex s = of_bytes (Util_.bytes_of_hex s) - - let[@inline] of_hex_substring s off = - of_bytes (Util_.bytes_of_hex_substring s off 16) - - let pp fmt t = Format.fprintf fmt "%s" (to_hex t) -end - -(** Span context. This bundles up a trace ID and parent ID. - - {{:https://opentelemetry.io/docs/specs/otel/trace/api/#spancontext} - https://opentelemetry.io/docs/specs/otel/trace/api/#spancontext} - @since 0.7 *) -module Span_ctx : sig - type t - - val make : - ?sampled:bool -> trace_id:Trace_id.t -> parent_id:Span_id.t -> unit -> t - - val dummy : t - (** Invalid span context, to be used as a placeholder *) - - val is_valid : t -> bool - - val trace_id : t -> Trace_id.t - - val parent_id : t -> Span_id.t - - val sampled : t -> bool - - val to_w3c_trace_context : t -> bytes - - val of_w3c_trace_context : bytes -> (t, string) result - - val of_w3c_trace_context_exn : bytes -> t - (** @raise Invalid_argument if parsing failed *) -end = struct - (* TODO: trace state *) - - type t = { - trace_id: Trace_id.t; - parent_id: Span_id.t; - sampled: bool; - } - - let dummy = - { trace_id = Trace_id.dummy; parent_id = Span_id.dummy; sampled = false } - - let make ?(sampled = false) ~trace_id ~parent_id () : t = - { trace_id; parent_id; sampled } - - let[@inline] is_valid self = - Trace_id.is_valid self.trace_id && Span_id.is_valid self.parent_id - - let[@inline] sampled self = self.sampled - - let[@inline] trace_id self = self.trace_id - - let[@inline] parent_id self = self.parent_id - - let to_w3c_trace_context (self : t) : bytes = - let bs = Bytes.create 55 in - Bytes.set bs 0 '0'; - Bytes.set bs 1 '0'; - Bytes.set bs 2 '-'; - Trace_id.to_hex_into self.trace_id bs 3; - (* +32 *) - Bytes.set bs (3 + 32) '-'; - Span_id.to_hex_into self.parent_id bs 36; - (* +16 *) - Bytes.set bs 52 '-'; - Bytes.set bs 53 '0'; - Bytes.set bs 54 - (if self.sampled then - '1' - else - '0'); - bs - - let of_w3c_trace_context bs : _ result = - try - if Bytes.length bs <> 55 then invalid_arg "trace context must be 55 bytes"; - (match int_of_string_opt (Bytes.sub_string bs 0 2) with - | Some 0 -> () - | Some n -> invalid_arg @@ spf "version is %d, expected 0" n - | None -> invalid_arg "expected 2-digit version"); - if Bytes.get bs 2 <> '-' then invalid_arg "expected '-' before trace_id"; - let trace_id = - try Trace_id.of_hex_substring (Bytes.unsafe_to_string bs) 3 - with Invalid_argument msg -> invalid_arg (spf "in trace id: %s" msg) - in - if Bytes.get bs (3 + 32) <> '-' then - invalid_arg "expected '-' before parent_id"; - let parent_id = - try Span_id.of_hex_substring (Bytes.unsafe_to_string bs) 36 - with Invalid_argument msg -> invalid_arg (spf "in span id: %s" msg) - in - if Bytes.get bs 52 <> '-' then invalid_arg "expected '-' after parent_id"; - let sampled = int_of_string_opt (Bytes.sub_string bs 53 2) = Some 1 in - - (* ignore flags *) - Ok { trace_id; parent_id; sampled } - with Invalid_argument msg -> Error msg - - let of_w3c_trace_context_exn bs = - match of_w3c_trace_context bs with - | Ok t -> t - | Error msg -> invalid_arg @@ spf "invalid w3c trace context: %s" msg -end - -(** Hmap key to carry around a {!Span_ctx.t}, e.g. to remember what the current - parent span is. - @since 0.8 *) -let k_span_ctx : Span_ctx.t Hmap.key = Hmap.Key.create () - -(** {2 Attributes and conventions} *) - -(** Semantic conventions - - {{:https://opentelemetry.io/docs/specs/semconv/} - https://opentelemetry.io/docs/specs/semconv/} *) -module Conventions = struct - module Attributes = struct - module Process = struct - module Runtime = struct - let name = "process.runtime.name" - - let version = "process.runtime.version" - - let description = "process.runtime.description" - end - end - - (** https://opentelemetry.io/docs/specs/semconv/attributes-registry/code/ *) - module Code = struct - (** Int *) - let column = "code.column" - - let filepath = "code.filepath" - - let function_ = "code.function" - - (** int *) - let line = "code.lineno" - - let namespace = "code.namespace" - - let stacktrace = "code.stacktrace" - end - - module Service = struct - let name = "service.name" - - let namespace = "service.namespace" - - let instance_id = "service.instance.id" - - let version = "service.version" - end - - module HTTP = struct - let error_type = "error.type" - - let request_method = "http.request.method" - - let route = "http.route" - - let url_full = "url.full" - - (** HTTP status code, int *) - let response_status_code = "http.response.status_code" - - let server_address = "server.address" - - let server_port = "server.port" - - (** http or https *) - let url_scheme = "url.scheme" - end - - (** https://github.com/open-telemetry/semantic-conventions/blob/main/docs/resource/host.md - *) - module Host = struct - let id = "host.id" - - let name = "host.name" - - let type_ = "host.type" - - let arch = "host.arch" - - let ip = "host.ip" - - let mac = "host.mac" - - let image_id = "host.image.id" - - let image_name = "host.image.name" - - let image_version = "host.image.version" - end - end - - module Metrics = struct - module Process = struct - module Runtime = struct - module Ocaml = struct - module GC = struct - let compactions = "process.runtime.ocaml.gc.compactions" - - let major_collections = "process.runtime.ocaml.gc.major_collections" - - let major_heap = "process.runtime.ocaml.gc.major_heap" - - let minor_allocated = "process.runtime.ocaml.gc.minor_allocated" - - let minor_collections = "process.runtime.ocaml.gc.minor_collections" - end - end - end - end - - (** https://opentelemetry.io/docs/specs/semconv/http/ *) - module HTTP = struct - module Server = struct - let request_duration = "http.server.request.duration" - - let active_requests = "http.server.active_requests" - - (** Histogram *) - let request_body_size = "http.server.request.body.size" - - (** Histogram *) - let response_body_size = "http.server.response.body.size" - end - - module Client = struct - let request_duration = "http.client.request.duration" - - (** Histogram *) - let request_body_size = "http.client.request.body.size" - - (** Histogram *) - let response_body_size = "http.client.response.body.size" - end - end - end -end - -type value = - [ `Int of int - | `String of string - | `Bool of bool - | `Float of float - | `None - ] -(** A value in a key/value attribute *) - -type key_value = string * value - -open struct - let _conv_value = - let open Proto.Common in - function - | `Int i -> Some (Int_value (Int64.of_int i)) - | `String s -> Some (String_value s) - | `Bool b -> Some (Bool_value b) - | `Float f -> Some (Double_value f) - | `None -> None - - let _conv_key_value (k, v) = - let open Proto.Common in - let value = _conv_value v in - default_key_value ~key:k ~value () -end - -(** {2 Global settings} *) - -(** Process-wide metadata, environment variables, etc. *) -module Globals = struct - open Proto.Common - - (** Main service name metadata *) - let service_name = ref "unknown_service" - - (** Namespace for the service *) - let service_namespace = ref None - - (** Unique identifier for the service *) - let service_instance_id = ref None - - (** Version for the service - @since 0.12 *) - let service_version = ref None - - let instrumentation_library = - default_instrumentation_scope ~version:"%%VERSION_NUM%%" ~name:"ocaml-otel" - () - - (** Global attributes, initially set via OTEL_RESOURCE_ATTRIBUTES and - modifiable by the user code. They will be attached to each outgoing - metrics/traces. *) - let global_attributes : key_value list ref = - let parse_pair s = - match String.split_on_char '=' s with - | [ a; b ] -> default_key_value ~key:a ~value:(Some (String_value b)) () - | _ -> failwith (Printf.sprintf "invalid attribute: %S" s) - in - ref - @@ - try - Sys.getenv "OTEL_RESOURCE_ATTRIBUTES" - |> String.split_on_char ',' |> List.map parse_pair - with _ -> [] - - (** Add a global attribute *) - let add_global_attribute (key : string) (v : value) : unit = - global_attributes := _conv_key_value (key, v) :: !global_attributes - - (* add global attributes to this list *) - let merge_global_attributes_ into : _ list = - let not_redundant kv = List.for_all (fun kv' -> kv.key <> kv'.key) into in - List.rev_append (List.filter not_redundant !global_attributes) into - - (** Default span kind in {!Span.create}. This will be used in all spans that - do not specify [~kind] explicitly; it is set to "internal", following - directions from the [.proto] file. It can be convenient to set "client" or - "server" uniformly in here. - @since 0.4 *) - let default_span_kind = ref Proto.Trace.Span_kind_internal - - let mk_attributes ?(service_name = !service_name) ?(attrs = []) () : _ list = - let l = List.map _conv_key_value attrs in - let l = - default_key_value ~key:Conventions.Attributes.Service.name - ~value:(Some (String_value service_name)) () - :: l - in - let l = - match !service_instance_id with - | None -> l - | Some v -> - default_key_value ~key:Conventions.Attributes.Service.instance_id - ~value:(Some (String_value v)) () - :: l - in - let l = - match !service_namespace with - | None -> l - | Some v -> - default_key_value ~key:Conventions.Attributes.Service.namespace - ~value:(Some (String_value v)) () - :: l - in - let l = - match !service_version with - | None -> l - | Some v -> - default_key_value ~key:Conventions.Attributes.Service.version - ~value:(Some (String_value v)) () - :: l - in - l |> merge_global_attributes_ -end - -(** {2 Traces and Spans} *) - -(** Events. - - Events occur at a given time and can carry attributes. They always belong in - a span. *) -module Event : sig - open Proto.Trace - - type t = span_event - - val make : - ?time_unix_nano:Timestamp_ns.t -> ?attrs:key_value list -> string -> t -end = struct - open Proto.Trace - - type t = span_event - - let make ?(time_unix_nano = Timestamp_ns.now_unix_ns ()) ?(attrs = []) - (name : string) : t = - let attrs = List.map _conv_key_value attrs in - default_span_event ~time_unix_nano ~name ~attributes:attrs () -end - -(** Span Link - - A pointer from the current span to another span in the same trace or in a - different trace. For example, this can be used in batching operations, where - a single batch handler processes multiple requests from different traces or - when the handler receives a request from a different project. *) -module Span_link : sig - open Proto.Trace - - type t = span_link - - val make : - trace_id:Trace_id.t -> - span_id:Span_id.t -> - ?trace_state:string -> - ?attrs:key_value list -> - ?dropped_attributes_count:int -> - unit -> - t - - val of_span_ctx : - ?trace_state:string -> - ?attrs:key_value list -> - ?dropped_attributes_count:int -> - Span_ctx.t -> - t -end = struct - open Proto.Trace - - type t = span_link - - let make ~trace_id ~span_id ?trace_state ?(attrs = []) - ?dropped_attributes_count () : t = - let attributes = List.map _conv_key_value attrs in - let dropped_attributes_count = - Option.map Int32.of_int dropped_attributes_count - in - default_span_link - ~trace_id:(Trace_id.to_bytes trace_id) - ~span_id:(Span_id.to_bytes span_id) ?trace_state ~attributes - ?dropped_attributes_count () - - let[@inline] of_span_ctx ?trace_state ?attrs ?dropped_attributes_count - (ctx : Span_ctx.t) : t = - make ~trace_id:(Span_ctx.trace_id ctx) ~span_id:(Span_ctx.parent_id ctx) - ?trace_state ?attrs ?dropped_attributes_count () -end - -module Span_status : sig - open Proto.Trace - - type t = status = { - message: string; - code: status_status_code; - } - - type code = status_status_code = - | Status_code_unset - | Status_code_ok - | Status_code_error - - val make : message:string -> code:code -> t -end = struct - open Proto.Trace - - type t = status = { - message: string; - code: status_status_code; - } - - type code = status_status_code = - | Status_code_unset - | Status_code_ok - | Status_code_error - - let make ~message ~code = { message; code } -end - -(** @since 0.11 *) -module Span_kind : sig - open Proto.Trace - - type t = span_span_kind = - | Span_kind_unspecified - | Span_kind_internal - | Span_kind_server - | Span_kind_client - | Span_kind_producer - | Span_kind_consumer -end = struct - open Proto.Trace - - type t = span_span_kind = - | Span_kind_unspecified - | Span_kind_internal - | Span_kind_server - | Span_kind_client - | Span_kind_producer - | Span_kind_consumer -end - -(** {2 Scopes} *) - -(** Scopes. - - A scope is a trace ID and the span ID of the currently active span. *) -module Scope : sig - type item_list - - type t = { - trace_id: Trace_id.t; - span_id: Span_id.t; - mutable items: item_list; - } - - val attrs : t -> key_value list - - val events : t -> Event.t list - - val links : t -> Span_link.t list - - val status : t -> Span_status.t option - - val kind : t -> Span_kind.t option - - val make : - trace_id:Trace_id.t -> - span_id:Span_id.t -> - ?events:Event.t list -> - ?attrs:key_value list -> - ?links:Span_link.t list -> - ?status:Span_status.t -> - unit -> - t - - val to_span_link : - ?trace_state:string -> - ?attrs:key_value list -> - ?dropped_attributes_count:int -> - t -> - Span_link.t - (** Turn the scope into a span link *) - - val to_span_ctx : t -> Span_ctx.t - (** Turn the scope into a span context *) - - val add_event : t -> (unit -> Event.t) -> unit - (** Add an event to the scope. It will be aggregated into the span. - - Note that this takes a function that produces an event, and will only call - it if there is an instrumentation backend. *) - - val record_exception : t -> exn -> Printexc.raw_backtrace -> unit - - val add_attrs : t -> (unit -> key_value list) -> unit - (** Add attributes to the scope. It will be aggregated into the span. - - Note that this takes a function that produces attributes, and will only - call it if there is an instrumentation backend. *) - - val add_links : t -> (unit -> Span_link.t list) -> unit - (** Add links to the scope. It will be aggregated into the span. - - Note that this takes a function that produces links, and will only call it - if there is an instrumentation backend. *) - - val set_status : t -> Span_status.t -> unit - (** set the span status. - - Note that this function will be called only if there is an instrumentation - backend. *) - - val set_kind : t -> Span_kind.t -> unit - (** Set the span's kind. - @since 0.11 *) - - val ambient_scope_key : t Ambient_context.key - (** The opaque key necessary to access/set the ambient scope with - {!Ambient_context}. *) - - val get_ambient_scope : ?scope:t -> unit -> t option - (** Obtain current scope from {!Ambient_context}, if available. *) - - val with_ambient_scope : t -> (unit -> 'a) -> 'a - (** [with_ambient_scope sc thunk] calls [thunk()] in a context where [sc] is - the (thread|continuation)-local scope, then reverts to the previous local - scope, if any. - - @see - ambient-context docs *) -end = struct - type item_list = - | Nil - | Ev of Event.t * item_list - | Attr of key_value * item_list - | Span_link of Span_link.t * item_list - | Span_status of Span_status.t * item_list - | Span_kind of Span_kind.t * item_list - - type t = { - trace_id: Trace_id.t; - span_id: Span_id.t; - mutable items: item_list; - } - - let attrs scope = - let rec loop acc = function - | Nil -> acc - | Attr (attr, l) -> loop (attr :: acc) l - | Ev (_, l) | Span_kind (_, l) | Span_link (_, l) | Span_status (_, l) -> - loop acc l - in - loop [] scope.items - - let events scope = - let rec loop acc = function - | Nil -> acc - | Ev (event, l) -> loop (event :: acc) l - | Attr (_, l) | Span_kind (_, l) | Span_link (_, l) | Span_status (_, l) - -> - loop acc l - in - loop [] scope.items - - let links scope = - let rec loop acc = function - | Nil -> acc - | Span_link (span_link, l) -> loop (span_link :: acc) l - | Ev (_, l) | Span_kind (_, l) | Attr (_, l) | Span_status (_, l) -> - loop acc l - in - loop [] scope.items - - let status scope = - let rec loop = function - | Nil -> None - | Span_status (status, _) -> Some status - | Ev (_, l) | Attr (_, l) | Span_kind (_, l) | Span_link (_, l) -> loop l - in - loop scope.items - - let kind scope = - let rec loop = function - | Nil -> None - | Span_kind (k, _) -> Some k - | Ev (_, l) | Span_status (_, l) | Attr (_, l) | Span_link (_, l) -> - loop l - in - loop scope.items - - let make ~trace_id ~span_id ?(events = []) ?(attrs = []) ?(links = []) ?status - () : t = - let items = - let items = - match status with - | None -> Nil - | Some status -> Span_status (status, Nil) - in - let items = List.fold_left (fun acc ev -> Ev (ev, acc)) items events in - let items = - List.fold_left (fun acc attr -> Attr (attr, acc)) items attrs - in - List.fold_left (fun acc link -> Span_link (link, acc)) items links - in - { trace_id; span_id; items } - - let[@inline] to_span_link ?trace_state ?attrs ?dropped_attributes_count - (self : t) : Span_link.t = - Span_link.make ?trace_state ?attrs ?dropped_attributes_count - ~trace_id:self.trace_id ~span_id:self.span_id () - - let[@inline] to_span_ctx (self : t) : Span_ctx.t = - Span_ctx.make ~trace_id:self.trace_id ~parent_id:self.span_id () - - let[@inline] add_event (scope : t) (ev : unit -> Event.t) : unit = - if Collector.has_backend () then scope.items <- Ev (ev (), scope.items) - - let[@inline] record_exception (scope : t) (exn : exn) - (bt : Printexc.raw_backtrace) : unit = - if Collector.has_backend () then ( - let ev = - Event.make "exception" - ~attrs: - [ - "exception.message", `String (Printexc.to_string exn); - "exception.type", `String (Printexc.exn_slot_name exn); - ( "exception.stacktrace", - `String (Printexc.raw_backtrace_to_string bt) ); - ] - in - scope.items <- Ev (ev, scope.items) - ) - - let[@inline] add_attrs (scope : t) (attrs : unit -> key_value list) : unit = - if Collector.has_backend () then - scope.items <- - List.fold_left (fun acc attr -> Attr (attr, acc)) scope.items (attrs ()) - - let[@inline] add_links (scope : t) (links : unit -> Span_link.t list) : unit = - if Collector.has_backend () then - scope.items <- - List.fold_left - (fun acc link -> Span_link (link, acc)) - scope.items (links ()) - - let set_status (scope : t) (status : Span_status.t) : unit = - if Collector.has_backend () then - scope.items <- Span_status (status, scope.items) - - let set_kind (scope : t) (k : Span_kind.t) : unit = - if Collector.has_backend () then scope.items <- Span_kind (k, scope.items) - - let ambient_scope_key : t Ambient_context.key = Ambient_context.create_key () - - let get_ambient_scope ?scope () : t option = - match scope with - | Some _ -> scope - | None -> Ambient_context.get ambient_scope_key - - let[@inline] with_ambient_scope (sc : t) (f : unit -> 'a) : 'a = - Ambient_context.with_binding ambient_scope_key sc (fun _ -> f ()) -end - -(** {2 Traces} *) - -(** Spans. - - A Span is the workhorse of traces, it indicates an operation that took place - over a given span of time (indicated by start_time and end_time) as part of - a hierarchical trace. All spans in a given trace are bound by the use of the - same {!Trace_id.t}. *) -module Span : sig - open Proto.Trace - - type t = span - - type id = Span_id.t - - type kind = Span_kind.t = - | Span_kind_unspecified - | Span_kind_internal - | Span_kind_server - | Span_kind_client - | Span_kind_producer - | Span_kind_consumer - - val id : t -> Span_id.t - - type key_value = - string - * [ `Int of int - | `String of string - | `Bool of bool - | `Float of float - | `None - ] - - val create : - ?kind:kind -> - ?id:id -> - ?trace_state:string -> - ?attrs:key_value list -> - ?events:Event.t list -> - ?status:status -> - trace_id:Trace_id.t -> - ?parent:id -> - ?links:Span_link.t list -> - start_time:Timestamp_ns.t -> - end_time:Timestamp_ns.t -> - string -> - t * id - (** [create ~trace_id name] creates a new span with its unique ID. - @param trace_id the trace this belongs to - @param parent parent span, if any - @param links - list of links to other spans, each with their trace state (see - {{:https://www.w3.org/TR/trace-context/#tracestate-header} w3.org}) *) -end = struct - open Proto.Trace - - type t = span - - type id = Span_id.t - - type kind = Span_kind.t = - | Span_kind_unspecified - | Span_kind_internal - | Span_kind_server - | Span_kind_client - | Span_kind_producer - | Span_kind_consumer - - type key_value = - string - * [ `Int of int - | `String of string - | `Bool of bool - | `Float of float - | `None - ] - - let id self = Span_id.of_bytes self.span_id - - let create ?(kind = !Globals.default_span_kind) ?(id = Span_id.create ()) - ?trace_state ?(attrs = []) ?(events = []) ?status ~trace_id ?parent - ?(links = []) ~start_time ~end_time name : t * id = - let trace_id = Trace_id.to_bytes trace_id in - let parent_span_id = Option.map Span_id.to_bytes parent in - let attributes = List.map _conv_key_value attrs in - let span = - default_span ~trace_id ?parent_span_id ~span_id:(Span_id.to_bytes id) - ~attributes ~events ?trace_state ~status ~kind ~name ~links - ~start_time_unix_nano:start_time ~end_time_unix_nano:end_time () - in - span, id -end - -(** Traces. - - See - {{:https://opentelemetry.io/docs/reference/specification/overview/#tracing-signal} - the spec} *) -module Trace = struct - open Proto.Trace - - type span = Span.t - - let make_resource_spans ?service_name ?attrs spans = - let ils = - default_scope_spans ~scope:(Some Globals.instrumentation_library) ~spans - () - in - let attributes = Globals.mk_attributes ?service_name ?attrs () in - let resource = Proto.Resource.default_resource ~attributes () in - default_resource_spans ~resource:(Some resource) ~scope_spans:[ ils ] () - - (** Sync emitter. - - This instructs the collector to forward the spans to some backend at a - later point. - - {b NOTE} be careful not to call this inside a Gc alarm, as it can cause - deadlocks. *) - let emit ?service_name ?attrs (spans : span list) : unit = - let rs = make_resource_spans ?service_name ?attrs spans in - Collector.send_trace [ rs ] ~ret:(fun () -> ()) - - type scope = Scope.t = { - trace_id: Trace_id.t; - span_id: Span_id.t; - mutable items: Scope.item_list; - } - [@@deprecated "use Scope.t"] - - let (add_event [@deprecated "use Scope.add_event"]) = Scope.add_event - - let (add_attrs [@deprecated "use Scope.add_attrs"]) = Scope.add_attrs - - let with_' ?(force_new_trace_id = false) ?trace_state ?service_name - ?(attrs : (string * [< value ]) list = []) ?kind ?trace_id ?parent ?scope - ?(links = []) name cb = - let scope = - if force_new_trace_id then - None - else - Scope.get_ambient_scope ?scope () - in - let trace_id = - match trace_id, scope with - | _ when force_new_trace_id -> Trace_id.create () - | Some trace_id, _ -> trace_id - | None, Some scope -> scope.trace_id - | None, None -> Trace_id.create () - in - let parent = - match parent, scope with - | _ when force_new_trace_id -> None - | Some span_id, _ -> Some span_id - | None, Some scope -> Some scope.span_id - | None, None -> None - in - let start_time = Timestamp_ns.now_unix_ns () in - let span_id = Span_id.create () in - let scope = Scope.make ~trace_id ~span_id ~attrs ~links () in - (* called once we're done, to emit a span *) - let finally res = - let status = - match Scope.status scope with - | Some status -> Some status - | None -> - (match res with - | Ok () -> - (* By default, all spans are Unset, which means a span completed without error. - The Ok status is reserved for when you need to explicitly mark a span as successful - rather than stick with the default of Unset (i.e., “without error”). - - https://opentelemetry.io/docs/languages/go/instrumentation/#set-span-status *) - None - | Error (e, bt) -> - Scope.record_exception scope e bt; - Some - (default_status ~code:Status_code_error - ~message:(Printexc.to_string e) ())) - in - let span, _ = - (* TODO: should the attrs passed to with_ go on the Span - (in Span.create) or on the ResourceSpan (in emit)? - (question also applies to Opentelemetry_lwt.Trace.with) *) - Span.create ?kind ~trace_id ?parent ~links:(Scope.links scope) - ~id:span_id ?trace_state ~attrs:(Scope.attrs scope) - ~events:(Scope.events scope) ~start_time - ~end_time:(Timestamp_ns.now_unix_ns ()) - ?status name - in - emit ?service_name [ span ] - in - let thunk () = - (* set global scope in this thread *) - Scope.with_ambient_scope scope @@ fun () -> cb scope - in - thunk, finally - - (** Sync span guard. - - Notably, this includes {e implicit} scope-tracking: if called without a - [~scope] argument (or [~parent]/[~trace_id]), it will check in the - {!Ambient_context} for a surrounding environment, and use that as the - scope. Similarly, it uses {!Scope.with_ambient_scope} to {e set} a new - scope in the ambient context, so that any logically-nested calls to - {!with_} will use this span as their parent. - - {b NOTE} be careful not to call this inside a Gc alarm, as it can cause - deadlocks. - - @param force_new_trace_id - if true (default false), the span will not use a ambient scope, the - [~scope] argument, nor [~trace_id], but will instead always create fresh - identifiers for this span *) - - let with_ ?force_new_trace_id ?trace_state ?service_name ?attrs ?kind - ?trace_id ?parent ?scope ?links name (cb : Scope.t -> 'a) : 'a = - let thunk, finally = - with_' ?force_new_trace_id ?trace_state ?service_name ?attrs ?kind - ?trace_id ?parent ?scope ?links name cb - in - - try - let rv = thunk () in - finally (Ok ()); - rv - with e -> - let bt = Printexc.get_raw_backtrace () in - finally (Error (e, bt)); - raise e -end - -(** {2 Metrics} *) - -(** Metrics. - - See - {{:https://opentelemetry.io/docs/reference/specification/overview/#metric-signal} - the spec} *) -module Metrics = struct - open Proto - open Proto.Metrics - - type t = Metrics.metric - (** A single metric, measuring some time-varying quantity or statistical - distribution. It is composed of one or more data points that have precise - values and time stamps. Each distinct metric should have a distinct name. - *) - - open struct - let _program_start = Timestamp_ns.now_unix_ns () - end - - (** Number data point, as a float *) - let float ?(start_time_unix_nano = _program_start) - ?(now = Timestamp_ns.now_unix_ns ()) ?(attrs = []) (d : float) : - number_data_point = - let attributes = attrs |> List.map _conv_key_value in - default_number_data_point ~start_time_unix_nano ~time_unix_nano:now - ~attributes ~value:(As_double d) () - - (** Number data point, as an int *) - let int ?(start_time_unix_nano = _program_start) - ?(now = Timestamp_ns.now_unix_ns ()) ?(attrs = []) (i : int) : - number_data_point = - let attributes = attrs |> List.map _conv_key_value in - default_number_data_point ~start_time_unix_nano ~time_unix_nano:now - ~attributes - ~value:(As_int (Int64.of_int i)) - () - - (** Aggregation of a scalar metric, always with the current value *) - let gauge ~name ?description ?unit_ (l : number_data_point list) : t = - let data = Gauge (default_gauge ~data_points:l ()) in - default_metric ~name ?description ?unit_ ~data () - - type aggregation_temporality = Metrics.aggregation_temporality = - | Aggregation_temporality_unspecified - | Aggregation_temporality_delta - | Aggregation_temporality_cumulative - - (** Sum of all reported measurements over a time interval *) - let sum ~name ?description ?unit_ - ?(aggregation_temporality = Aggregation_temporality_cumulative) - ?is_monotonic (l : number_data_point list) : t = - let data = - Sum (default_sum ~data_points:l ?is_monotonic ~aggregation_temporality ()) - in - default_metric ~name ?description ?unit_ ~data () - - (** Histogram data - @param count number of values in population (non negative) - @param sum sum of values in population (0 if count is 0) - @param bucket_counts - count value of histogram for each bucket. Sum of the counts must be - equal to [count]. length must be [1+length explicit_bounds] - @param explicit_bounds strictly increasing list of bounds for the buckets - *) - let histogram_data_point ?(start_time_unix_nano = _program_start) - ?(now = Timestamp_ns.now_unix_ns ()) ?(attrs = []) ?(exemplars = []) - ?(explicit_bounds = []) ?sum ~bucket_counts ~count () : - histogram_data_point = - let attributes = attrs |> List.map _conv_key_value in - default_histogram_data_point ~start_time_unix_nano ~time_unix_nano:now - ~attributes ~exemplars ~bucket_counts ~explicit_bounds ~count ?sum () - - let histogram ~name ?description ?unit_ ?aggregation_temporality - (l : histogram_data_point list) : t = - let data = - Histogram (default_histogram ~data_points:l ?aggregation_temporality ()) - in - default_metric ~name ?description ?unit_ ~data () - - (* TODO: exponential history *) - (* TODO: summary *) - (* TODO: exemplar *) - - (** Aggregate metrics into a {!Proto.Metrics.resource_metrics} *) - let make_resource_metrics ?service_name ?attrs (l : t list) : resource_metrics - = - let lm = - default_scope_metrics ~scope:(Some Globals.instrumentation_library) - ~metrics:l () - in - let attributes = Globals.mk_attributes ?service_name ?attrs () in - let resource = Proto.Resource.default_resource ~attributes () in - default_resource_metrics ~scope_metrics:[ lm ] ~resource:(Some resource) () - - (** Emit some metrics to the collector (sync). This blocks until the backend - has pushed the metrics into some internal queue, or discarded them. - - {b NOTE} be careful not to call this inside a Gc alarm, as it can cause - deadlocks. *) - let emit ?attrs (l : t list) : unit = - let rm = make_resource_metrics ?attrs l in - Collector.send_metrics [ rm ] ~ret:ignore -end - -(** A set of callbacks that produce metrics when called. The metrics are - automatically called regularly. - - This allows applications to register metrics callbacks from various points - in the program (or even in libraries), and not worry about setting - alarms/intervals to emit them. *) -module Metrics_callbacks = struct - open struct - (* [true] iff the initial list of metric callbacks has already been registered - with `on_tick`. This registration must only happen once, after which, - [registered_with_on_tick] will forever be [false]. *) - let registered_with_on_tick : bool Atomic.t = Atomic.make false - - let cbs_ : (unit -> Metrics.t list) AList.t = AList.make () - end - - (** [register f] adds the callback [f] to the list. - - [f] will be called at unspecified times and is expected to return a list - of metrics. It might be called regularly by the backend, in particular - (but not only) when {!Collector.tick} is called. *) - let register f : unit = - (* sets [registered_with_on_tick] to [true] atomically, iff it is currently - [false]. *) - if not (Atomic.exchange registered_with_on_tick true) then - (* make sure we call [f] (and others) at each tick *) - Collector.on_tick (fun () -> - let m = List.map (fun f -> f ()) (AList.get cbs_) |> List.flatten in - Metrics.emit m); - AList.add cbs_ f -end - -(** {2 Logs} *) - -(** Logs. - - See - {{:https://opentelemetry.io/docs/reference/specification/overview/#log-signal} - the spec} *) -module Logs = struct - open Opentelemetry_proto - open Logs - - type t = log_record - - (** Severity level of a log event *) - type severity = Logs.severity_number = - | Severity_number_unspecified - | Severity_number_trace - | Severity_number_trace2 - | Severity_number_trace3 - | Severity_number_trace4 - | Severity_number_debug - | Severity_number_debug2 - | Severity_number_debug3 - | Severity_number_debug4 - | Severity_number_info - | Severity_number_info2 - | Severity_number_info3 - | Severity_number_info4 - | Severity_number_warn - | Severity_number_warn2 - | Severity_number_warn3 - | Severity_number_warn4 - | Severity_number_error - | Severity_number_error2 - | Severity_number_error3 - | Severity_number_error4 - | Severity_number_fatal - | Severity_number_fatal2 - | Severity_number_fatal3 - | Severity_number_fatal4 - - let pp_severity = Logs.pp_severity_number - - type flags = Logs.log_record_flags = - | Log_record_flags_do_not_use - | Log_record_flags_trace_flags_mask - - let pp_flags = Logs.pp_log_record_flags - - (** Make a single log entry *) - let make ?time ?(observed_time_unix_nano = Timestamp_ns.now_unix_ns ()) - ?severity ?log_level ?flags ?trace_id ?span_id (body : value) : t = - let time_unix_nano = - match time with - | None -> observed_time_unix_nano - | Some t -> t - in - let trace_id = Option.map Trace_id.to_bytes trace_id in - let span_id = Option.map Span_id.to_bytes span_id in - let body = _conv_value body in - default_log_record ~time_unix_nano ~observed_time_unix_nano - ?severity_number:severity ?severity_text:log_level ?flags ?trace_id - ?span_id ~body () - - (** Make a log entry whose body is a string *) - let make_str ?time ?observed_time_unix_nano ?severity ?log_level ?flags - ?trace_id ?span_id (body : string) : t = - make ?time ?observed_time_unix_nano ?severity ?log_level ?flags ?trace_id - ?span_id (`String body) - - (** Make a log entry with format *) - let make_strf ?time ?observed_time_unix_nano ?severity ?log_level ?flags - ?trace_id ?span_id fmt = - Format.kasprintf - (fun bod -> - make_str ?time ?observed_time_unix_nano ?severity ?log_level ?flags - ?trace_id ?span_id bod) - fmt - - (** Emit logs. - - This instructs the collector to send the logs to some backend at a later - date. {b NOTE} be careful not to call this inside a Gc alarm, as it can - cause deadlocks. *) - let emit ?service_name ?attrs (l : t list) : unit = - let attributes = Globals.mk_attributes ?service_name ?attrs () in - let resource = Proto.Resource.default_resource ~attributes () in - let ll = - default_scope_logs ~scope:(Some Globals.instrumentation_library) - ~log_records:l () - in - let rl = - default_resource_logs ~resource:(Some resource) ~scope_logs:[ ll ] () - in - Collector.send_logs [ rl ] ~ret:ignore -end - -(** {2 Utils} *) - -(** Implementation of the W3C Trace Context spec - - https://www.w3.org/TR/trace-context/ *) -module Trace_context = struct - (** The traceparent header - https://www.w3.org/TR/trace-context/#traceparent-header *) - module Traceparent = struct - let name = "traceparent" - - (** Parse the value of the traceparent header. - - The values are of the form: - - {[ - { version } - { trace_id } - { parent_id } - { flags } - ]} - - For example: - - {[ - 00-4bf92f3577b34da6a3ce929d0e0e4736-00f067aa0ba902b7-01 - ]} - - [{flags}] are currently ignored. *) - let of_value str : (Trace_id.t * Span_id.t, string) result = - match Span_ctx.of_w3c_trace_context (Bytes.unsafe_of_string str) with - | Ok sp -> Ok (Span_ctx.trace_id sp, Span_ctx.parent_id sp) - | Error _ as e -> e - - let to_value ?(sampled : bool option) ~(trace_id : Trace_id.t) - ~(parent_id : Span_id.t) () : string = - let span_ctx = Span_ctx.make ?sampled ~trace_id ~parent_id () in - Bytes.unsafe_to_string @@ Span_ctx.to_w3c_trace_context span_ctx - end -end - -(** Export GC metrics. - - These metrics are emitted after each GC collection. *) -module GC_metrics : sig - val basic_setup : unit -> unit - (** Setup a hook that will emit GC statistics on every tick (assuming a ticker - thread) *) - - val get_runtime_attributes : unit -> Span.key_value list - (** Get OCaml name and version runtime attributes *) - - val get_metrics : unit -> Metrics.t list - (** Get a few metrics from the current state of the GC *) -end = struct - (** See - https://github.com/open-telemetry/opentelemetry-specification/blob/main/specification/resource/semantic_conventions/process.md#process-runtimes - *) - let runtime_attributes = - lazy - Conventions.Attributes. - [ - Process.Runtime.name, `String "ocaml"; - Process.Runtime.version, `String Sys.ocaml_version; - ] - - let get_runtime_attributes () = Lazy.force runtime_attributes - - let basic_setup () = - let on_tick () = - match Collector.get_backend () with - | None -> () - | Some (module C) -> C.signal_emit_gc_metrics () - in - Collector.on_tick on_tick - - let bytes_per_word = Sys.word_size / 8 - - let word_to_bytes n = n * bytes_per_word - - let word_to_bytes_f n = n *. float bytes_per_word - - let get_metrics () : Metrics.t list = - let gc = Gc.quick_stat () in - let now = Timestamp_ns.now_unix_ns () in - let open Metrics in - let open Conventions.Metrics in - [ - gauge ~name:Process.Runtime.Ocaml.GC.major_heap ~unit_:"B" - [ int ~now (word_to_bytes gc.Gc.heap_words) ]; - sum ~name:Process.Runtime.Ocaml.GC.minor_allocated - ~aggregation_temporality:Metrics.Aggregation_temporality_cumulative - ~is_monotonic:true ~unit_:"B" - [ float ~now (word_to_bytes_f gc.Gc.minor_words) ]; - sum ~name:Process.Runtime.Ocaml.GC.minor_collections - ~aggregation_temporality:Metrics.Aggregation_temporality_cumulative - ~is_monotonic:true - [ int ~now gc.Gc.minor_collections ]; - sum ~name:Process.Runtime.Ocaml.GC.major_collections - ~aggregation_temporality:Metrics.Aggregation_temporality_cumulative - ~is_monotonic:true - [ int ~now gc.Gc.major_collections ]; - sum ~name:Process.Runtime.Ocaml.GC.compactions - ~aggregation_temporality:Metrics.Aggregation_temporality_cumulative - ~is_monotonic:true - [ int ~now gc.Gc.compactions ]; - ] -end diff --git a/src/core/rand_bytes.ml b/src/core/rand_bytes.ml index 18cf7dc88..6a3a7493d 100644 --- a/src/core/rand_bytes.ml +++ b/src/core/rand_bytes.ml @@ -1,38 +1,71 @@ -(* generate random IDs *) -let rand_ = Random.State.make_self_init () +open struct + type cell = { + mu: Mutex.t; + mutable rand: Random.State.t option; + } -let ( let@ ) = ( @@ ) + let cells = Array.init 8 (fun _ -> { mu = Mutex.create (); rand = None }) + + let ( let@ ) = ( @@ ) + + let with_shard_rand i (f : Random.State.t -> 'a) : 'a = + let cell = Array.get cells (i land 0b111) in + let@ () = Util_mutex.protect cell.mu in + let rand = + match cell.rand with + | Some r -> r + | None -> + let r = Random.State.make_self_init () in + cell.rand <- Some r; + r + in + f rand +end + +(** What rand state do we use? *) +let[@inline] shard () : int = Thread.id (Thread.self ()) let default_rand_bytes_8 () : bytes = - let@ () = Lock.with_lock in + let shard = shard () in + let@ rand = with_shard_rand shard in + let b = Bytes.create 8 in for i = 0 to 1 do - let r = Random.State.bits rand_ in + (* rely on the stdlib's [Random] being thread-or-domain safe *) + let r = Random.State.bits rand in (* 30 bits, of which we use 24 *) Bytes.set b (i * 3) (Char.chr (r land 0xff)); Bytes.set b ((i * 3) + 1) (Char.chr ((r lsr 8) land 0xff)); Bytes.set b ((i * 3) + 2) (Char.chr ((r lsr 16) land 0xff)) done; - let r = Random.State.bits rand_ in + let r = Random.State.bits rand in Bytes.set b 6 (Char.chr (r land 0xff)); Bytes.set b 7 (Char.chr ((r lsr 8) land 0xff)); b let default_rand_bytes_16 () : bytes = - let@ () = Lock.with_lock in + let shard = shard () in + let@ rand = with_shard_rand shard in + let b = Bytes.create 16 in for i = 0 to 4 do - let r = Random.State.bits rand_ in + let r = Random.State.bits rand in (* 30 bits, of which we use 24 *) Bytes.set b (i * 3) (Char.chr (r land 0xff)); Bytes.set b ((i * 3) + 1) (Char.chr ((r lsr 8) land 0xff)); Bytes.set b ((i * 3) + 2) (Char.chr ((r lsr 16) land 0xff)) done; - let r = Random.State.bits rand_ in + let r = Random.State.bits rand in Bytes.set b 15 (Char.chr (r land 0xff)); (* last byte *) b -let rand_bytes_16 = ref default_rand_bytes_16 +let rand_bytes_16_ref = ref default_rand_bytes_16 + +let rand_bytes_8_ref = ref default_rand_bytes_8 + +(** Generate a 16B identifier *) +let[@inline] rand_bytes_16 () = !rand_bytes_16_ref () -let rand_bytes_8 = ref default_rand_bytes_8 +(** Generate an 8B identifier *) +let[@inline] rand_bytes_8 () = !rand_bytes_8_ref () diff --git a/src/core/rand_bytes.mli b/src/core/rand_bytes.mli index 7c42ea35b..4b015b274 100644 --- a/src/core/rand_bytes.mli +++ b/src/core/rand_bytes.mli @@ -2,12 +2,12 @@ We need random identifiers for trace IDs and span IDs. *) -val rand_bytes_16 : (unit -> bytes) ref +val rand_bytes_16_ref : (unit -> bytes) ref (** Generate 16 bytes of random data. The implementation can be swapped to use any random generator. *) -val rand_bytes_8 : (unit -> bytes) ref -(** Generate 16 bytes of random data. The implementation can be swapped to use +val rand_bytes_8_ref : (unit -> bytes) ref +(** Generate 8 bytes of random data. The implementation can be swapped to use any random generator. *) val default_rand_bytes_8 : unit -> bytes @@ -15,3 +15,9 @@ val default_rand_bytes_8 : unit -> bytes val default_rand_bytes_16 : unit -> bytes (** Default implementation using {!Random} *) + +val rand_bytes_16 : unit -> bytes +(** Call the current {!rand_bytes_16_ref} *) + +val rand_bytes_8 : unit -> bytes +(** Call the current {!rand_bytes_8_ref} *) diff --git a/src/core/span.ml b/src/core/span.ml new file mode 100644 index 000000000..21b8de847 --- /dev/null +++ b/src/core/span.ml @@ -0,0 +1,153 @@ +open Common_ +open Proto.Trace + +type t = span + +type id = Span_id.t + +type kind = Span_kind.t = + | Span_kind_unspecified + | Span_kind_internal + | Span_kind_server + | Span_kind_client + | Span_kind_producer + | Span_kind_consumer + +type key_value = + string + * [ `Int of int + | `String of string + | `Bool of bool + | `Float of float + | `None + ] + +let[@inline] id self = Span_id.of_bytes self.span_id + +let[@inline] trace_id self = Trace_id.of_bytes self.trace_id + +let[@inline] is_not_dummy self = Span_id.is_valid (id self) + +let pp = Proto.Trace.pp_span + +let default_kind = ref Proto.Trace.Span_kind_unspecified + +let make ?(kind = !default_kind) ?trace_state ?(attrs = []) ?(events = []) + ?status ~trace_id ~id ?parent ?(links = []) ~start_time ~end_time name : t = + let trace_id = Trace_id.to_bytes trace_id in + let parent_span_id = Option.map Span_id.to_bytes parent in + let attributes = List.map Key_value.conv attrs in + let span = + make_span ~trace_id ?parent_span_id ~span_id:(Span_id.to_bytes id) + ~attributes ~events ?trace_state ?status ~kind ~name ~links + ~start_time_unix_nano:start_time ~end_time_unix_nano:end_time () + in + span + +let dummy : t = + Proto.Trace.make_span + ~trace_id:Trace_id.(dummy |> to_bytes) + ~span_id:Span_id.(dummy |> to_bytes) + () + +let create_new ?kind ?(id = Span_id.create ()) ?trace_state ?attrs ?events + ?status ~trace_id ?parent ?links ~start_time ~end_time name : t = + make ?kind ~id ~trace_id ?trace_state ?attrs ?events ?status ?parent ?links + ~start_time ~end_time name + +let attrs self = self.attributes |> List.rev_map Key_value.of_otel + +let events self = self.events + +let links self : Span_link.t list = self.links + +let status self = self.status + +let kind self = + let k = self.kind in + if k = Span_kind_unspecified then + None + else + Some k + +let to_span_link (self : t) : Span_link.t = + make_span_link ~attributes:self.attributes + ?flags: + (if span_has_flags self then + Some self.flags + else + None) + ?dropped_attributes_count: + (if span_has_dropped_attributes_count self then + Some self.dropped_attributes_count + else + None) + ?trace_state: + (if span_has_trace_state self then + Some self.trace_state + else + None) + ~trace_id:self.trace_id ~span_id:self.span_id () + +let[@inline] to_span_ctx (self : t) : Span_ctx.t = + Span_ctx.make ~trace_id:(trace_id self) ~parent_id:(id self) () + +(* Note: a span must not be concurrently modified from multiple + threads or domains. *) +let[@inline] add_event self ev : unit = + if is_not_dummy self then span_set_events self (ev :: self.events) + +let add_event' self ev : unit = + if is_not_dummy self then span_set_events self (ev () :: self.events) + +let record_exception (self : t) (exn : exn) (bt : Printexc.raw_backtrace) : unit + = + if is_not_dummy self then ( + let exn_msg = Printexc.to_string exn in + let ev = + Event.make "exception" + ~attrs: + [ + "exception.message", `String exn_msg; + "exception.type", `String (Printexc.exn_slot_name exn); + ( "exception.stacktrace", + `String (Printexc.raw_backtrace_to_string bt) ); + ] + in + add_event self ev; + + let status = make_status ~code:Status_code_error ~message:exn_msg () in + span_set_status self status + ) + +let add_attrs (self : t) (attrs : Key_value.t list) : unit = + if is_not_dummy self then ( + let attrs = List.rev_map Key_value.conv attrs in + let attrs = List.rev_append attrs self.attributes in + span_set_attributes self attrs + ) + +let add_attrs' (self : t) (attrs : unit -> Key_value.t list) : unit = + if is_not_dummy self then ( + let attrs = List.rev_map Key_value.conv (attrs ()) in + let attrs = List.rev_append attrs self.attributes in + span_set_attributes self attrs + ) + +let add_links (self : t) (links : Span_link.t list) : unit = + if is_not_dummy self && links <> [] then ( + let links = List.rev_append links self.links in + span_set_links self links + ) + +let add_links' (self : t) (links : unit -> Span_link.t list) : unit = + if is_not_dummy self then ( + let links = List.rev_append (links ()) self.links in + span_set_links self links + ) + +let set_status self st = if is_not_dummy self then span_set_status self st + +let set_kind self k = if is_not_dummy self then span_set_kind self k + +let k_ambient : t Context.key = Context.new_key () diff --git a/src/core/span.mli b/src/core/span.mli new file mode 100644 index 000000000..15f34e775 --- /dev/null +++ b/src/core/span.mli @@ -0,0 +1,131 @@ +(** Spans. + + A Span is the workhorse of traces, it indicates an operation that took place + over a given span of time (indicated by start_time and end_time) as part of + a hierarchical trace. All spans in a given trace are bound by the use of the + same {!Trace_id.t}. *) + +open Common_ +open Proto.Trace + +type t = span + +type id = Span_id.t + +type kind = Span_kind.t = + | Span_kind_unspecified + | Span_kind_internal + | Span_kind_server + | Span_kind_client + | Span_kind_producer + | Span_kind_consumer + +type key_value = Key_value.t + +val pp : Format.formatter -> t -> unit + +val make : + ?kind:kind -> + ?trace_state:string -> + ?attrs:key_value list -> + ?events:Event.t list -> + ?status:status -> + trace_id:Trace_id.t -> + id:Span_id.t -> + ?parent:id -> + ?links:Span_link.t list -> + start_time:Timestamp_ns.t -> + end_time:Timestamp_ns.t -> + string -> + t +(** [make ~trace_id ~id name] creates a new span + @param trace_id the trace this belongs to + @param parent parent span, if any + @param links + list of links to other spans, each with their trace state (see + {{:https://www.w3.org/TR/trace-context/#tracestate-header} w3.org}) *) + +val id : t -> Span_id.t + +val trace_id : t -> Trace_id.t + +val is_not_dummy : t -> bool + +val dummy : t +(** Dummy span, will not record anything *) + +val create_new : + ?kind:kind -> + ?id:Span_id.t -> + ?trace_state:string -> + ?attrs:key_value list -> + ?events:Event.t list -> + ?status:status -> + trace_id:Trace_id.t -> + ?parent:id -> + ?links:Span_link.t list -> + start_time:Timestamp_ns.t -> + end_time:Timestamp_ns.t -> + string -> + t + +val attrs : t -> Key_value.t list + +val events : t -> Event.t list + +val links : t -> Span_link.t list + +val status : t -> Span_status.t option + +val kind : t -> Span_kind.t option + +val to_span_link : t -> Span_link.t +(** Turn the scope into a span link *) + +val to_span_ctx : t -> Span_ctx.t +(** Turn the scope into a span context *) + +val add_event : t -> Event.t -> unit + +val add_event' : t -> (unit -> Event.t) -> unit +(** Add an event to the scope. It will be aggregated into the span. + + Note that this takes a function that produces an event, and will only call + it if there is an instrumentation backend. *) + +val record_exception : t -> exn -> Printexc.raw_backtrace -> unit +(** Record an exception occurring inside the span. This creates a span event + {b and} also sets the span status to error. *) + +val add_links : t -> Span_link.t list -> unit + +val add_links' : t -> (unit -> Span_link.t list) -> unit +(** Add links to the scope. It will be aggregated into the span. + + Note that this takes a function that produces links, and will only call it + if there is an instrumentation backend. *) + +val add_attrs : t -> Key_value.t list -> unit + +val add_attrs' : t -> (unit -> Key_value.t list) -> unit + +val set_status : t -> Span_status.t -> unit +(** set the span status. + + Note that this function will be called only if there is an instrumentation + backend. *) + +val set_kind : t -> Span_kind.t -> unit +(** Set the span's kind. + @since 0.11 *) + +val default_kind : Span_kind.t ref +(** Default span kind in {!make} and {!create_new}. + + This will be used in all spans that do not specify [~kind] explicitly; it is + set to "internal", following directions from the [.proto] file. It can be + convenient to set "client" or "server" uniformly in here. *) + +val k_ambient : t Context.key +(** Context key to carry around a {!Span.t} in ambient context. + @since 0.90 *) diff --git a/src/core/span_ctx.ml b/src/core/span_ctx.ml new file mode 100644 index 000000000..3f2c73e1f --- /dev/null +++ b/src/core/span_ctx.ml @@ -0,0 +1,95 @@ +open Common_ + +(* see: https://opentelemetry.io/docs/specs/otel/trace/api/#spancontext *) + +(* TODO: trace state *) + +external int_of_bool : bool -> int = "%identity" + +module Flags = struct + let sampled = 1 + + let remote = 2 +end + +type t = { + trace_id: Trace_id.t; + parent_id: Span_id.t; + flags: int; +} + +let dummy = { trace_id = Trace_id.dummy; parent_id = Span_id.dummy; flags = 0 } + +let make ?(remote = false) ?(sampled = false) ~trace_id ~parent_id () : t = + let flags = + 0 + lor (int_of_bool remote lsl Flags.remote) + lor (int_of_bool sampled lsl Flags.sampled) + in + { trace_id; parent_id; flags } + +let[@inline] is_valid self = + Trace_id.is_valid self.trace_id && Span_id.is_valid self.parent_id + +let[@inline] sampled self = self.flags land (1 lsl Flags.sampled) != 0 + +let[@inline] is_remote self = self.flags land (1 lsl Flags.remote) != 0 + +let[@inline] trace_id self = self.trace_id + +let[@inline] parent_id self = self.parent_id + +let to_w3c_trace_context (self : t) : bytes = + let bs = Bytes.create 55 in + Bytes.set bs 0 '0'; + Bytes.set bs 1 '0'; + Bytes.set bs 2 '-'; + Trace_id.to_hex_into self.trace_id bs 3; + (* +32 *) + Bytes.set bs (3 + 32) '-'; + Span_id.to_hex_into self.parent_id bs 36; + (* +16 *) + Bytes.set bs 52 '-'; + Bytes.set bs 53 '0'; + Bytes.set bs 54 + (if sampled self then + '1' + else + '0'); + bs + +let of_w3c_trace_context bs : _ result = + try + if Bytes.length bs <> 55 then invalid_arg "trace context must be 55 bytes"; + (match int_of_string_opt (Bytes.sub_string bs 0 2) with + | Some 0 -> () + | Some n -> invalid_arg @@ spf "version is %d, expected 0" n + | None -> invalid_arg "expected 2-digit version"); + if Bytes.get bs 2 <> '-' then invalid_arg "expected '-' before trace_id"; + let trace_id = + try Trace_id.of_hex_substring (Bytes.unsafe_to_string bs) 3 + with Invalid_argument msg -> invalid_arg (spf "in trace id: %s" msg) + in + if Bytes.get bs (3 + 32) <> '-' then + invalid_arg "expected '-' before parent_id"; + let parent_id = + try Span_id.of_hex_substring (Bytes.unsafe_to_string bs) 36 + with Invalid_argument msg -> invalid_arg (spf "in span id: %s" msg) + in + if Bytes.get bs 52 <> '-' then invalid_arg "expected '-' after parent_id"; + let sampled = + match int_of_string_opt ("0x" ^ Bytes.sub_string bs 53 2) with + | Some flags -> flags land 1 = 1 + | None -> false + in + + (* ignore other flags *) + Ok (make ~remote:true ~sampled ~trace_id ~parent_id ()) + with Invalid_argument msg -> Error msg + +let of_w3c_trace_context_exn bs = + match of_w3c_trace_context bs with + | Ok t -> t + | Error msg -> invalid_arg @@ spf "invalid w3c trace context: %s" msg + +let k_ambient : t Hmap.key = Hmap.Key.create () diff --git a/src/core/span_ctx.mli b/src/core/span_ctx.mli new file mode 100644 index 000000000..2970daab7 --- /dev/null +++ b/src/core/span_ctx.mli @@ -0,0 +1,42 @@ +(** Span context. This bundles up a trace ID and parent ID. + + {{:https://opentelemetry.io/docs/specs/otel/trace/api/#spancontext} + https://opentelemetry.io/docs/specs/otel/trace/api/#spancontext} + @since 0.7 *) + +type t + +val make : + ?remote:bool -> + ?sampled:bool -> + trace_id:Trace_id.t -> + parent_id:Span_id.t -> + unit -> + t + +val dummy : t +(** Invalid span context, to be used as a placeholder *) + +val is_remote : t -> bool +(** Does this come from a remote parent? *) + +val is_valid : t -> bool +(** Are the span ID and trace ID valid (ie non-zero)? *) + +val trace_id : t -> Trace_id.t + +val parent_id : t -> Span_id.t + +val sampled : t -> bool + +val to_w3c_trace_context : t -> bytes + +val of_w3c_trace_context : bytes -> (t, string) result + +val of_w3c_trace_context_exn : bytes -> t +(** @raise Invalid_argument if parsing failed *) + +val k_ambient : t Hmap.key +(** Hmap key to carry around a {!Span_ctx.t}, e.g. to remember what the current + parent span is. + @since 0.8 *) diff --git a/src/core/span_id.ml b/src/core/span_id.ml new file mode 100644 index 000000000..6285fe94e --- /dev/null +++ b/src/core/span_id.ml @@ -0,0 +1,40 @@ +type t = bytes + +let[@inline] to_bytes self = self + +let dummy : t = Bytes.make 8 '\x00' + +let create () : t = + let b = Rand_bytes.rand_bytes_8 () in + assert (Bytes.length b = 8); + (* make sure the identifier is not all 0, which is a dummy identifier. *) + Bytes.set b 0 (Char.unsafe_chr (Char.code (Bytes.get b 0) lor 1)); + b + +(* dark magic, woo. We have an [assert] below to do the bound checks once *) +external unsafe_b_get64 : bytes -> int -> int64 = "%caml_bytes_get64u" + +let[@inline] is_zero (self : t) : bool = + (* try to reduce branches *) + assert (Bytes.length self = 8); + let n1 = unsafe_b_get64 self 0 in + n1 = 0L + +let[@inline] is_valid self = not (is_zero self) + +let[@inline] of_bytes b = + if Bytes.length b = 8 then + b + else + invalid_arg "span IDs must be 8 bytes in length" + +let to_hex = Util_bytes_.bytes_to_hex + +let to_hex_into = Util_bytes_.bytes_to_hex_into + +let[@inline] of_hex s = of_bytes (Util_bytes_.bytes_of_hex s) + +let[@inline] of_hex_substring s off = + of_bytes (Util_bytes_.bytes_of_hex_substring s off 16) + +let pp fmt t = Format.fprintf fmt "%s" (to_hex t) diff --git a/src/core/span_id.mli b/src/core/span_id.mli new file mode 100644 index 000000000..db51d475e --- /dev/null +++ b/src/core/span_id.mli @@ -0,0 +1,23 @@ +(** Unique ID of a span. *) + +type t + +val create : unit -> t + +val dummy : t + +val pp : Format.formatter -> t -> unit + +val is_valid : t -> bool + +val to_bytes : t -> bytes + +val of_bytes : bytes -> t + +val to_hex : t -> string + +val to_hex_into : t -> bytes -> int -> unit + +val of_hex : string -> t + +val of_hex_substring : string -> int -> t diff --git a/src/core/span_kind.ml b/src/core/span_kind.ml new file mode 100644 index 000000000..d3ddace4d --- /dev/null +++ b/src/core/span_kind.ml @@ -0,0 +1,13 @@ +(** Span kind. + @since 0.11 *) + +open Common_ +open Proto.Trace + +type t = span_span_kind = + | Span_kind_unspecified + | Span_kind_internal + | Span_kind_server + | Span_kind_client + | Span_kind_producer + | Span_kind_consumer diff --git a/src/core/span_link.ml b/src/core/span_link.ml new file mode 100644 index 000000000..308d3598f --- /dev/null +++ b/src/core/span_link.ml @@ -0,0 +1,20 @@ +open Common_ +open Proto.Trace + +type t = span_link + +let make ~trace_id ~span_id ?trace_state ?(attrs = []) ?dropped_attributes_count + () : t = + let attributes = List.map Key_value.conv attrs in + let dropped_attributes_count = + Option.map Int32.of_int dropped_attributes_count + in + make_span_link + ~trace_id:(Trace_id.to_bytes trace_id) + ~span_id:(Span_id.to_bytes span_id) ?trace_state ~attributes + ?dropped_attributes_count () + +let[@inline] of_span_ctx ?trace_state ?attrs ?dropped_attributes_count + (ctx : Span_ctx.t) : t = + make ~trace_id:(Span_ctx.trace_id ctx) ~span_id:(Span_ctx.parent_id ctx) + ?trace_state ?attrs ?dropped_attributes_count () diff --git a/src/core/span_link.mli b/src/core/span_link.mli new file mode 100644 index 000000000..402ff0ec0 --- /dev/null +++ b/src/core/span_link.mli @@ -0,0 +1,27 @@ +(** Span Link + + A pointer from the current span to another span in the same trace or in a + different trace. For example, this can be used in batching operations, where + a single batch handler processes multiple requests from different traces or + when the handler receives a request from a different project. *) + +open Common_ +open Proto.Trace + +type t = span_link + +val make : + trace_id:Trace_id.t -> + span_id:Span_id.t -> + ?trace_state:string -> + ?attrs:Key_value.t list -> + ?dropped_attributes_count:int -> + unit -> + t + +val of_span_ctx : + ?trace_state:string -> + ?attrs:Key_value.t list -> + ?dropped_attributes_count:int -> + Span_ctx.t -> + t diff --git a/src/core/span_status.ml b/src/core/span_status.ml new file mode 100644 index 000000000..388d20aca --- /dev/null +++ b/src/core/span_status.ml @@ -0,0 +1,15 @@ +open Common_ +open Proto.Trace + +type t = Proto.Trace.status = private { + mutable _presence: Pbrt.Bitfield.t; + mutable message: string; + mutable code: status_status_code; +} + +type code = status_status_code = + | Status_code_unset + | Status_code_ok + | Status_code_error + +let[@inline] make ~message ~code : t = make_status ~message ~code () diff --git a/src/core/span_status.mli b/src/core/span_status.mli new file mode 100644 index 000000000..da2e11b92 --- /dev/null +++ b/src/core/span_status.mli @@ -0,0 +1,15 @@ +open Common_ +open Proto.Trace + +type t = Proto.Trace.status = private { + mutable _presence: Pbrt.Bitfield.t; + mutable message: string; + mutable code: status_status_code; +} + +type code = status_status_code = + | Status_code_unset + | Status_code_ok + | Status_code_error + +val make : message:string -> code:code -> t diff --git a/src/core/timestamp_ns.ml b/src/core/timestamp_ns.ml new file mode 100644 index 000000000..75ca56691 --- /dev/null +++ b/src/core/timestamp_ns.ml @@ -0,0 +1 @@ +include Opentelemetry_util.Timestamp_ns diff --git a/src/core/trace_context.ml b/src/core/trace_context.ml new file mode 100644 index 000000000..9c8b141d5 --- /dev/null +++ b/src/core/trace_context.ml @@ -0,0 +1,34 @@ +(** Implementation of the W3C Trace Context spec + + https://www.w3.org/TR/trace-context/ *) + +(** The traceparent header + https://www.w3.org/TR/trace-context/#traceparent-header *) +module Traceparent = struct + let name = "traceparent" + + (** Parse the value of the traceparent header. + + The values are of the form: + + {[ + { version } - { trace_id } - { parent_id } - { flags } + ]} + + For example: + + {[ + 00-4bf92f3577b34da6a3ce929d0e0e4736-00f067aa0ba902b7-01 + ]} + + [{flags}] are currently ignored. *) + let of_value str : (Trace_id.t * Span_id.t, string) result = + match Span_ctx.of_w3c_trace_context (Bytes.unsafe_of_string str) with + | Ok sp -> Ok (Span_ctx.trace_id sp, Span_ctx.parent_id sp) + | Error _ as e -> e + + let to_value ?(sampled : bool option) ~(trace_id : Trace_id.t) + ~(parent_id : Span_id.t) () : string = + let span_ctx = Span_ctx.make ?sampled ~trace_id ~parent_id () in + Bytes.unsafe_to_string @@ Span_ctx.to_w3c_trace_context span_ctx +end diff --git a/src/core/trace_id.ml b/src/core/trace_id.ml new file mode 100644 index 000000000..e82539c52 --- /dev/null +++ b/src/core/trace_id.ml @@ -0,0 +1,51 @@ +type t = bytes + +let[@inline] to_bytes self = self + +let dummy : t = Bytes.make 16 '\x00' + +let create () : t = + let b = Rand_bytes.rand_bytes_16 () in + assert (Bytes.length b = 16); + (* make sure the identifier is not all 0, which is a dummy identifier. *) + Bytes.set b 0 (Char.unsafe_chr (Char.code (Bytes.get b 0) lor 1)); + b + +let[@inline] of_bytes b = + if Bytes.length b = 16 then + b + else + invalid_arg "trace ID must be 16 bytes in length" + +(* dark magic, woo. We have an [assert] below to do the bound checks once *) +external unsafe_b_get64 : bytes -> int -> int64 = "%caml_bytes_get64u" + +let[@inline] is_zero (self : t) : bool = + (* try to reduce branches *) + assert (Bytes.length self = 16); + let n1 = unsafe_b_get64 self 0 in + let n2 = unsafe_b_get64 self 8 in + n1 = 0L && n2 = 0L + +let[@inline] is_valid self = not (is_zero self) + +let to_hex = Util_bytes_.bytes_to_hex + +let to_hex_into = Util_bytes_.bytes_to_hex_into + +let[@inline] of_hex s = of_bytes (Util_bytes_.bytes_of_hex s) + +let[@inline] of_hex_substring s off = + of_bytes (Util_bytes_.bytes_of_hex_substring s off 32) + +let pp fmt t = Format.fprintf fmt "%s" (to_hex t) + +let compare = Bytes.compare + +module Map = Map.Make (struct + type nonrec t = t + + let compare = compare +end) + +let k_trace_id : t Hmap.key = Hmap.Key.create () diff --git a/src/core/trace_id.mli b/src/core/trace_id.mli new file mode 100644 index 000000000..d3c45f9ba --- /dev/null +++ b/src/core/trace_id.mli @@ -0,0 +1,34 @@ +(** Trace ID. + + This 16 bytes identifier is shared by all spans in one trace. *) + +type t + +val create : unit -> t + +val dummy : t + +val compare : t -> t -> int + +val pp : Format.formatter -> t -> unit + +val is_valid : t -> bool + +val to_bytes : t -> bytes + +val of_bytes : bytes -> t + +val to_hex : t -> string + +val to_hex_into : t -> bytes -> int -> unit + +val of_hex : string -> t + +val of_hex_substring : string -> int -> t + +module Map : Map.S with type key = t + +val k_trace_id : t Hmap.key +(** Hmap key to carry around a {!Trace_id.t}, to remember what the current trace + is. + @since 0.8 *) diff --git a/src/core/value.ml b/src/core/value.ml new file mode 100644 index 000000000..d3d07c0ee --- /dev/null +++ b/src/core/value.ml @@ -0,0 +1,27 @@ +open Common_ + +type t = + [ `Int of int + | `String of string + | `Bool of bool + | `Float of float + | `None + ] +(** A value in a key/value attribute *) + +let conv = + let open Proto.Common in + function + | `Int i -> Some (Int_value (Int64.of_int i)) + | `String s -> Some (String_value s) + | `Bool b -> Some (Bool_value b) + | `Float f -> Some (Double_value f) + | `None -> None + +let of_otel_opt (v : Proto.Common.any_value option) : t = + match v with + | Some (Int_value i) -> `Int (Int64.to_int i) + | Some (String_value s) -> `String s + | Some (Bool_value b) -> `Bool b + | Some (Double_value f) -> `Float f + | Some (Array_value _ | Kvlist_value _ | Bytes_value _) | None -> `None diff --git a/src/domain/dune b/src/domain/dune new file mode 100644 index 000000000..c75ee3c4f --- /dev/null +++ b/src/domain/dune @@ -0,0 +1,14 @@ +(library + (name opentelemetry_domain) + (synopsis "Compatibility package for the Domain module for opentelemetry") + (public_name opentelemetry.domain) + (modules opentelemetry_domain)) + +(executable + (modules gen) + (name gen)) + +(rule + (targets opentelemetry_domain.ml) + (action + (run ./gen.exe))) diff --git a/src/domain/gen.ml b/src/domain/gen.ml new file mode 100644 index 000000000..f1cf82e66 --- /dev/null +++ b/src/domain/gen.ml @@ -0,0 +1,26 @@ +let domain_4 = + {| +let cpu_relax = ignore +let relax_loop : int -> unit = ignore + |} + +let domain_5 = + {| +let cpu_relax = Domain.cpu_relax +let relax_loop i = + for _j = 1 to i do cpu_relax () done +|} + +let write_file file s = + let oc = open_out file in + output_string oc s; + close_out oc + +let () = + let version = Scanf.sscanf Sys.ocaml_version "%d.%d.%s" (fun x y _ -> x, y) in + write_file "opentelemetry_domain.ml" + (if version >= (5, 0) then + domain_5 + else + domain_4); + () diff --git a/src/domain/opentelemetry_domain.mli b/src/domain/opentelemetry_domain.mli new file mode 100644 index 000000000..36f5929e4 --- /dev/null +++ b/src/domain/opentelemetry_domain.mli @@ -0,0 +1,4 @@ +val cpu_relax : unit -> unit + +val relax_loop : int -> unit +(** Call {!cpu_relax} n times *) diff --git a/src/emitter/dune b/src/emitter/dune new file mode 100644 index 000000000..d6d6f5677 --- /dev/null +++ b/src/emitter/dune @@ -0,0 +1,10 @@ +(library + (name opentelemetry_emitter) + (public_name opentelemetry.emitter) + (libraries + (re_export opentelemetry.proto) + (re_export opentelemetry.util) + (re_export opentelemetry.atomic) + (re_export mtime)) + (flags :standard -open Opentelemetry_atomic) + (synopsis "Modular emitters for a single signal at a time")) diff --git a/src/emitter/emitter.ml b/src/emitter/emitter.ml new file mode 100644 index 000000000..d5c0393a0 --- /dev/null +++ b/src/emitter/emitter.ml @@ -0,0 +1,94 @@ +(** Emitters. + + This is the composable abstraction we use to represent how signals are + emitted, from their origin point (a site in user code or library code that + was instrumented, and just created a span or log record or metric), down to + the actual SDK exporter installed in the application. *) + +exception Closed + +type -'a t = { + signal_name: string; (** Description of what signal is emitted *) + enabled: unit -> bool; + (** Return [true] if [emit] has a chance of doing something with the + signals it's given. *) + emit: 'a list -> unit; + (** Emit signals. @raise Closed if the emitter is closed. *) + tick: mtime:Mtime.t -> unit; + (** Call regularly to ensure background work is done. The current + monotonic timestamp is passed to improve testability. *) + closed: unit -> bool; + (** True if the emitter is already closed. Beware TOCTOU bugs. *) + flush_and_close: unit -> unit; + (** Flush internally buffered signals, then close. *) + self_metrics: + now:Opentelemetry_util.Timestamp_ns.t -> + unit -> + Opentelemetry_proto.Metrics.metric list; + (** metrics about the emitter itself. *) +} +(** An emitter for values of type ['a]. *) + +let[@inline] enabled self : bool = self.enabled () + +let[@inline] emit (self : _ t) l : unit = if l <> [] then self.emit l + +let[@inline] tick (self : _ t) ~mtime : unit = self.tick ~mtime + +let[@inline] closed self : bool = self.closed () + +let[@inline] flush_and_close (self : _ t) : unit = self.flush_and_close () + +let[@inline] self_metrics self ~now : _ list = self.self_metrics ~now () + +(** [map f emitter] returns a new emitter that applies [f] to signals item-wise + before passing them to [emitter] *) +let map (f : 'a -> 'b) (self : 'b t) : 'a t = + { self with emit = (fun l -> self.emit (List.map f l)) } + +(** [map_l f emitter] applies [f] to incoming lists of signals, and emits the + resulting list (if non empty) *) +let flat_map (f : 'a list -> 'b list) (self : 'b t) : 'a t = + let emit l = + match f l with + | [] -> () + | fl -> self.emit fl + in + { self with emit } + +(** [tap f e] is like [e], but every signal is passed to [f] *) +let tap (f : 'a -> unit) (self : 'a t) : 'a t = + let emit l = + List.iter f l; + self.emit l + in + { self with emit } + +(** [make ~emit ()] is an emitter that calls [emit]. *) +let make ?tick ?closed ?enabled ?(flush_and_close = ignore) + ?(self_metrics = fun ~now:_ () -> []) ~signal_name ~emit () : _ t = + let tick = + match tick with + | None -> fun ~mtime:_ -> () + | Some f -> f + in + let closed, enabled = + match closed, enabled with + | None, None -> (fun () -> false), fun () -> true + | Some f, None -> f, fun () -> not (f ()) + | None, Some f -> (fun () -> not (f ())), f + | Some f1, Some f2 -> f1, f2 + in + { signal_name; tick; emit; flush_and_close; closed; enabled; self_metrics } + +(** Dummy emitter, doesn't accept or emit anything. *) +let dummy : _ t = + { + signal_name = "dummy"; + enabled = (fun () -> false); + emit = ignore; + tick = (fun ~mtime:_ -> ()); + closed = (fun () -> true); + flush_and_close = ignore; + self_metrics = (fun ~now:_ () -> []); + } diff --git a/src/emitter/to_list.ml b/src/emitter/to_list.ml new file mode 100644 index 000000000..260e5c103 --- /dev/null +++ b/src/emitter/to_list.ml @@ -0,0 +1,13 @@ +(** Emitter that stores signals into a list, in reverse order (most recent + signals first). *) +let to_list ~signal_name (l : 'a list ref) : 'a Emitter.t = + let closed_ = Atomic.make false in + let enabled = fun () -> not (Atomic.get closed_) in + let emit = + fun sigs -> + if Atomic.get closed_ then raise Emitter.Closed; + l := List.rev_append sigs !l + in + let closed () = Atomic.get closed_ in + let flush_and_close = fun () -> Atomic.set closed_ true in + Emitter.make ~signal_name ~emit ~enabled ~closed ~flush_and_close () diff --git a/src/integrations/cohttp/dune b/src/integrations/cohttp/dune index 16a92278b..5879dbf33 100644 --- a/src/integrations/cohttp/dune +++ b/src/integrations/cohttp/dune @@ -1,4 +1,4 @@ (library (name opentelemetry_cohttp_lwt) (public_name opentelemetry-cohttp-lwt) - (libraries cohttp-lwt opentelemetry opentelemetry-lwt)) + (libraries lwt cohttp uri cohttp-lwt opentelemetry opentelemetry-lwt)) diff --git a/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml b/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml index ad670b5c6..10be34c7d 100644 --- a/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml +++ b/src/integrations/cohttp/opentelemetry_cohttp_lwt.ml @@ -2,9 +2,16 @@ module Otel = Opentelemetry module Otel_lwt = Opentelemetry_lwt open Cohttp +open struct + let attrs_of_response (res : Response.t) = + let code = Response.status res in + let code = Code.code_of_status code in + [ "http.status_code", `Int code ] +end + module Server : sig val trace : - ?service_name:string -> + ?tracer:Otel.Tracer.t -> ?attrs:Otel.Span.key_value list -> ('conn -> Request.t -> 'body -> (Response.t * 'body) Lwt.t) -> 'conn -> @@ -27,8 +34,8 @@ module Server : sig ]} *) val with_ : + ?tracer:Otel.Tracer.t -> ?trace_state:string -> - ?service_name:string -> ?attrs:Otel.Span.key_value list -> ?kind:Otel.Span.kind -> ?links:Otel.Span_link.t list -> @@ -43,11 +50,11 @@ module Server : sig convenience. *) val get_trace_context : - ?from:[ `Internal | `External ] -> Request.t -> Otel.Scope.t option + ?from:[ `Internal | `External ] -> Request.t -> Otel.Span.t option (** Get the tracing scope from the custom [x-ocaml-otel-traceparent] header added by [trace] and [with_]. *) - val set_trace_context : Otel.Scope.t -> Request.t -> Request.t + val set_trace_context : Otel.Span.t -> Request.t -> Request.t (** Set the tracing scope in the custom [x-ocaml-otel-traceparent] header used by [trace] and [with_]. *) @@ -76,23 +83,18 @@ end = struct | Some r -> [ "http.request.header.referer", `String r ]); ] - let attrs_of_response (res : Response.t) = - let code = Response.status res in - let code = Code.code_of_status code in - [ "http.status_code", `Int code ] - let header_x_ocaml_otel_traceparent = "x-ocaml-otel-traceparent" - let set_trace_context (scope : Otel.Scope.t) req = + let set_trace_context (span : Otel.Span.t) req = let module Traceparent = Otel.Trace_context.Traceparent in let headers = Header.add (Request.headers req) header_x_ocaml_otel_traceparent - (Traceparent.to_value ~trace_id:scope.trace_id ~parent_id:scope.span_id - ()) + (Traceparent.to_value ~trace_id:(Otel.Span.trace_id span) + ~parent_id:(Otel.Span.id span) ()) in { req with headers } - let get_trace_context ?(from = `Internal) req = + let get_trace_context ?(from = `Internal) req : Otel.Span.t option = let module Traceparent = Otel.Trace_context.Traceparent in let name = match from with @@ -104,7 +106,9 @@ end = struct | Some v -> (match Traceparent.of_value v with | Ok (trace_id, parent_id) -> - Some (Otel.Scope.make ~trace_id ~span_id:parent_id ()) + (* TODO: we need a span_ctx here actually *) + Some + (Otel.Span.make ~trace_id ~id:parent_id ~start_time:0L ~end_time:0L "") | Error _ -> None) let remove_trace_context req = @@ -113,75 +117,57 @@ end = struct in { req with headers } - let trace ?service_name ?(attrs = []) callback conn req body = - let scope = get_trace_context ~from:`External req in - Otel_lwt.Trace.with_ ?service_name "request" ~kind:Span_kind_server - ?trace_id:(Option.map (fun scope -> scope.Otel.Trace.trace_id) scope) - ?parent:(Option.map (fun scope -> scope.Otel.Trace.span_id) scope) + let trace ?(tracer = Otel.Tracer.default) ?(attrs = []) callback conn req body + = + let parent = get_trace_context ~from:`External req in + Otel_lwt.Tracer.with_ ~tracer "request" ~kind:Span_kind_server + ?trace_id:(Option.map Otel.Span.trace_id parent) + ?parent ~attrs:(attrs @ attrs_of_request req) - (fun scope -> + (fun span -> let open Lwt.Syntax in - let req = set_trace_context scope req in + let req = set_trace_context span req in let* res, body = callback conn req body in - Otel.Scope.add_attrs scope (fun () -> attrs_of_response res); + Otel.Span.add_attrs span (attrs_of_response res); Lwt.return (res, body)) - let with_ ?trace_state ?service_name ?attrs + let with_ ?(tracer = Otel.Tracer.default) ?trace_state ?attrs ?(kind = Otel.Span.Span_kind_internal) ?links name req (f : Request.t -> 'a Lwt.t) = - let scope = get_trace_context ~from:`Internal req in - Otel_lwt.Trace.with_ ?trace_state ?service_name ?attrs ~kind - ?trace_id:(Option.map (fun scope -> scope.Otel.Trace.trace_id) scope) - ?parent:(Option.map (fun scope -> scope.Otel.Trace.span_id) scope) - ?links name - (fun scope -> - let req = set_trace_context scope req in + let span = get_trace_context ~from:`Internal req in + Otel_lwt.Tracer.with_ ~tracer ?trace_state ?attrs ~kind + ?trace_id:(Option.map Otel.Span.trace_id span) ?parent:span ?links name + (fun span -> + let req = set_trace_context span req in f req) end -let client ?(scope : Otel.Scope.t option) (module C : Cohttp_lwt.S.Client) = +let client ?(tracer = Otel.Tracer.default) ?(span : Otel.Span.t option) + (module C : Cohttp_lwt.S.Client) = let module Traced = struct open Lwt.Syntax (* These types and values are not customized by our client, but are required to satisfy [Cohttp_lwt.S.Client]. *) - include ( - C : - sig - type ctx = C.ctx - - type 'a io = 'a C.io - - type 'a with_context = 'a C.with_context + include C - type body = C.body - - val map_context : 'a with_context -> ('a -> 'b) -> 'b with_context - - val set_cache : Cohttp_lwt.S.call -> unit - end) - - let attrs_for ~uri ~meth:_ () = + let attrs_for ~uri ~meth () = [ - "http.method", `String (Code.string_of_method `GET); + "http.method", `String (Code.string_of_method meth); "http.url", `String (Uri.to_string uri); ] let context_for ~uri ~meth = - let trace_id = - match scope with - | Some scope -> Some scope.trace_id - | None -> None - in let parent = - match scope with - | Some scope -> Some scope.span_id - | None -> None + match span with + | Some _ -> span + | None -> Otel.Ambient_span.get () in + let trace_id = Option.map Otel.Span.trace_id parent in let attrs = attrs_for ~uri ~meth () in trace_id, parent, attrs - let add_traceparent (scope : Otel.Scope.t) headers = + let add_traceparent (span : Otel.Span.t) headers = let module Traceparent = Otel.Trace_context.Traceparent in let headers = match headers with @@ -189,20 +175,17 @@ let client ?(scope : Otel.Scope.t option) (module C : Cohttp_lwt.S.Client) = | Some headers -> headers in Header.add headers Traceparent.name - (Traceparent.to_value ~trace_id:scope.trace_id ~parent_id:scope.span_id - ()) + (Traceparent.to_value ~trace_id:(Otel.Span.trace_id span) + ~parent_id:(Otel.Span.id span) ()) let call ?ctx ?headers ?body ?chunked meth (uri : Uri.t) : (Response.t * Cohttp_lwt.Body.t) Lwt.t = let trace_id, parent, attrs = context_for ~uri ~meth in - Otel_lwt.Trace.with_ "request" ~kind:Span_kind_client ?trace_id ?parent - ~attrs (fun scope -> - let headers = add_traceparent scope headers in + Otel_lwt.Tracer.with_ ~tracer "request" ~kind:Span_kind_client ?trace_id + ?parent ~attrs (fun span -> + let headers = add_traceparent span headers in let* res, body = C.call ?ctx ~headers ?body ?chunked meth uri in - Otel.Scope.add_attrs scope (fun () -> - let code = Response.status res in - let code = Code.code_of_status code in - [ "http.status_code", `Int code ]); + Otel.Span.add_attrs span (attrs_of_response res); Lwt.return (res, body)) let head ?ctx ?headers uri = @@ -225,14 +208,11 @@ let client ?(scope : Otel.Scope.t option) (module C : Cohttp_lwt.S.Client) = let post_form ?ctx ?headers ~params uri = let trace_id, parent, attrs = context_for ~uri ~meth:`POST in - Otel_lwt.Trace.with_ "request" ~kind:Span_kind_client ?trace_id ?parent - ~attrs (fun scope -> - let headers = add_traceparent scope headers in + Otel_lwt.Tracer.with_ ~tracer "request" ~kind:Span_kind_client ?trace_id + ?parent ~attrs (fun span -> + let headers = add_traceparent span headers in let* res, body = C.post_form ?ctx ~headers ~params uri in - Otel.Scope.add_attrs scope (fun () -> - let code = Response.status res in - let code = Code.code_of_status code in - [ "http.status_code", `Int code ]); + Otel.Span.add_attrs span (attrs_of_response res); Lwt.return (res, body)) let callv = C.callv (* TODO *) diff --git a/src/integrations/logs/opentelemetry_logs.ml b/src/integrations/logs/opentelemetry_logs.ml index 713d4e38d..c840bacfc 100644 --- a/src/integrations/logs/opentelemetry_logs.ml +++ b/src/integrations/logs/opentelemetry_logs.ml @@ -1,4 +1,4 @@ -module Otel = Opentelemetry +module OTEL = Opentelemetry (*****************************************************************************) (* Prelude *) @@ -10,22 +10,19 @@ module Otel = Opentelemetry (*****************************************************************************) (* Levels *) (*****************************************************************************) -(* Convert log level to Otel severity *) -let log_level_to_severity (level : Logs.level) : Otel.Logs.severity = +(* Convert log level to OTEL severity *) +let log_level_to_severity (level : Logs.level) : OTEL.Log_record.severity = match level with - | Logs.App -> Otel.Logs.Severity_number_info (* like info, but less severe *) - | Logs.Info -> Otel.Logs.Severity_number_info2 - | Logs.Error -> Otel.Logs.Severity_number_error - | Logs.Warning -> Otel.Logs.Severity_number_warn - | Logs.Debug -> Otel.Logs.Severity_number_debug + | Logs.App -> Severity_number_info (* like info, but less severe *) + | Logs.Info -> Severity_number_info2 + | Logs.Error -> Severity_number_error + | Logs.Warning -> Severity_number_warn + | Logs.Debug -> Severity_number_debug (*****************************************************************************) (* Logs Util *) (*****************************************************************************) -let create_tag (tag : string) : string Logs.Tag.def = - Logs.Tag.def tag Format.pp_print_string - let emit_telemetry_tag = Logs.Tag.def ~doc:"Whether or not to emit this log via telemetry" "emit_telemetry" Format.pp_print_bool @@ -37,21 +34,22 @@ let emit_telemetry do_emit = Logs.Tag.(empty |> add emit_telemetry_tag do_emit) (*****************************************************************************) (* Log a message to otel with some attrs *) -let log ?service_name ?(attrs = []) ?(scope = Otel.Scope.get_ambient_scope ()) - ~level msg = +let log ?(logger = OTEL.Logger.default) ?attrs + ?(scope = OTEL.Ambient_span.get ()) ~level msg = let log_level = Logs.level_to_string (Some level) in - let span_id = - Option.map (fun (scope : Otel.Scope.t) -> scope.span_id) scope - in - let trace_id = - Option.map (fun (scope : Otel.Scope.t) -> scope.trace_id) scope - in + let span_id = Option.map OTEL.Span.id scope in + let trace_id = Option.map OTEL.Span.trace_id scope in let severity = log_level_to_severity level in - let log = Otel.Logs.make_str ~severity ~log_level ?trace_id ?span_id msg in + let log = + let observed_time_unix_nano = OTEL.Clock.now logger.clock in + OTEL.Log_record.make_str ~observed_time_unix_nano ~severity ~log_level + ?attrs ?trace_id ?span_id msg + in + (* Noop if no backend is set *) - Otel.Logs.emit ?service_name ~attrs [ log ] + OTEL.Logger.emit1 logger log -let otel_reporter ?service_name ?(attributes = []) () : Logs.reporter = +let otel_reporter ?(attributes = []) () : Logs.reporter = let report src level ~over k msgf = msgf (fun ?header ?(tags : Logs.Tag.set option) fmt -> let k _ = @@ -95,13 +93,13 @@ let otel_reporter ?service_name ?(attributes = []) () : Logs.reporter = let do_emit = Option.value ~default:true (Logs.Tag.find emit_telemetry_tag tags) in - if do_emit then log ?service_name ~attrs ~level msg; + if do_emit then log ~attrs ~level msg; k ()) fmt) in { Logs.report } -let attach_otel_reporter ?service_name ?attributes reporter = +let attach_otel_reporter ?attributes reporter = (* Copied directly from the Logs.mli docs. Just calls a bunch of reporters in a row *) let combine r1 r2 = @@ -111,5 +109,5 @@ let attach_otel_reporter ?service_name ?attributes reporter = in { Logs.report } in - let otel_reporter = otel_reporter ?service_name ?attributes () in + let otel_reporter = otel_reporter ?attributes () in combine reporter otel_reporter diff --git a/src/integrations/logs/opentelemetry_logs.mli b/src/integrations/logs/opentelemetry_logs.mli index 7ac4e5945..43fadb8fb 100644 --- a/src/integrations/logs/opentelemetry_logs.mli +++ b/src/integrations/logs/opentelemetry_logs.mli @@ -24,11 +24,8 @@ val emit_telemetry : bool -> Logs.Tag.set {!emit_telemetry_tag} as its only member *) val otel_reporter : - ?service_name:string -> - ?attributes:(string * Opentelemetry.value) list -> - unit -> - Logs.reporter -(** [otel_reporter ?service_name ?tag_value_pp_buffer_size ?attrs ()] creates a + ?attributes:(string * Opentelemetry.value) list -> unit -> Logs.reporter +(** [otel_reporter ?tag_value_pp_buffer_size ?attrs ()] creates a [Logs.reporter] that will create and emit an OTel log with the following info: {ul @@ -61,19 +58,17 @@ val otel_reporter : Example use: [Logs.set_reporter (Opentelemetery_logs.otel_reporter ())] *) val attach_otel_reporter : - ?service_name:string -> ?attributes:(string * Opentelemetry.value) list -> Logs.reporter -> Logs.reporter -(** [attach_otel_reporter ?service_name ?attributes reporter] will create a - reporter that first calls the reporter passed as an argument, then an otel - report created via {!otel_reporter}, for every log. This is useful for if - you want to emit logs to stderr and to OTel at the same time. +(** [attach_otel_reporter ?attributes reporter] will create a reporter that + first calls the reporter passed as an argument, then an otel report created + via {!otel_reporter}, for every log. This is useful for if you want to emit + logs to stderr and to OTel at the same time. Example: {[ let reporter = Logs_fmt.reporter () in Logs.set_reporter - (Opentelemetry_logs.attach_otel_reporter ?service_name ?attributes - reporter) + (Opentelemetry_logs.attach_otel_reporter ?attributes reporter) ]} *) diff --git a/src/lib/ambient_span.ml b/src/lib/ambient_span.ml new file mode 100644 index 000000000..41d20edd7 --- /dev/null +++ b/src/lib/ambient_span.ml @@ -0,0 +1,9 @@ +(** Find current span from ambient-context *) +let[@inline] get () : Span.t option = + Opentelemetry_ambient_context.get Span.k_ambient + +(** [with_ambient span f] runs [f()] with the current ambient span being set to + [span] *) +let[@inline] with_ambient (span : Span.t) (f : unit -> 'a) : 'a = + Opentelemetry_ambient_context.with_key_bound_to Span.k_ambient span (fun _ -> + f ()) diff --git a/src/lib/ambient_span.mli b/src/lib/ambient_span.mli new file mode 100644 index 000000000..70997ac47 --- /dev/null +++ b/src/lib/ambient_span.mli @@ -0,0 +1,8 @@ +(** Storing the current span in ambient context. *) + +val get : unit -> Span.t option +(** Find current span from ambient-context *) + +val with_ambient : Span.t -> (unit -> 'a) -> 'a +(** [with_ambient span f] runs [f()] with the current ambient span being set to + [span] *) diff --git a/src/lib/batch.ml b/src/lib/batch.ml new file mode 100644 index 000000000..aa0938647 --- /dev/null +++ b/src/lib/batch.ml @@ -0,0 +1,139 @@ +open Opentelemetry_atomic + +type 'a state = { + start: Mtime.t; + size: int; + q: 'a list; (** The queue is a FIFO represented as a list in reverse order *) +} + +type 'a t = { + st: 'a state Atomic.t; + batch: int; (** Minimum size to batch before popping *) + high_watermark: int; (** Size above which we start dropping signals *) + timeout: Mtime.span option; + n_dropped: int Atomic.t; +} + +let max_batch_size = 100_000 + +let default_high_watermark batch_size = + max 10 (min (batch_size * 10) max_batch_size) + +(** passed to ignore timeout *) +let mtime_dummy_ = Mtime.min_stamp + +let _empty_state : _ state = { q = []; size = 0; start = mtime_dummy_ } + +let[@inline] cur_size (self : _ t) : int = (Atomic.get self.st).size + +let make ?(batch = 100) ?high_watermark ?mtime ?timeout () : _ t = + let batch = min batch max_batch_size in + let high_watermark = + match high_watermark with + | Some x -> max x batch (* high watermark must be >= batch *) + | None -> default_high_watermark batch + in + assert (high_watermark >= batch); + + let start = + match mtime with + | Some x -> x + | None -> mtime_dummy_ + in + assert (batch > 0); + { + st = Atomic.make @@ { size = 0; q = []; start }; + batch; + timeout; + high_watermark; + n_dropped = Atomic.make 0; + } + +let timeout_expired_ ~mtime ~timeout (self : _ state) : bool = + mtime <> mtime_dummy_ + && + match timeout with + | Some t -> + let elapsed = Mtime.span mtime self.start in + Mtime.Span.compare elapsed t >= 0 + | None -> false + +(** Big enough to send? *) +let[@inline] is_full_ ~batch (self : _ state) : bool = self.size >= batch + +let pop_if_ready_ ~force ~mtime (self : _ t) : _ list option = + let rev_batch_opt = + (* update state. When uncontended this runs only once. *) + Util_atomic.update_cas self.st @@ fun state -> + (* *) + + (* check if the batch is ready *) + let ready_to_pop = + state.size > 0 + && (force + || is_full_ ~batch:self.batch state + || timeout_expired_ ~mtime ~timeout:self.timeout state) + in + + if ready_to_pop then ( + assert (state.q <> []); + let batch = state.q in + let new_st = _empty_state in + Some batch, new_st + ) else + None, state + in + match rev_batch_opt with + | None -> None + | Some batch -> + (* Reverse the list to retrieve the FIFO order. *) + Some (List.rev batch) + +let pop_if_ready ?(force = false) ~mtime (self : _ t) : _ list option = + pop_if_ready_ ~force ~mtime self + +let push (self : _ t) elems : [ `Dropped | `Ok ] = + if elems = [] then + `Ok + else ( + let now = Mtime_clock.now () in + let res = + Util_atomic.update_cas self.st @@ fun state -> + if state.size >= self.high_watermark then + ( (* drop this to prevent queue from growing too fast *) + `Dropped, + state ) + else ( + let start = + if state.size = 0 && Option.is_some self.timeout then + now + else + state.start + in + + (* add to queue *) + let state = + { + size = state.size + List.length elems; + q = List.rev_append elems state.q; + start; + } + in + + `Ok, state + ) + in + (match res with + | `Dropped -> + ignore (Atomic.fetch_and_add self.n_dropped (List.length elems) : int) + | `Ok -> ()); + res + ) + +let[@inline] push' self elems = ignore (push self elems : [ `Dropped | `Ok ]) + +let[@inline] n_dropped self = Atomic.get self.n_dropped + +module Internal_ = struct + let mtime_dummy_ = mtime_dummy_ +end diff --git a/src/client/batch.mli b/src/lib/batch.mli similarity index 63% rename from src/client/batch.mli rename to src/lib/batch.mli index a7ed2aa91..baa94068b 100644 --- a/src/client/batch.mli +++ b/src/lib/batch.mli @@ -1,11 +1,11 @@ -(** A thread-safe batch of resources to be popper when ready . *) +(** A thread-safe batch of resources, to be sent together when ready. *) type 'a t val make : ?batch:int -> ?high_watermark:int -> - ?now:Mtime.t -> + ?mtime:Mtime.t -> ?timeout:Mtime.span -> unit -> 'a t @@ -13,8 +13,7 @@ val make : @param batch the number of elements after which the batch will be considered {b full}, - and ready to pop. Set to [0] to disable batching. It is required that - [batch >= 0]. Default [1]. + and ready to pop. It is required that [batch >= 0]. Default [100]. @param high_watermark the batch size limit after which new elements will be [`Dropped] by @@ -22,15 +21,15 @@ val make : transmission in case of signal floods. Default [if batch = 1 then 100 else batch * 10]. - @param now the current time. Default [Mtime_clock.now ()]. + @param mtime the current time. @param timeout the time span after which a batch is ready to pop, whether or not it is {b full}. *) -val pop_if_ready : ?force:bool -> now:Mtime.t -> 'a t -> 'a list option -(** [pop_if_ready ~now b] is [Some xs], where is [xs] includes all the elements - {!push}ed since the last batch, if the batch ready to be emitted. +val pop_if_ready : ?force:bool -> mtime:Mtime.t -> 'a t -> 'a list option +(** [pop_if_ready ~mtime b] is [Some xs], where is [xs] includes all the + elements {!push}ed since the last batch, if the batch ready to be emitted. A batch is ready to pop if it contains some elements and @@ -40,7 +39,7 @@ val pop_if_ready : ?force:bool -> now:Mtime.t -> 'a t -> 'a list option the last pop was ready, or - the pop is [force]d, - @param now the current time + @param mtime the current monotonic time @param force override the other batch conditions, for when when we just want to emit @@ -50,3 +49,20 @@ val push : 'a t -> 'a list -> [ `Dropped | `Ok ] (** [push b xs] is [`Ok] if it succeeds in pushing the values in [xs] into the batch [b], or [`Dropped] if the current size of the batch has exceeded the high water mark determined by the [batch] argument to [{!make}]. ) *) + +val push' : 'a t -> 'a list -> unit +(** Like {!push} but ignores the result *) + +val cur_size : _ t -> int +(** Number of elements in the current batch *) + +val n_dropped : _ t -> int +(** Number of elements dropped because the batch exceeded its high watermark *) + +(**/**) + +module Internal_ : sig + val mtime_dummy_ : Mtime.t +end + +(**/**) diff --git a/src/lib/conventions.ml b/src/lib/conventions.ml new file mode 100644 index 000000000..c4002cb11 --- /dev/null +++ b/src/lib/conventions.ml @@ -0,0 +1,130 @@ +(** Semantic conventions. + + {{:https://opentelemetry.io/docs/specs/semconv/} + https://opentelemetry.io/docs/specs/semconv/} *) + +module Attributes = struct + module Process = struct + module Runtime = struct + let name = "process.runtime.name" + + let version = "process.runtime.version" + + let description = "process.runtime.description" + end + end + + (** https://opentelemetry.io/docs/specs/semconv/attributes-registry/code/ *) + module Code = struct + (** Int *) + let column = "code.column" + + let filepath = "code.filepath" + + let function_ = "code.function" + + (** int *) + let line = "code.lineno" + + let namespace = "code.namespace" + + let stacktrace = "code.stacktrace" + end + + module Service = struct + let name = "service.name" + + let namespace = "service.namespace" + + let instance_id = "service.instance.id" + + let version = "service.version" + end + + module HTTP = struct + let error_type = "error.type" + + let request_method = "http.request.method" + + let route = "http.route" + + let url_full = "url.full" + + (** HTTP status code, int *) + let response_status_code = "http.response.status_code" + + let server_address = "server.address" + + let server_port = "server.port" + + (** http or https *) + let url_scheme = "url.scheme" + end + + (** https://github.com/open-telemetry/semantic-conventions/blob/main/docs/resource/host.md + *) + module Host = struct + let id = "host.id" + + let name = "host.name" + + let type_ = "host.type" + + let arch = "host.arch" + + let ip = "host.ip" + + let mac = "host.mac" + + let image_id = "host.image.id" + + let image_name = "host.image.name" + + let image_version = "host.image.version" + end +end + +module Metrics = struct + module Process = struct + module Runtime = struct + module Ocaml = struct + module GC = struct + let compactions = "process.runtime.ocaml.gc.compactions" + + let major_collections = "process.runtime.ocaml.gc.major_collections" + + let major_heap = "process.runtime.ocaml.gc.major_heap" + + let minor_allocated = "process.runtime.ocaml.gc.minor_allocated" + + let minor_collections = "process.runtime.ocaml.gc.minor_collections" + end + end + end + end + + (** https://opentelemetry.io/docs/specs/semconv/http/ *) + module HTTP = struct + module Server = struct + let request_duration = "http.server.request.duration" + + let active_requests = "http.server.active_requests" + + (** Histogram *) + let request_body_size = "http.server.request.body.size" + + (** Histogram *) + let response_body_size = "http.server.response.body.size" + end + + module Client = struct + let request_duration = "http.client.request.duration" + + (** Histogram *) + let request_body_size = "http.client.request.body.size" + + (** Histogram *) + let response_body_size = "http.client.response.body.size" + end + end +end diff --git a/src/lib/dune b/src/lib/dune new file mode 100644 index 000000000..98c8aed64 --- /dev/null +++ b/src/lib/dune @@ -0,0 +1,28 @@ +(library + (name opentelemetry) + (public_name opentelemetry) + (synopsis "API for opentelemetry instrumentation") + (flags + :standard + -warn-error + -a+8 + -open + Opentelemetry_util + -open + Opentelemetry_core + -open + Opentelemetry_core.Common_ + -open + Opentelemetry_atomic) + (libraries + (re_export opentelemetry.core) + (re_export opentelemetry.proto) + (re_export opentelemetry.util) + (re_export opentelemetry.ambient-context) + (re_export opentelemetry.atomic) + (re_export hmap) + mtime + mtime.clock.os + pbrt + unix + threads)) diff --git a/src/lib/dynamic_enricher.ml b/src/lib/dynamic_enricher.ml new file mode 100644 index 000000000..2b44c02dd --- /dev/null +++ b/src/lib/dynamic_enricher.ml @@ -0,0 +1,26 @@ +(** Hooks to add attributes to every span or log *) + +type t = unit -> Key_value.t list +(** A dynamic enricher is a callback that produces high-cardinality attributes + at span/log-record creation time. This enables "wide events". *) + +open struct + let enrichers_ : t Alist.t = Alist.make () +end + +let add (f : t) : unit = Alist.add enrichers_ f + +let collect () : Key_value.t list = + let acc = ref [] in + List.iter + (fun f -> + match f () with + | kvs -> acc := List.rev_append kvs !acc + | exception exn -> + let bt = Printexc.get_raw_backtrace () in + Self_debug.log Warning (fun () -> + Printf.sprintf "dynamic_enricher raised %s\n%s" + (Printexc.to_string exn) + (Printexc.raw_backtrace_to_string bt))) + (Alist.get enrichers_); + !acc diff --git a/src/lib/emitter_batch.ml b/src/lib/emitter_batch.ml new file mode 100644 index 000000000..a1c282a35 --- /dev/null +++ b/src/lib/emitter_batch.ml @@ -0,0 +1,85 @@ +open Opentelemetry_emitter + +(** Emit current batch, if the conditions are met *) +let maybe_emit_ (b : _ Batch.t) ~(e : _ Emitter.t) ~mtime : unit = + match Batch.pop_if_ready b ~force:false ~mtime with + | None -> () + | Some l -> Emitter.emit e l + +let wrap_emitter_with_batch (self : _ Batch.t) (e : _ Emitter.t) : _ Emitter.t = + (* we need to be able to close this emitter before we close [e]. This + will become [true] when we close, then we call [Emitter.flush_and_close e], + then [e] itself will be closed. *) + let closed_here = Atomic.make false in + + let signal_name = e.signal_name in + let enabled () = (not (Atomic.get closed_here)) && e.enabled () in + let closed () = Atomic.get closed_here || e.closed () in + + let dropped_name = Printf.sprintf "otel.sdk.%s.batch.dropped" signal_name in + let self_metrics ~now () = + let m = + Opentelemetry_core.Metrics.( + sum ~name:dropped_name [ int ~now (Batch.n_dropped self) ]) + in + m :: e.self_metrics ~now () + in + let flush_and_close () = + if not (Atomic.exchange closed_here true) then ( + (* NOTE: we need to close this wrapping emitter first, to prevent + further pushes; then write the content to [e]; then + flusn and close [e]. In this order. *) + (match + Batch.pop_if_ready self ~force:true ~mtime:Batch.Internal_.mtime_dummy_ + with + | None -> () + | Some l -> Emitter.emit e l); + + (* now we can close [e], nothing remains in [self] *) + Emitter.flush_and_close e + ) + in + + let tick ~mtime = + if not (Atomic.get closed_here) then ( + (* first, check if batch has timed out *) + maybe_emit_ self ~e ~mtime; + + (* only then, tick the underlying emitter *) + Emitter.tick e ~mtime + ) + in + + let emit l = + if l <> [] && not (Atomic.get closed_here) then ( + let old_n_dropped = Batch.n_dropped self in + (match Batch.push self l with + | `Ok -> () + | `Dropped -> + let n_dropped = Batch.n_dropped self in + if n_dropped / 100_000 <> old_n_dropped / 100_000 then + Self_debug.log Debug (fun () -> + Printf.sprintf "otel: batch %s dropped %d items in total" + signal_name n_dropped)); + maybe_emit_ self ~e ~mtime:Batch.Internal_.mtime_dummy_ + ) + in + + { + Emitter.closed; + signal_name; + self_metrics; + enabled; + flush_and_close; + tick; + emit; + } + +let add_batching ~timeout ~batch_size (emitter : 'a Emitter.t) : 'a Emitter.t = + let b = Batch.make ~batch:batch_size ~timeout () in + wrap_emitter_with_batch b emitter + +let add_batching_opt ~timeout ~batch_size:(b : int option) e = + match b with + | None -> e + | Some b -> add_batching ~timeout ~batch_size:b e diff --git a/src/lib/emitter_batch.mli b/src/lib/emitter_batch.mli new file mode 100644 index 000000000..4a43fcaae --- /dev/null +++ b/src/lib/emitter_batch.mli @@ -0,0 +1,20 @@ +(** Add a batch in front of an emitter. + + The batch accumulates signals until it's full or too old, at which points + all the accumulated signals are emitted at once. Pushing into a batch is + generally very fast (amortized), in most cases; the slow path is only when + the batch needs to be emitted. + + @since 0.90 *) + +open Opentelemetry_emitter + +val wrap_emitter_with_batch : 'a Batch.t -> 'a Emitter.t -> 'a Emitter.t +(** [wrap_emitter_with_batch batch e] is an emitter that uses batch [batch] to + gather signals into larger lists before passing them to [e]. *) + +val add_batching : + timeout:Mtime.span -> batch_size:int -> 'a Emitter.t -> 'a Emitter.t + +val add_batching_opt : + timeout:Mtime.span -> batch_size:int option -> 'a Emitter.t -> 'a Emitter.t diff --git a/src/lib/gc_metrics.ml b/src/lib/gc_metrics.ml new file mode 100644 index 000000000..5258880fb --- /dev/null +++ b/src/lib/gc_metrics.ml @@ -0,0 +1,46 @@ +open struct + let bytes_per_word = Sys.word_size / 8 + + let[@inline] word_to_bytes n = n * bytes_per_word + + let[@inline] word_to_bytes_f n = n *. float bytes_per_word + + let default_interval_s = 20 +end + +let get_metrics () : Metrics.t list = + let gc = Gc.quick_stat () in + let now = Clock.now_main () in + let open Metrics in + let open Conventions.Metrics in + [ + gauge ~name:Process.Runtime.Ocaml.GC.major_heap ~unit_:"B" + [ int ~now (word_to_bytes gc.Gc.heap_words) ]; + sum ~name:Process.Runtime.Ocaml.GC.minor_allocated + ~aggregation_temporality:Metrics.Aggregation_temporality_cumulative + ~is_monotonic:true ~unit_:"B" + [ float ~now (word_to_bytes_f gc.Gc.minor_words) ]; + sum ~name:Process.Runtime.Ocaml.GC.minor_collections + ~aggregation_temporality:Metrics.Aggregation_temporality_cumulative + ~is_monotonic:true + [ int ~now gc.Gc.minor_collections ]; + sum ~name:Process.Runtime.Ocaml.GC.major_collections + ~aggregation_temporality:Metrics.Aggregation_temporality_cumulative + ~is_monotonic:true + [ int ~now gc.Gc.major_collections ]; + sum ~name:Process.Runtime.Ocaml.GC.compactions + ~aggregation_temporality:Metrics.Aggregation_temporality_cumulative + ~is_monotonic:true + [ int ~now gc.Gc.compactions ]; + ] + +let setup ?(min_interval_s = default_interval_s) + ?(meter = Meter_provider.default_meter) () = + let min_interval_s = max 5 min_interval_s in + let min_interval = Mtime.Span.(min_interval_s * s) in + let limiter = Interval_limiter.create ~min_interval () in + Sdk.add_on_tick_callback (fun () -> + if Interval_limiter.make_attempt limiter then + List.iter (Meter.emit1 meter) (get_metrics ())) + +let basic_setup () = setup () diff --git a/src/lib/gc_metrics.mli b/src/lib/gc_metrics.mli new file mode 100644 index 000000000..53cae54b6 --- /dev/null +++ b/src/lib/gc_metrics.mli @@ -0,0 +1,12 @@ +(** Export GC metrics periodically. *) + +val get_metrics : unit -> Metrics.t list +(** Get a snapshot of GC statistics as metrics. *) + +val setup : ?min_interval_s:int -> ?meter:Meter.t -> unit -> unit +(** Register a tick callback that emits GC statistics periodically. + @param min_interval_s emit at most every N seconds (default 20) + @param meter where to emit metrics (default [Meter.default]) *) + +val basic_setup : unit -> unit +(** [setup ()] — uses all defaults. *) diff --git a/src/lib/globals.ml b/src/lib/globals.ml new file mode 100644 index 000000000..0c773233f --- /dev/null +++ b/src/lib/globals.ml @@ -0,0 +1,144 @@ +(** Process-wide metadata, environment variables, etc. *) + +open Common_ +open Proto.Common + +(** Main service name metadata *) +let service_name = + ref + (match Sys.getenv_opt "OTEL_SERVICE_NAME" with + | Some name -> name + | None -> "unknown_service") + +(** Namespace for the service *) +let service_namespace = ref None + +(** Unique identifier for the service *) +let service_instance_id = ref None + +(** Version for the service + @since 0.12 *) +let service_version = ref None + +(** @since 0.90 *) +let sdk_version : string = Version.version + +let instrumentation_library = + make_instrumentation_scope ~version:sdk_version ~name:"opentelemetry" () + +(** Global attributes, initially set via OTEL_RESOURCE_ATTRIBUTES and modifiable + by the user code. They will be attached to each outgoing metrics/traces. *) +let global_attributes : key_value list ref = + let parse_pair s = + match String.split_on_char '=' s with + | [ a; b ] -> make_key_value ~key:a ~value:(String_value b) () + | _ -> failwith (Printf.sprintf "invalid attribute: %S" s) + in + ref + @@ + try + Sys.getenv "OTEL_RESOURCE_ATTRIBUTES" + |> String.split_on_char ',' |> List.map parse_pair + with _ -> [] + +(** Add a global attribute *) +let add_global_attribute (key : string) (v : Value.t) : unit = + global_attributes := Key_value.conv (key, v) :: !global_attributes + +(* add global attributes to this list *) +let merge_global_attributes_ into : _ list = + let not_redundant kv = List.for_all (fun kv' -> kv.key <> kv'.key) into in + List.rev_append (List.filter not_redundant !global_attributes) into + +let default_span_kind = Span.default_kind + +open struct + let runtime_attributes = + Conventions.Attributes. + [ + Process.Runtime.name, `String "ocaml"; + Process.Runtime.version, `String Sys.ocaml_version; + ] + + let runtime_attributes_converted = List.map Key_value.conv runtime_attributes + + let sdk_attributes = + [ + "telemetry.sdk.language", `String "ocaml"; + "telemetry.sdk.name", `String "opentelemetry"; + "telemetry.sdk.version", `String sdk_version; + ] + + let sdk_attributes_converted = List.map Key_value.conv sdk_attributes +end + +(** Attributes about the OCaml runtime. See + https://github.com/open-telemetry/opentelemetry-specification/blob/main/specification/resource/semantic_conventions/process.md#process-runtimes +*) +let[@inline] get_runtime_attributes () = runtime_attributes + +(** Build main global attributes, to be used in resource attributes (shared by + all spans/metrics/logs in each outgoing batch) *) +let mk_attributes ?(service_name = !service_name) ?(attrs = []) () : _ list = + let l = List.rev_map Key_value.conv attrs in + let l = List.rev_append runtime_attributes_converted l in + let l = List.rev_append sdk_attributes_converted l in + let l = + make_key_value ~key:Conventions.Attributes.Service.name + ~value:(String_value service_name) () + :: l + in + let l = + match !service_instance_id with + | None -> l + | Some v -> + make_key_value ~key:Conventions.Attributes.Service.instance_id + ~value:(String_value v) () + :: l + in + let l = + match !service_namespace with + | None -> l + | Some v -> + make_key_value ~key:Conventions.Attributes.Service.namespace + ~value:(String_value v) () + :: l + in + let l = + match !service_version with + | None -> l + | Some v -> + make_key_value ~key:Conventions.Attributes.Service.version + ~value:(String_value v) () + :: l + in + l |> merge_global_attributes_ + +(** Global tick callback registry. Callbacks are run periodically by the SDK + ticker. Other modules register here to avoid depending on {!Sdk}. *) +let tick_cbs_ : (unit -> unit) Alist.t = Alist.make () + +let add_on_tick_callback (f : unit -> unit) : unit = Alist.add tick_cbs_ f + +let run_tick_callbacks () : unit = + List.iter (fun f -> f ()) (Alist.get tick_cbs_) + +(* TODO: rename to dynamic_attributes *) +module Enricher = struct + type t = unit -> key_value list + + let cached ~(timeout_s : float) (e : t) : t = + let last_updated = ref (Unix.gettimeofday ()) in + let value = ref (e ()) in + fun () -> + let now = Unix.gettimeofday () in + if now > !last_updated +. timeout_s then ( + last_updated := now; + value := e () + ); + !value + + let all_ : t list ref = ref [] + + let add f = all_ := f :: !all_ +end diff --git a/src/lib/interval_limiter.ml b/src/lib/interval_limiter.ml new file mode 100644 index 000000000..37eff85a9 --- /dev/null +++ b/src/lib/interval_limiter.ml @@ -0,0 +1,20 @@ +type t = { + min_interval: Mtime.span; + last: Mtime.t Atomic.t; +} + +let[@inline] min_interval self = self.min_interval + +let create ~min_interval () : t = + { min_interval; last = Atomic.make Mtime.min_stamp } + +let make_attempt (self : t) : bool = + let now = Mtime_clock.now () in + let last = Atomic.get self.last in + let elapsed = Mtime.span last now in + if Mtime.Span.compare elapsed self.min_interval >= 0 then + (* attempts succeeds, unless another thread updated [self.last] + in the mean time, so we return [true] iff the CAS was successful *) + Atomic.compare_and_set self.last last now + else + false diff --git a/src/lib/interval_limiter.mli b/src/lib/interval_limiter.mli new file mode 100644 index 000000000..b2cc11dd3 --- /dev/null +++ b/src/lib/interval_limiter.mli @@ -0,0 +1,14 @@ +(** Interval limiter. This is a form of rate limiting where an event cannot be + followed by another event until a given interval of time has passed. *) + +type t + +val create : min_interval:Mtime.span -> unit -> t + +val min_interval : t -> Mtime.span + +val make_attempt : t -> bool +(** [make_attempt lim] returns [true] if the last successful attempt was more + than [min_interval] ago, as measured by mtime. If so, this counts as the new + latest attempt; otherwise [false] is returned and the state is not updated. +*) diff --git a/src/lib/log_provider.ml b/src/lib/log_provider.ml new file mode 100644 index 000000000..b4e30378e --- /dev/null +++ b/src/lib/log_provider.ml @@ -0,0 +1,84 @@ +open Opentelemetry_emitter + +open struct + let provider_ : Logger.t Atomic.t = Atomic.make Logger.dummy +end + +let get () : Logger.t = Atomic.get provider_ + +let set (t : Logger.t) : unit = + Self_debug.log Info (fun () -> "otel: log provider installed"); + Atomic.set provider_ t + +let clear () : unit = + Self_debug.log Info (fun () -> "otel: log provider removed"); + Atomic.set provider_ Logger.dummy + +(** Get a logger pre-configured with a fixed set of attributes added to every + log record it emits, forwarding to the current global logger. Intended to be + called once at the top of a library module. + + @param name instrumentation scope name (recorded as [otel.scope.name]) + @param version + instrumentation scope version (recorded as [otel.scope.version]) + @param __MODULE__ + the OCaml module name, typically the [__MODULE__] literal (recorded as + [code.namespace]) + @param attrs additional fixed attributes *) +let get_logger ?name ?version ?(attrs : (string * [< Value.t ]) list = []) + ?__MODULE__ () : Logger.t = + let extra = + Scope_attributes.make_attrs ?name ?version ~attrs ?__MODULE__ () + in + { + Logger.emit = + Emitter.make ~signal_name:"logs" + ~enabled:(fun () -> Emitter.enabled (Atomic.get provider_).emit) + ~emit:(fun logs -> + (match extra with + | [] -> () + | _ -> List.iter (fun log -> Log_record.add_attrs log extra) logs); + Emitter.emit (Atomic.get provider_).emit logs) + (); + clock = { Clock.now = (fun () -> Clock.now (Clock.Main.get ())) }; + } + +(** A Logger.t that lazily reads the global at emit time *) +let default_logger : Logger.t = get_logger () + +(** Emit log with current logger *) +let[@inline] emit (log : Log_record.t) : unit = + Emitter.emit (get ()).emit [ log ] + +open Log_record + +(** Create log record and emit it on [logger] *) +let log ?(logger = default_logger) ?attrs ?trace_id ?span_id + ?(severity : severity option) (msg : string) : unit = + if Logger.enabled logger then ( + let now = Clock.now logger.clock in + let dyn_attrs = Dynamic_enricher.collect () in + let attrs = + match dyn_attrs with + | [] -> attrs + | _ -> + let base = Option.value ~default:[] attrs in + Some (List.rev_append dyn_attrs base) + in + let logrec = + Log_record.make_str ?attrs ?trace_id ?span_id ?severity + ~observed_time_unix_nano:now msg + in + Logger.emit1 logger logrec + ) + +(** Helper to create a log record, with a suspension, like in [Logs]. + + Example usage: + [logf ~severity:Severity_number_warn (fun k->k"oh no!! %s it's bad: %b" + "help" true)] *) +let logf ?(logger = default_logger) ?attrs ?trace_id ?span_id ?severity msgf : + unit = + if Logger.enabled logger then + msgf (fun fmt -> + Format.kasprintf (log ~logger ?attrs ?trace_id ?span_id ?severity) fmt) diff --git a/src/lib/logger.ml b/src/lib/logger.ml new file mode 100644 index 000000000..1dc0d45a9 --- /dev/null +++ b/src/lib/logger.ml @@ -0,0 +1,29 @@ +(** Logs. + + The logger is an object that can be used to emit logs. + + See + {{:https://opentelemetry.io/docs/reference/specification/overview/#log-signal} + the spec} *) + +open Opentelemetry_emitter + +type t = { + emit: Log_record.t Emitter.t; + clock: Clock.t; +} + +(** Dummy logger, always disabled *) +let dummy : t = { emit = Emitter.dummy; clock = Clock.ptime_clock } + +let[@inline] enabled (self : t) : bool = Emitter.enabled self.emit + +let[@inline] emit1 (self : t) (l : Log_record.t) = Emitter.emit self.emit [ l ] + +let of_exporter (exp : Exporter.t) : t = + let emit = + Emitter.make ~signal_name:"logs" + ~emit:(fun logs -> exp.Exporter.export (Any_signal_l.Logs logs)) + () + in + { emit; clock = Clock.Main.get () } diff --git a/src/lib/meter.ml b/src/lib/meter.ml new file mode 100644 index 000000000..961e40f4c --- /dev/null +++ b/src/lib/meter.ml @@ -0,0 +1,52 @@ +open Opentelemetry_emitter + +type t = { + emit: Metrics.t Emitter.t; + clock: Clock.t; +} + +(** Dummy meter, always disabled *) +let dummy : t = { emit = Emitter.dummy; clock = Clock.ptime_clock } + +let[@inline] enabled (self : t) = Emitter.enabled self.emit + +let[@inline] emit self ms : unit = Emitter.emit self.emit ms + +let[@inline] emit1 (self : t) (m : Metrics.t) : unit = + Emitter.emit self.emit [ m ] + +let of_exporter (exp : Exporter.t) : t = + let emit = + Emitter.make ~signal_name:"metrics" + ~emit:(fun ms -> exp.Exporter.export (Any_signal_l.Metrics ms)) + () + in + { emit; clock = Clock.Main.get () } + +(** Global list of raw metric callbacks, collected alongside {!Instrument.all}. +*) +let cbs_ : (clock:Clock.t -> unit -> Metrics.t list) Alist.t = Alist.make () + +let add_cb (f : clock:Clock.t -> unit -> Metrics.t list) : unit = + Alist.add cbs_ f + +let collect (self : t) : Metrics.t list = + let clock = self.clock in + let acc = ref [] in + Instrument.Internal.iter_all (fun f -> + acc := List.rev_append (f ~clock ()) !acc); + List.iter + (fun f -> acc := List.rev_append (f ~clock ()) !acc) + (Alist.get cbs_); + List.rev !acc + +module Instrument = Instrument + +module type INSTRUMENT_IMPL = Instrument.CUSTOM_IMPL + +module Make_instrument = Instrument.Make +module Int_counter = Instrument.Int_counter +module Float_counter = Instrument.Float_counter +module Int_gauge = Instrument.Int_gauge +module Float_gauge = Instrument.Float_gauge +module Histogram = Instrument.Histogram diff --git a/src/lib/meter.mli b/src/lib/meter.mli new file mode 100644 index 000000000..c76a59345 --- /dev/null +++ b/src/lib/meter.mli @@ -0,0 +1,52 @@ +(** Builder for instruments and periodic metric emission. + + https://opentelemetry.io/docs/specs/otel/metrics/api/#get-a-meter + + Instruments ({!Int_counter}, {!Histogram}, …) register themselves into a + global list ({!Instrument.all}) on creation and do not require a meter. A + {!t} is only needed to wire up periodic collection and emission: call + {!add_to_exporter} or {!add_to_main_exporter} once after creating your + instruments. *) + +type t = { + emit: Metrics.t Opentelemetry_emitter.Emitter.t; + clock: Clock.t; +} + +val dummy : t +(** Dummy meter, always disabled *) + +val enabled : t -> bool + +val of_exporter : Exporter.t -> t +(** Create a meter from an exporter *) + +val emit : t -> Metrics.t list -> unit +(** Emit metrics directly, bypassing the instrument registry *) + +val emit1 : t -> Metrics.t -> unit +(** Emit a single metric directly, bypassing the instrument registry *) + +val add_cb : (clock:Clock.t -> unit -> Metrics.t list) -> unit +(** Register a raw global metrics callback. Called alongside all instruments + when {!collect} runs. Use this for ad-hoc metrics that don't fit the + structured instrument API. *) + +val collect : t -> Metrics.t list +(** Collect metrics from all registered instruments ({!Instrument.all}) and raw + callbacks ({!add_cb}), using this meter's clock. *) + +module Instrument = Instrument +(** Global registry of metric instruments. Re-exported from + {!Opentelemetry_core.Instrument} for convenience. *) + +(** Convenience aliases for the instrument submodules in {!Instrument}. *) + +module type INSTRUMENT_IMPL = Instrument.CUSTOM_IMPL + +module Make_instrument = Instrument.Make +module Int_counter = Instrument.Int_counter +module Float_counter = Instrument.Float_counter +module Int_gauge = Instrument.Int_gauge +module Float_gauge = Instrument.Float_gauge +module Histogram = Instrument.Histogram diff --git a/src/lib/meter_provider.ml b/src/lib/meter_provider.ml new file mode 100644 index 000000000..55d2f96bf --- /dev/null +++ b/src/lib/meter_provider.ml @@ -0,0 +1,85 @@ +open Opentelemetry_emitter + +open struct + let provider_ : Meter.t Atomic.t = Atomic.make Meter.dummy +end + +let get () : Meter.t = Atomic.get provider_ + +let set (t : Meter.t) : unit = + Self_debug.log Info (fun () -> "otel: meter provider installed"); + Atomic.set provider_ t + +let clear () : unit = + Self_debug.log Info (fun () -> "otel: meter provider removed"); + Atomic.set provider_ Meter.dummy + +(** Get a meter pre-configured with a fixed set of attributes added to every + metric it emits, forwarding to the current global meter. Intended to be + called once at the top of a library module. + + @param name instrumentation scope name (recorded as [otel.scope.name]) + @param version + instrumentation scope version (recorded as [otel.scope.version]) + @param __MODULE__ + the OCaml module name, typically the [__MODULE__] literal (recorded as + [code.namespace]) + @param attrs additional fixed attributes *) +let get_meter ?name ?version ?(attrs : (string * [< Value.t ]) list = []) + ?__MODULE__ () : Meter.t = + let extra = + Scope_attributes.make_attrs ?name ?version ~attrs ?__MODULE__ () + in + { + Meter.emit = + Emitter.make ~signal_name:"metrics" + ~enabled:(fun () -> Emitter.enabled (Atomic.get provider_).emit) + ~emit:(fun metrics -> + (match extra with + | [] -> () + | _ -> List.iter (fun m -> Metrics.add_attrs m extra) metrics); + Emitter.emit (Atomic.get provider_).emit metrics) + (); + clock = { Clock.now = (fun () -> Clock.now (Clock.Main.get ())) }; + } + +(** Emit with current meter *) +let[@inline] emit (m : Metrics.t) : unit = Emitter.emit (get ()).emit [ m ] + +(** Emit a list of metrics with current meter *) +let[@inline] emit_l (ms : Metrics.t list) : unit = Emitter.emit (get ()).emit ms + +(** A Meter.t that lazily reads the global at emit time *) +let default_meter : Meter.t = get_meter () + +let minimum_min_interval_ = Mtime.Span.(100 * ms) + +let default_min_interval_ = Mtime.Span.(4 * s) + +let clamp_interval_ interval = + if Mtime.Span.compare interval minimum_min_interval_ < 0 then + minimum_min_interval_ + else + interval + +let add_to_exporter ?(min_interval = default_min_interval_) (_exp : Exporter.t) + (self : Meter.t) : unit = + let limiter = + Interval_limiter.create ~min_interval:(clamp_interval_ min_interval) () + in + Globals.add_on_tick_callback (fun () -> + if Interval_limiter.make_attempt limiter then ( + let metrics = Meter.collect self in + if metrics <> [] then Emitter.emit self.emit metrics + )) + +let add_to_main_exporter ?(min_interval = default_min_interval_) + (self : Meter.t) : unit = + let limiter = + Interval_limiter.create ~min_interval:(clamp_interval_ min_interval) () + in + Globals.add_on_tick_callback (fun () -> + if Interval_limiter.make_attempt limiter then ( + let metrics = Meter.collect self in + if metrics <> [] then Emitter.emit self.emit metrics + )) diff --git a/src/lib/opentelemetry.ml b/src/lib/opentelemetry.ml new file mode 100644 index 000000000..600071265 --- /dev/null +++ b/src/lib/opentelemetry.ml @@ -0,0 +1,177 @@ +(** Main Opentelemetry API for libraries and user code. *) + +module Core = Opentelemetry_core +(** Core types and definitions *) + +module Interval_limiter = Interval_limiter +(** Utility to limit the frequency of some event + @since 0.90 *) + +(** {2 Wire format} *) + +module Proto = Opentelemetry_proto +(** Protobuf types. + + This is mostly useful internally. Users should not need to touch it. *) + +(** {2 Time} *) + +module Clock = Clock +module Timestamp_ns = Timestamp_ns + +(** {2 Export signals to some external collector.} *) + +module Emitter = Opentelemetry_emitter.Emitter + +module Exporter = struct + include Exporter + + (** Get a tracer from this exporter. + @since 0.90 *) + let get_tracer (self : t) : Tracer.t = Tracer.of_exporter self + + (** Get a meter from this exporter. + @since 0.90 *) + let get_meter (self : t) : Meter.t = Meter.of_exporter self + + (** Get a logger from this exporter. + @since 0.90 *) + let get_logger (self : t) : Logger.t = Logger.of_exporter self +end + +module Sdk = struct + include Sdk + + (** Get a tracer forwarding to the current main exporter. + @since 0.90 *) + let get_tracer ?name ?version ?attrs ?__MODULE__ () = + Trace_provider.get_tracer ?name ?version ?attrs ?__MODULE__ () + + (** Get a meter forwarding to the current main exporter. + @since 0.90 *) + let get_meter ?name ?version ?attrs ?__MODULE__ () = + Meter_provider.get_meter ?name ?version ?attrs ?__MODULE__ () + + (** Get a logger forwarding to the current main exporter. + @since 0.90 *) + let get_logger ?name ?version ?attrs ?__MODULE__ () = + Log_provider.get_logger ?name ?version ?attrs ?__MODULE__ () + + let self_debug_to_stderr = Sdk.self_debug_to_stderr +end + +module Main_exporter = Sdk [@@deprecated "use Sdk instead"] + +module Collector = struct + include Exporter + include Sdk +end +[@@deprecated "Use 'Exporter' instead"] + +module Provider_config = Provider_config +module Self_debug = Self_debug +module Dynamic_enricher = Dynamic_enricher +module Trace_provider = Trace_provider +module Meter_provider = Meter_provider +module Log_provider = Log_provider + +(** {2 Identifiers} *) + +module Trace_id = Trace_id + +let k_trace_id = Trace_id.k_trace_id + +module Span_id = Span_id +module Span_ctx = Span_ctx + +let k_ambient = Span_ctx.k_ambient + +(** {2 Attributes and conventions} *) + +module Conventions = Conventions +module Value = Value +module Key_value = Key_value + +type value = Value.t +(** A value in a key/value attribute *) + +type key_value = Key_value.t + +(** {2 Global settings} *) + +module Globals = Globals +module Version = Version + +(** {2 Traces and Spans} *) + +module Event = Event +module Span_link = Span_link +module Span_status = Span_status +module Span_kind = Span_kind + +(** {2 Traces} *) + +module Span = Span +module Ambient_span = Ambient_span + +module Tracer = struct + include Tracer + + let default = Trace_provider.default_tracer + + let with_thunk_and_finally = Trace_provider.with_thunk_and_finally + + let with_ = Trace_provider.with_ +end + +module Trace = Tracer [@@deprecated "use Tracer instead"] + +(** {2 Metrics} *) + +module Metrics = Metrics +module Instrument = Instrument + +module Meter = struct + include Meter + + let default = Meter_provider.default_meter + + let add_to_exporter = Meter_provider.add_to_exporter + + let add_to_main_exporter = Meter_provider.add_to_main_exporter +end + +(** {2 Logs} *) + +module Log_record = Log_record + +module Logger = struct + include Logger + + let default = Log_provider.default_logger + + let log = Log_provider.log + + let logf = Log_provider.logf +end + +module Logs = Logger [@@deprecated "use Logger"] + +(** {2 Utils} *) + +module Any_signal = Any_signal +module Any_signal_l = Any_signal_l +module Trace_context = Trace_context +module Gc_metrics = Gc_metrics + +module Aswitch = Aswitch +(** @since 0.90 *) + +module Alist = Alist +(** Atomic list, for internal usage + @since 0.7 *) + +(* *) + +module GC_metrics = Gc_metrics +[@@deprecated "use Gc_metrics (beware capitalization)"] diff --git a/src/lib/provider_config.ml b/src/lib/provider_config.ml new file mode 100644 index 000000000..b9e2278ff --- /dev/null +++ b/src/lib/provider_config.ml @@ -0,0 +1,11 @@ +(** Per-provider batching configuration. *) + +type t = { + batch: int option; + timeout: Mtime.Span.t; +} + +let make ?(batch : int option) ?(timeout = Mtime.Span.(2_000 * ms)) () : t = + { batch; timeout } + +let default : t = make () diff --git a/src/lib/provider_config.mli b/src/lib/provider_config.mli new file mode 100644 index 000000000..f9f391011 --- /dev/null +++ b/src/lib/provider_config.mli @@ -0,0 +1,16 @@ +(** Per-provider batching configuration. *) + +type t = { + batch: int option; + (** Batch size (number of items). [None] means unbatched (immediate emit). + *) + timeout: Mtime.Span.t; (** Timeout between automatic batch flushes. *) +} + +val make : ?batch:int -> ?timeout:Mtime.Span.t -> unit -> t +(** Create a provider config. + @param batch batch size. [None] (the default) means no batching. + @param timeout flush timeout. Default: [2000ms] *) + +val default : t +(** Default provider config: no batching, [2s] timeout. *) diff --git a/src/lib/scope_attributes.ml b/src/lib/scope_attributes.ml new file mode 100644 index 000000000..0db02f075 --- /dev/null +++ b/src/lib/scope_attributes.ml @@ -0,0 +1,27 @@ +(** Helper for building instrumentation scope attributes. + + Used internally by {!Tracer.get}, {!Meter.get}, {!Logger.get}. *) + +(** Build a list of fixed key-value attributes from instrumentation scope + parameters. These attributes will be injected into every signal emitted by a + tracer/meter/logger obtained via the corresponding [get] function. + + @param name instrumentation scope name (recorded as [otel.scope.name]) + @param version + instrumentation scope version (recorded as [otel.scope.version]) + @param __MODULE__ + the OCaml module name, typically the [__MODULE__] literal (recorded as + [code.namespace]) + @param attrs additional fixed attributes *) +let make_attrs ?name ?version ?(attrs : (string * [< Value.t ]) list = []) + ?__MODULE__ () : Key_value.t list = + let maybe_cons opt k l = + match opt with + | None -> l + | Some v -> (k, (`String v : Value.t)) :: l + in + let l = (attrs :> Key_value.t list) in + let l = maybe_cons __MODULE__ Conventions.Attributes.Code.namespace l in + let l = maybe_cons version "otel.scope.version" l in + let l = maybe_cons name "otel.scope.name" l in + l diff --git a/src/lib/sdk.ml b/src/lib/sdk.ml new file mode 100644 index 000000000..485c48c45 --- /dev/null +++ b/src/lib/sdk.ml @@ -0,0 +1,130 @@ +(** SDK setup. + + Convenience module for installing a single {!Exporter.t} as the global + backend, wiring it into {!Trace_provider}, {!Meter_provider}, and + {!Log_provider} at once. Optionally applies per-signal batching. *) + +open Opentelemetry_emitter + +open struct + let exporter : Exporter.t option Atomic.t = Atomic.make None +end + +let self_debug_to_stderr = Self_debug.to_stderr + +(** Remove current exporter, if any. + @param on_done called once the exporter has fully shut down (queue drained). +*) +let remove ~on_done () : unit = + Self_debug.log Info (fun () -> "opentelemetry: SDK removed"); + (* flush+close provider emitters so buffered signals reach the queue *) + Emitter.flush_and_close (Trace_provider.get ()).emit; + Emitter.flush_and_close (Meter_provider.get ()).emit; + Emitter.flush_and_close (Log_provider.get ()).emit; + + (* clear providers — no new signals accepted *) + Trace_provider.clear (); + Meter_provider.clear (); + Log_provider.clear (); + match Atomic.exchange exporter None with + | None -> on_done () + | Some exp -> + (* wait for exporter to fully drain, then call on_done *) + Aswitch.on_turn_off (Exporter.active exp) on_done; + (* initiate shutdown (closes queue, starts consumer drain) *) + Exporter.shutdown exp + +let[@inline] present () : bool = Option.is_some (Atomic.get exporter) + +let[@inline] get () : Exporter.t option = Atomic.get exporter + +(** Aswitch of the installed exporter, or {!Aswitch.dummy} if none. *) +let[@inline] active () : Aswitch.t = + match Atomic.get exporter with + | None -> Aswitch.dummy + | Some exp -> Exporter.active exp + +let add_on_tick_callback : (unit -> unit) -> unit = Globals.add_on_tick_callback + +let run_tick_callbacks : unit -> unit = Globals.run_tick_callbacks + +(** Tick all providers and run all registered callbacks. Call this periodically + (e.g. every 500ms) to drive metrics collection, GC metrics, and batch + timeout flushing. This is the single function client libraries should call + from their ticker. *) +let tick : unit -> unit = Globals.run_tick_callbacks + +let set ?(traces = Provider_config.make ~batch:400 ()) + ?(metrics = Provider_config.make ~batch:200 ()) + ?(logs = Provider_config.make ~batch:400 ()) (exp : Exporter.t) : unit = + Self_debug.log Info (fun () -> "opentelemetry: SDK set up"); + Atomic.set exporter (Some exp); + let tracer : Tracer.t = + let t = Tracer.of_exporter exp in + { + t with + emit = + Emitter_batch.add_batching_opt ~timeout:traces.Provider_config.timeout + ~batch_size:traces.Provider_config.batch t.emit; + } + in + let meter : Meter.t = + let m = Meter.of_exporter exp in + { + m with + emit = + Emitter_batch.add_batching_opt ~timeout:metrics.Provider_config.timeout + ~batch_size:metrics.Provider_config.batch m.emit; + } + in + let logger : Logger.t = + let l = Logger.of_exporter exp in + { + l with + emit = + Emitter_batch.add_batching_opt ~timeout:logs.Provider_config.timeout + ~batch_size:logs.Provider_config.batch l.emit; + } + in + Trace_provider.set tracer; + Meter_provider.set meter; + Log_provider.set logger + +let self_metrics () : Metrics.t list = + let now = Clock.now_main () in + let emitter_metrics = + Emitter.self_metrics (Trace_provider.get ()).emit ~now + @ Emitter.self_metrics (Meter_provider.get ()).emit ~now + @ Emitter.self_metrics (Log_provider.get ()).emit ~now + in + match get () with + | None -> emitter_metrics + | Some exp -> exp.Exporter.self_metrics () @ emitter_metrics + +open struct + let self_metrics_enabled = Atomic.make false +end + +(** Regularly emit metrics about the OTEL SDK. Idempotent. *) +let setup_self_metrics () = + if not (Atomic.exchange self_metrics_enabled true) then ( + Self_debug.log Info (fun () -> "enabling self metrics"); + let interval_limiter = + Interval_limiter.create ~min_interval:Mtime.Span.(10 * s) () + in + let on_tick () = + if Interval_limiter.make_attempt interval_limiter then ( + let ms = self_metrics () in + Meter_provider.emit_l ms + ) + in + Globals.add_on_tick_callback on_tick + ) + +(* Permanent tick callback to drive batch timeouts on provider emitters *) +let () = + Globals.add_on_tick_callback (fun () -> + let mtime = Mtime_clock.now () in + Emitter.tick (Trace_provider.get ()).emit ~mtime; + Emitter.tick (Meter_provider.get ()).emit ~mtime; + Emitter.tick (Log_provider.get ()).emit ~mtime) diff --git a/src/lib/self_debug.ml b/src/lib/self_debug.ml new file mode 100644 index 000000000..c47e82473 --- /dev/null +++ b/src/lib/self_debug.ml @@ -0,0 +1,36 @@ +type level = + | Debug + | Info + | Warning + | Error + +type logger = level -> (unit -> string) -> unit + +let logger : logger ref = ref (fun _ _ -> ()) + +let[@inline] log level f = !logger level f + +let string_of_level = function + | Debug -> "debug" + | Info -> "info" + | Warning -> "warning" + | Error -> "error" + +open struct + let[@inline] int_of_level_ = function + | Debug -> 0 + | Info -> 1 + | Warning -> 2 + | Error -> 3 +end + +let level_above ~min_level level : bool = + int_of_level_ level >= int_of_level_ min_level + +let to_stderr ?(min_level = Warning) () : unit = + logger := + fun level mk_msg -> + if level_above ~min_level level then ( + let msg = mk_msg () in + Printf.eprintf "[otel:%s] %s\n%!" (string_of_level level) msg + ) diff --git a/src/lib/self_debug.mli b/src/lib/self_debug.mli new file mode 100644 index 000000000..f084d2570 --- /dev/null +++ b/src/lib/self_debug.mli @@ -0,0 +1,41 @@ +(** Emergency diagnostic logger for the OpenTelemetry SDK itself. + + Bypasses the OTEL pipeline entirely. Defaults to silently discarding all + messages. Use {!to_stderr} or set {!logger} to enable output. + + Usage: + {[ + Self_debug.log Info (fun () -> Printf.sprintf "batch flushed %d items" n) + ]}. + + @since 0.90 *) + +type level = + | Debug + | Info + | Warning + | Error + +type logger = level -> (unit -> string) -> unit +(** A logger, takes a level and a (lazy) message, and maybe emit the message *) + +val logger : logger ref +(** The current log sink. Replace to redirect output. Default: no-op. *) + +val string_of_level : level -> string +(** String representation of a level. *) + +val level_above : min_level:level -> level -> bool +(** [level_above ~min_level lvl] is true if messages at level [lvl] should be + logged. + @since NEXT_RELEASE *) + +val log : level -> (unit -> string) -> unit +(** [log level mk_msg] emits a diagnostic message if the current logger is + active. [mk_msg] is called lazily — only if the message will be emitted. *) + +val to_stderr : ?min_level:level -> unit -> unit +(** Install a stderr logger. Messages below [min_level] (default: [Warning]) are + suppressed. This is useful to help debug problems with this library itself + (e.g. when nothing is emitted but the user expects something to be emitted) +*) diff --git a/src/lib/trace_provider.ml b/src/lib/trace_provider.ml new file mode 100644 index 000000000..0b3c087e4 --- /dev/null +++ b/src/lib/trace_provider.ml @@ -0,0 +1,134 @@ +open Proto.Trace +open Opentelemetry_emitter + +open struct + let provider_ : Tracer.t Atomic.t = Atomic.make Tracer.dummy +end + +(** Get current tracer. *) +let get () : Tracer.t = Atomic.get provider_ + +(** Set current tracer *) +let set (t : Tracer.t) : unit = + Self_debug.log Info (fun () -> "otel: trace provider installed"); + Atomic.set provider_ t + +(** Replace current tracer by the dummy one. All spans will be discarded from + now on. *) +let clear () : unit = + Self_debug.log Info (fun () -> "otel: trace provider removed"); + Atomic.set provider_ Tracer.dummy + +(** Get a tracer pre-configured with a fixed set of attributes added to every + span it emits, forwarding to the current global tracer. Intended to be + called once at the top of a library module. + + @param name instrumentation scope name (recorded as [otel.scope.name]) + @param version + instrumentation scope version (recorded as [otel.scope.version]) + @param __MODULE__ + the OCaml module name, typically the [__MODULE__] literal (recorded as + [code.namespace]) + @param attrs additional fixed attributes *) +let get_tracer ?name ?version ?(attrs : (string * [< Value.t ]) list = []) + ?__MODULE__ () : Tracer.t = + let extra = + Scope_attributes.make_attrs ?name ?version ~attrs ?__MODULE__ () + in + { + Tracer.emit = + Emitter.make ~signal_name:"spans" + ~enabled:(fun () -> Emitter.enabled (Atomic.get provider_).emit) + ~emit:(fun spans -> + (match extra with + | [] -> () + | _ -> List.iter (fun span -> Span.add_attrs span extra) spans); + Emitter.emit (Atomic.get provider_).emit spans) + (); + clock = { Clock.now = (fun () -> Clock.now (Clock.Main.get ())) }; + } + +(** A Tracer.t that lazily reads the global at emit time *) +let default_tracer : Tracer.t = get_tracer () + +(** Emit a span directly via the current global tracer *) +let[@inline] emit (span : Span.t) : unit = Emitter.emit (get ()).emit [ span ] + +(** Helper to implement {!with_} and similar functions *) +let with_thunk_and_finally (self : Tracer.t) ?(force_new_trace_id = false) + ?trace_state ?(attrs : (string * [< Value.t ]) list = []) ?kind ?trace_id + ?parent ?links name cb = + let parent = + match parent with + | Some _ -> parent + | None -> Ambient_span.get () + in + let trace_id = + match trace_id, parent with + | _ when force_new_trace_id -> Trace_id.create () + | Some trace_id, _ -> trace_id + | None, Some p -> Span.trace_id p + | None, None -> Trace_id.create () + in + let start_time = Clock.now self.clock in + let span_id = Span_id.create () in + + let parent_id = Option.map Span.id parent in + + let span : Span.t = + Span.make ?trace_state ?kind ?parent:parent_id ~trace_id ~id:span_id ~attrs + ?links ~start_time ~end_time:start_time name + in + let () = + match Dynamic_enricher.collect () with + | [] -> () + | dyn_attrs -> Span.add_attrs span dyn_attrs + in + (* called once we're done, to emit a span *) + let finally res = + let end_time = Clock.now self.clock in + span_set_end_time_unix_nano span end_time; + + (match Span.status span with + | Some _ -> () + | None -> + (match res with + | Ok () -> () + | Error (e, bt) -> Span.record_exception span e bt)); + + Emitter.emit self.emit [ span ] + in + let thunk () = Ambient_span.with_ambient span (fun () -> cb span) in + thunk, finally + +(** Sync span guard. + + Notably, this includes {e implicit} scope-tracking: if called without a + [~scope] argument (or [~parent]/[~trace_id]), it will check in the + {!Ambient_context} for a surrounding environment, and use that as the scope. + Similarly, it uses {!Scope.with_ambient_scope} to {e set} a new scope in the + ambient context, so that any logically-nested calls to {!with_} will use + this span as their parent. + + {b NOTE} be careful not to call this inside a Gc alarm, as it can cause + deadlocks. + + @param tracer the tracer to use (default [default_tracer]) + @param force_new_trace_id + if true (default false), the span will not use a ambient scope, the + [~scope] argument, nor [~trace_id], but will instead always create fresh + identifiers for this span *) +let with_ ?(tracer = default_tracer) ?force_new_trace_id ?trace_state ?attrs + ?kind ?trace_id ?parent ?links name (cb : Span.t -> 'a) : 'a = + let thunk, finally = + with_thunk_and_finally tracer ?force_new_trace_id ?trace_state ?attrs ?kind + ?trace_id ?parent ?links name cb + in + try + let rv = thunk () in + finally (Ok ()); + rv + with e -> + let bt = Printexc.get_raw_backtrace () in + finally (Error (e, bt)); + raise e diff --git a/src/lib/tracer.ml b/src/lib/tracer.ml new file mode 100644 index 000000000..91d0a76e9 --- /dev/null +++ b/src/lib/tracer.ml @@ -0,0 +1,32 @@ +(** Traces. + + The tracer is an object that can be used to emit spans that form a trace. + + See + {{:https://opentelemetry.io/docs/reference/specification/overview/#tracing-signal} + the spec} *) + +open Opentelemetry_emitter + +type span = Span.t + +type t = { + emit: Span.t Emitter.t; + clock: Clock.t; +} +(** A tracer. + + https://opentelemetry.io/docs/specs/otel/trace/api/#tracer *) + +(** Dummy tracer, always disabled *) +let dummy : t = { emit = Emitter.dummy; clock = Clock.ptime_clock } + +let[@inline] enabled (self : t) = Emitter.enabled self.emit + +let of_exporter (exp : Exporter.t) : t = + let emit = + Emitter.make ~signal_name:"spans" + ~emit:(fun spans -> exp.Exporter.export (Any_signal_l.Spans spans)) + () + in + { emit; clock = Clock.Main.get () } diff --git a/src/lib/version.ml b/src/lib/version.ml new file mode 100644 index 000000000..9349a8db8 --- /dev/null +++ b/src/lib/version.ml @@ -0,0 +1 @@ +let version = "%%VERSION%%" diff --git a/src/lib/version.mli b/src/lib/version.mli new file mode 100644 index 000000000..658a9af34 --- /dev/null +++ b/src/lib/version.mli @@ -0,0 +1,3 @@ +val version : string +(** Version of the library, e.g. ["0.12"]. ["dev"] if not built from a release. +*) diff --git a/src/lwt/dune b/src/lwt/dune index 24fbdf225..d1c985dbd 100644 --- a/src/lwt/dune +++ b/src/lwt/dune @@ -2,6 +2,7 @@ (name opentelemetry_lwt) (public_name opentelemetry-lwt) (synopsis "Lwt frontend for opentelemetry") - (preprocess - (pps lwt_ppx)) - (libraries lwt opentelemetry)) + (libraries + (re_export lwt) + ambient-context-lwt + (re_export opentelemetry))) diff --git a/src/lwt/opentelemetry_lwt.ml b/src/lwt/opentelemetry_lwt.ml index 7b443c20c..b09d769fc 100644 --- a/src/lwt/opentelemetry_lwt.ml +++ b/src/lwt/opentelemetry_lwt.ml @@ -1,47 +1,61 @@ -open Opentelemetry -open Lwt.Syntax -module Span_id = Span_id -module Trace_id = Trace_id -module Event = Event -module Span = Span -module Span_link = Span_link -module Globals = Globals -module Timestamp_ns = Timestamp_ns -module GC_metrics = GC_metrics -module Metrics_callbacks = Metrics_callbacks -module Trace_context = Trace_context +include Opentelemetry + +(** Setup Lwt as the ambient context *) +let setup_ambient_context () = + Opentelemetry_ambient_context.set_current_storage Ambient_context_lwt.storage + +module Sdk = struct + include Sdk + + let remove () : unit Lwt.t = + let p, resolve = Lwt.wait () in + remove () ~on_done:(fun () -> Lwt.wakeup_later resolve ()); + p +end external reraise : exn -> 'a = "%reraise" (** This is equivalent to [Lwt.reraise]. We inline it here so we don't force to use Lwt's latest version *) -module Trace = struct - include Trace +module Tracer = struct + include Tracer (** Sync span guard *) - let with_ ?force_new_trace_id ?trace_state ?service_name ?attrs ?kind - ?trace_id ?parent ?scope ?links name (cb : Scope.t -> 'a Lwt.t) : 'a Lwt.t - = + let with_ (type a) ?(tracer = default) ?force_new_trace_id ?trace_state ?attrs + ?kind ?trace_id ?parent ?links name (cb : Span.t -> a Lwt.t) : a Lwt.t = + let open Lwt.Syntax in let thunk, finally = - with_' ?force_new_trace_id ?trace_state ?service_name ?attrs ?kind - ?trace_id ?parent ?scope ?links name cb + with_thunk_and_finally tracer ?force_new_trace_id ?trace_state ?attrs + ?kind ?trace_id ?parent ?links name cb in - try%lwt - let* rv = thunk () in - let () = finally (Ok ()) in - Lwt.return rv - with e -> - let bt = Printexc.get_raw_backtrace () in - let () = finally (Error (e, bt)) in - reraise e + let* r = + Lwt.catch + (fun () -> + let+ res = thunk () in + Ok res) + (fun exn -> + let bt = Printexc.get_raw_backtrace () in + Lwt.return (Error (exn, bt))) + in + + match r with + | Ok r -> + finally (Ok ()); + Lwt.return r + | Error (exn, bt) -> + finally (Error (exn, bt)); + Lwt.fail exn end +module Trace = Tracer [@@deprecated "use Tracer"] + module Metrics = struct include Metrics end module Logs = struct include Proto.Logs - include Logs + include Log_record + include Logger end diff --git a/src/proto/common.ml b/src/proto/common.ml index b0faafa53..99d0ebaa6 100644 --- a/src/proto/common.ml +++ b/src/proto/common.ml @@ -1,4 +1,4 @@ -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39-44"] type any_value = | String_value of string @@ -10,136 +10,194 @@ type any_value = | Bytes_value of bytes and array_value = { - values : any_value list; -} - -and key_value_list = { - values : key_value list; -} - -and key_value = { - key : string; - value : any_value option; -} - -type instrumentation_scope = { - name : string; - version : string; - attributes : key_value list; - dropped_attributes_count : int32; -} - -let rec default_any_value () : any_value = String_value ("") - -and default_array_value - ?values:((values:any_value list) = []) - () : array_value = { - values; -} - -and default_key_value_list - ?values:((values:key_value list) = []) - () : key_value_list = { - values; -} - -and default_key_value - ?key:((key:string) = "") - ?value:((value:any_value option) = None) - () : key_value = { - key; - value; -} - -let rec default_instrumentation_scope - ?name:((name:string) = "") - ?version:((version:string) = "") - ?attributes:((attributes:key_value list) = []) - ?dropped_attributes_count:((dropped_attributes_count:int32) = 0l) - () : instrumentation_scope = { - name; - version; - attributes; - dropped_attributes_count; -} - -type array_value_mutable = { mutable values : any_value list; } -let default_array_value_mutable () : array_value_mutable = { - values = []; -} - -type key_value_list_mutable = { +and key_value_list = { mutable values : key_value list; } -let default_key_value_list_mutable () : key_value_list_mutable = { - values = []; -} - -type key_value_mutable = { +and key_value = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) mutable key : string; mutable value : any_value option; } -let default_key_value_mutable () : key_value_mutable = { - key = ""; - value = None; -} - -type instrumentation_scope_mutable = { +type instrumentation_scope = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 3 fields *) mutable name : string; mutable version : string; mutable attributes : key_value list; mutable dropped_attributes_count : int32; } -let default_instrumentation_scope_mutable () : instrumentation_scope_mutable = { - name = ""; - version = ""; - attributes = []; - dropped_attributes_count = 0l; +type entity_ref = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 2 fields *) + mutable schema_url : string; + mutable type_ : string; + mutable id_keys : string list; + mutable description_keys : string list; } +let default_any_value (): any_value = String_value ("") -(** {2 Make functions} *) - +let default_array_value (): array_value = +{ + values=[]; +} -let rec make_array_value - ~(values:any_value list) - () : array_value = { - values; +let default_key_value_list (): key_value_list = +{ + values=[]; } -and make_key_value_list - ~(values:key_value list) - () : key_value_list = { - values; +let default_key_value (): key_value = +{ + _presence=Pbrt.Bitfield.empty; + key=""; + value=None; } -and make_key_value - ~(key:string) - ?value:((value:any_value option) = None) - () : key_value = { - key; - value; +let default_instrumentation_scope (): instrumentation_scope = +{ + _presence=Pbrt.Bitfield.empty; + name=""; + version=""; + attributes=[]; + dropped_attributes_count=0l; } -let rec make_instrumentation_scope - ~(name:string) - ~(version:string) - ~(attributes:key_value list) - ~(dropped_attributes_count:int32) - () : instrumentation_scope = { - name; - version; - attributes; - dropped_attributes_count; +let default_entity_ref (): entity_ref = +{ + _presence=Pbrt.Bitfield.empty; + schema_url=""; + type_=""; + id_keys=[]; + description_keys=[]; } -[@@@ocaml.warning "-27-30-39"] + +(** {2 Make functions} *) + + +let[@inline] array_value_set_values (self:array_value) (x:any_value list) : unit = + self.values <- x + +let copy_array_value (self:array_value) : array_value = + { self with values = self.values } + +let make_array_value + ?(values=[]) + () : array_value = + let _res = default_array_value () in + array_value_set_values _res values; + _res + + +let[@inline] key_value_list_set_values (self:key_value_list) (x:key_value list) : unit = + self.values <- x + +let copy_key_value_list (self:key_value_list) : key_value_list = + { self with values = self.values } + +let make_key_value_list + ?(values=[]) + () : key_value_list = + let _res = default_key_value_list () in + key_value_list_set_values _res values; + _res + +let[@inline] key_value_has_key (self:key_value) : bool = (Pbrt.Bitfield.get self._presence 0) + +let[@inline] key_value_set_key (self:key_value) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.key <- x +let[@inline] key_value_set_value (self:key_value) (x:any_value) : unit = + self.value <- Some x + +let copy_key_value (self:key_value) : key_value = + { self with key = self.key } + +let make_key_value + ?(key:string option) + ?(value:any_value option) + () : key_value = + let _res = default_key_value () in + (match key with + | None -> () + | Some v -> key_value_set_key _res v); + (match value with + | None -> () + | Some v -> key_value_set_value _res v); + _res + +let[@inline] instrumentation_scope_has_name (self:instrumentation_scope) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] instrumentation_scope_has_version (self:instrumentation_scope) : bool = (Pbrt.Bitfield.get self._presence 1) +let[@inline] instrumentation_scope_has_dropped_attributes_count (self:instrumentation_scope) : bool = (Pbrt.Bitfield.get self._presence 2) + +let[@inline] instrumentation_scope_set_name (self:instrumentation_scope) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.name <- x +let[@inline] instrumentation_scope_set_version (self:instrumentation_scope) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.version <- x +let[@inline] instrumentation_scope_set_attributes (self:instrumentation_scope) (x:key_value list) : unit = + self.attributes <- x +let[@inline] instrumentation_scope_set_dropped_attributes_count (self:instrumentation_scope) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 2); self.dropped_attributes_count <- x + +let copy_instrumentation_scope (self:instrumentation_scope) : instrumentation_scope = + { self with name = self.name } + +let make_instrumentation_scope + ?(name:string option) + ?(version:string option) + ?(attributes=[]) + ?(dropped_attributes_count:int32 option) + () : instrumentation_scope = + let _res = default_instrumentation_scope () in + (match name with + | None -> () + | Some v -> instrumentation_scope_set_name _res v); + (match version with + | None -> () + | Some v -> instrumentation_scope_set_version _res v); + instrumentation_scope_set_attributes _res attributes; + (match dropped_attributes_count with + | None -> () + | Some v -> instrumentation_scope_set_dropped_attributes_count _res v); + _res + +let[@inline] entity_ref_has_schema_url (self:entity_ref) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] entity_ref_has_type_ (self:entity_ref) : bool = (Pbrt.Bitfield.get self._presence 1) + +let[@inline] entity_ref_set_schema_url (self:entity_ref) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.schema_url <- x +let[@inline] entity_ref_set_type_ (self:entity_ref) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.type_ <- x +let[@inline] entity_ref_set_id_keys (self:entity_ref) (x:string list) : unit = + self.id_keys <- x +let[@inline] entity_ref_set_description_keys (self:entity_ref) (x:string list) : unit = + self.description_keys <- x + +let copy_entity_ref (self:entity_ref) : entity_ref = + { self with schema_url = self.schema_url } + +let make_entity_ref + ?(schema_url:string option) + ?(type_:string option) + ?(id_keys=[]) + ?(description_keys=[]) + () : entity_ref = + let _res = default_entity_ref () in + (match schema_url with + | None -> () + | Some v -> entity_ref_set_schema_url _res v); + (match type_ with + | None -> () + | Some v -> entity_ref_set_type_ _res v); + entity_ref_set_id_keys _res id_keys; + entity_ref_set_description_keys _res description_keys; + _res + +[@@@ocaml.warning "-23-27-30-39"] (** {2 Formatters} *) @@ -167,21 +225,30 @@ and pp_key_value_list fmt (v:key_value_list) = and pp_key_value fmt (v:key_value) = let pp_i fmt () = - Pbrt.Pp.pp_record_field ~first:true "key" Pbrt.Pp.pp_string fmt v.key; + Pbrt.Pp.pp_record_field ~absent:(not (key_value_has_key v)) ~first:true "key" Pbrt.Pp.pp_string fmt v.key; Pbrt.Pp.pp_record_field ~first:false "value" (Pbrt.Pp.pp_option pp_any_value) fmt v.value; in Pbrt.Pp.pp_brk pp_i fmt () let rec pp_instrumentation_scope fmt (v:instrumentation_scope) = let pp_i fmt () = - Pbrt.Pp.pp_record_field ~first:true "name" Pbrt.Pp.pp_string fmt v.name; - Pbrt.Pp.pp_record_field ~first:false "version" Pbrt.Pp.pp_string fmt v.version; + Pbrt.Pp.pp_record_field ~absent:(not (instrumentation_scope_has_name v)) ~first:true "name" Pbrt.Pp.pp_string fmt v.name; + Pbrt.Pp.pp_record_field ~absent:(not (instrumentation_scope_has_version v)) ~first:false "version" Pbrt.Pp.pp_string fmt v.version; Pbrt.Pp.pp_record_field ~first:false "attributes" (Pbrt.Pp.pp_list pp_key_value) fmt v.attributes; - Pbrt.Pp.pp_record_field ~first:false "dropped_attributes_count" Pbrt.Pp.pp_int32 fmt v.dropped_attributes_count; + Pbrt.Pp.pp_record_field ~absent:(not (instrumentation_scope_has_dropped_attributes_count v)) ~first:false "dropped_attributes_count" Pbrt.Pp.pp_int32 fmt v.dropped_attributes_count; in Pbrt.Pp.pp_brk pp_i fmt () -[@@@ocaml.warning "-27-30-39"] +let rec pp_entity_ref fmt (v:entity_ref) = + let pp_i fmt () = + Pbrt.Pp.pp_record_field ~absent:(not (entity_ref_has_schema_url v)) ~first:true "schema_url" Pbrt.Pp.pp_string fmt v.schema_url; + Pbrt.Pp.pp_record_field ~absent:(not (entity_ref_has_type_ v)) ~first:false "type_" Pbrt.Pp.pp_string fmt v.type_; + Pbrt.Pp.pp_record_field ~first:false "id_keys" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.id_keys; + Pbrt.Pp.pp_record_field ~first:false "description_keys" (Pbrt.Pp.pp_list Pbrt.Pp.pp_string) fmt v.description_keys; + in + Pbrt.Pp.pp_brk pp_i fmt () + +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Encoding} *) @@ -211,22 +278,24 @@ let rec encode_pb_any_value (v:any_value) encoder = end and encode_pb_array_value (v:array_value) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_any_value x encoder; Pbrt.Encoder.key 1 Pbrt.Bytes encoder; ) v.values encoder; () and encode_pb_key_value_list (v:key_value_list) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_key_value x encoder; Pbrt.Encoder.key 1 Pbrt.Bytes encoder; ) v.values encoder; () and encode_pb_key_value (v:key_value) encoder = - Pbrt.Encoder.string v.key encoder; - Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + if key_value_has_key v then ( + Pbrt.Encoder.string v.key encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ); begin match v.value with | Some x -> Pbrt.Encoder.nested encode_pb_any_value x encoder; @@ -236,19 +305,44 @@ and encode_pb_key_value (v:key_value) encoder = () let rec encode_pb_instrumentation_scope (v:instrumentation_scope) encoder = - Pbrt.Encoder.string v.name encoder; - Pbrt.Encoder.key 1 Pbrt.Bytes encoder; - Pbrt.Encoder.string v.version encoder; - Pbrt.Encoder.key 2 Pbrt.Bytes encoder; - Pbrt.List_util.rev_iter_with (fun x encoder -> + if instrumentation_scope_has_name v then ( + Pbrt.Encoder.string v.name encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ); + if instrumentation_scope_has_version v then ( + Pbrt.Encoder.string v.version encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + ); + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_key_value x encoder; Pbrt.Encoder.key 3 Pbrt.Bytes encoder; ) v.attributes encoder; - Pbrt.Encoder.int32_as_varint v.dropped_attributes_count encoder; - Pbrt.Encoder.key 4 Pbrt.Varint encoder; + if instrumentation_scope_has_dropped_attributes_count v then ( + Pbrt.Encoder.int32_as_varint v.dropped_attributes_count encoder; + Pbrt.Encoder.key 4 Pbrt.Varint encoder; + ); () -[@@@ocaml.warning "-27-30-39"] +let rec encode_pb_entity_ref (v:entity_ref) encoder = + if entity_ref_has_schema_url v then ( + Pbrt.Encoder.string v.schema_url encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ); + if entity_ref_has_type_ v then ( + Pbrt.Encoder.string v.type_ encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + ); + Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + ) v.id_keys encoder; + Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.Encoder.string x encoder; + Pbrt.Encoder.key 4 Pbrt.Bytes encoder; + ) v.description_keys encoder; + () + +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Decoding} *) @@ -273,100 +367,350 @@ let rec decode_pb_any_value d = loop () and decode_pb_array_value d = - let v = default_array_value_mutable () in + let v = default_array_value () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.values <- List.rev v.values; + (* put lists in the correct order *) + array_value_set_values v (List.rev v.values); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.values <- (decode_pb_any_value (Pbrt.Decoder.nested d)) :: v.values; + array_value_set_values v ((decode_pb_any_value (Pbrt.Decoder.nested d)) :: v.values); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(array_value), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "array_value" 1 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - values = v.values; - } : array_value) + (v : array_value) and decode_pb_key_value_list d = - let v = default_key_value_list_mutable () in + let v = default_key_value_list () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.values <- List.rev v.values; + (* put lists in the correct order *) + key_value_list_set_values v (List.rev v.values); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.values <- (decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.values; + key_value_list_set_values v ((decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.values); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(key_value_list), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "key_value_list" 1 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - values = v.values; - } : key_value_list) + (v : key_value_list) and decode_pb_key_value d = - let v = default_key_value_mutable () in + let v = default_key_value () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.key <- Pbrt.Decoder.string d; + key_value_set_key v (Pbrt.Decoder.string d); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(key_value), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "key_value" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.value <- Some (decode_pb_any_value (Pbrt.Decoder.nested d)); + key_value_set_value v (decode_pb_any_value (Pbrt.Decoder.nested d)); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(key_value), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "key_value" 2 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - key = v.key; - value = v.value; - } : key_value) + (v : key_value) let rec decode_pb_instrumentation_scope d = - let v = default_instrumentation_scope_mutable () in + let v = default_instrumentation_scope () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.attributes <- List.rev v.attributes; + (* put lists in the correct order *) + instrumentation_scope_set_attributes v (List.rev v.attributes); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.name <- Pbrt.Decoder.string d; + instrumentation_scope_set_name v (Pbrt.Decoder.string d); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(instrumentation_scope), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "instrumentation_scope" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.version <- Pbrt.Decoder.string d; + instrumentation_scope_set_version v (Pbrt.Decoder.string d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(instrumentation_scope), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "instrumentation_scope" 2 pk | Some (3, Pbrt.Bytes) -> begin - v.attributes <- (decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes; + instrumentation_scope_set_attributes v ((decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(instrumentation_scope), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "instrumentation_scope" 3 pk | Some (4, Pbrt.Varint) -> begin - v.dropped_attributes_count <- Pbrt.Decoder.int32_as_varint d; + instrumentation_scope_set_dropped_attributes_count v (Pbrt.Decoder.int32_as_varint d); + end + | Some (4, pk) -> + Pbrt.Decoder.unexpected_payload_message "instrumentation_scope" 4 pk + | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind + done; + (v : instrumentation_scope) + +let rec decode_pb_entity_ref d = + let v = default_entity_ref () in + let continue__= ref true in + while !continue__ do + match Pbrt.Decoder.key d with + | None -> ( + (* put lists in the correct order *) + entity_ref_set_description_keys v (List.rev v.description_keys); + entity_ref_set_id_keys v (List.rev v.id_keys); + ); continue__ := false + | Some (1, Pbrt.Bytes) -> begin + entity_ref_set_schema_url v (Pbrt.Decoder.string d); + end + | Some (1, pk) -> + Pbrt.Decoder.unexpected_payload_message "entity_ref" 1 pk + | Some (2, Pbrt.Bytes) -> begin + entity_ref_set_type_ v (Pbrt.Decoder.string d); + end + | Some (2, pk) -> + Pbrt.Decoder.unexpected_payload_message "entity_ref" 2 pk + | Some (3, Pbrt.Bytes) -> begin + entity_ref_set_id_keys v ((Pbrt.Decoder.string d) :: v.id_keys); + end + | Some (3, pk) -> + Pbrt.Decoder.unexpected_payload_message "entity_ref" 3 pk + | Some (4, Pbrt.Bytes) -> begin + entity_ref_set_description_keys v ((Pbrt.Decoder.string d) :: v.description_keys); end | Some (4, pk) -> - Pbrt.Decoder.unexpected_payload "Message(instrumentation_scope), field(4)" pk + Pbrt.Decoder.unexpected_payload_message "entity_ref" 4 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; + (v : entity_ref) + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 Protobuf YoJson Encoding} *) + +let rec encode_json_any_value (v:any_value) = + begin match v with + | String_value v -> `Assoc [("stringValue", Pbrt_yojson.make_string v)] + | Bool_value v -> `Assoc [("boolValue", Pbrt_yojson.make_bool v)] + | Int_value v -> `Assoc [("intValue", Pbrt_yojson.make_string (Int64.to_string v))] + | Double_value v -> `Assoc [("doubleValue", Pbrt_yojson.make_string (string_of_float v))] + | Array_value v -> `Assoc [("arrayValue", encode_json_array_value v)] + | Kvlist_value v -> `Assoc [("kvlistValue", encode_json_key_value_list v)] + | Bytes_value v -> `Assoc [("bytesValue", Pbrt_yojson.make_bytes v)] + end + +and encode_json_array_value (v:array_value) = + let assoc = ref [] in + assoc := ( + let l = v.values |> List.map encode_json_any_value in + ("values", `List l) :: !assoc + ); + `Assoc !assoc + +and encode_json_key_value_list (v:key_value_list) = + let assoc = ref [] in + assoc := ( + let l = v.values |> List.map encode_json_key_value in + ("values", `List l) :: !assoc + ); + `Assoc !assoc + +and encode_json_key_value (v:key_value) = + let assoc = ref [] in + if key_value_has_key v then ( + assoc := ("key", Pbrt_yojson.make_string v.key) :: !assoc; + ); + assoc := (match v.value with + | None -> !assoc + | Some v -> ("value", encode_json_any_value v) :: !assoc); + `Assoc !assoc + +let rec encode_json_instrumentation_scope (v:instrumentation_scope) = + let assoc = ref [] in + if instrumentation_scope_has_name v then ( + assoc := ("name", Pbrt_yojson.make_string v.name) :: !assoc; + ); + if instrumentation_scope_has_version v then ( + assoc := ("version", Pbrt_yojson.make_string v.version) :: !assoc; + ); + assoc := ( + let l = v.attributes |> List.map encode_json_key_value in + ("attributes", `List l) :: !assoc + ); + if instrumentation_scope_has_dropped_attributes_count v then ( + assoc := ("droppedAttributesCount", Pbrt_yojson.make_int (Int32.to_int v.dropped_attributes_count)) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_entity_ref (v:entity_ref) = + let assoc = ref [] in + if entity_ref_has_schema_url v then ( + assoc := ("schemaUrl", Pbrt_yojson.make_string v.schema_url) :: !assoc; + ); + if entity_ref_has_type_ v then ( + assoc := ("type", Pbrt_yojson.make_string v.type_) :: !assoc; + ); + assoc := ( + let l = v.id_keys |> List.map Pbrt_yojson.make_string in + ("idKeys", `List l) :: !assoc + ); + assoc := ( + let l = v.description_keys |> List.map Pbrt_yojson.make_string in + ("descriptionKeys", `List l) :: !assoc + ); + `Assoc !assoc + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 JSON Decoding} *) + +let rec decode_json_any_value json = + let assoc = match json with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + let rec loop = function + | [] -> Pbrt_yojson.E.malformed_variant "any_value" + | ("stringValue", json_value)::_ -> + (String_value (Pbrt_yojson.string json_value "any_value" "String_value") : any_value) + | ("boolValue", json_value)::_ -> + (Bool_value (Pbrt_yojson.bool json_value "any_value" "Bool_value") : any_value) + | ("intValue", json_value)::_ -> + (Int_value (Pbrt_yojson.int64 json_value "any_value" "Int_value") : any_value) + | ("doubleValue", json_value)::_ -> + (Double_value (Pbrt_yojson.float json_value "any_value" "Double_value") : any_value) + | ("arrayValue", json_value)::_ -> + (Array_value ((decode_json_array_value json_value)) : any_value) + | ("kvlistValue", json_value)::_ -> + (Kvlist_value ((decode_json_key_value_list json_value)) : any_value) + | ("bytesValue", json_value)::_ -> + (Bytes_value (Pbrt_yojson.bytes json_value "any_value" "Bytes_value") : any_value) + + | _ :: tl -> loop tl + in + loop assoc + +and decode_json_array_value d = + let v = default_array_value () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("values", `List l) -> begin + array_value_set_values v @@ List.map (function + | json_value -> (decode_json_any_value json_value) + ) l; + end + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + values = v.values; + } : array_value) + +and decode_json_key_value_list d = + let v = default_key_value_list () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("values", `List l) -> begin + key_value_list_set_values v @@ List.map (function + | json_value -> (decode_json_key_value json_value) + ) l; + end + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + values = v.values; + } : key_value_list) + +and decode_json_key_value d = + let v = default_key_value () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("key", json_value) -> + key_value_set_key v (Pbrt_yojson.string json_value "key_value" "key") + | ("value", json_value) -> + key_value_set_value v (decode_json_any_value json_value) + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + key = v.key; + value = v.value; + } : key_value) + +let rec decode_json_instrumentation_scope d = + let v = default_instrumentation_scope () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("name", json_value) -> + instrumentation_scope_set_name v (Pbrt_yojson.string json_value "instrumentation_scope" "name") + | ("version", json_value) -> + instrumentation_scope_set_version v (Pbrt_yojson.string json_value "instrumentation_scope" "version") + | ("attributes", `List l) -> begin + instrumentation_scope_set_attributes v @@ List.map (function + | json_value -> (decode_json_key_value json_value) + ) l; + end + | ("droppedAttributesCount", json_value) -> + instrumentation_scope_set_dropped_attributes_count v (Pbrt_yojson.int32 json_value "instrumentation_scope" "dropped_attributes_count") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; ({ + _presence = v._presence; name = v.name; version = v.version; attributes = v.attributes; dropped_attributes_count = v.dropped_attributes_count; } : instrumentation_scope) + +let rec decode_json_entity_ref d = + let v = default_entity_ref () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("schemaUrl", json_value) -> + entity_ref_set_schema_url v (Pbrt_yojson.string json_value "entity_ref" "schema_url") + | ("type", json_value) -> + entity_ref_set_type_ v (Pbrt_yojson.string json_value "entity_ref" "type_") + | ("idKeys", `List l) -> begin + entity_ref_set_id_keys v @@ List.map (function + | json_value -> Pbrt_yojson.string json_value "entity_ref" "id_keys" + ) l; + end + | ("descriptionKeys", `List l) -> begin + entity_ref_set_description_keys v @@ List.map (function + | json_value -> Pbrt_yojson.string json_value "entity_ref" "description_keys" + ) l; + end + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + schema_url = v.schema_url; + type_ = v.type_; + id_keys = v.id_keys; + description_keys = v.description_keys; + } : entity_ref) diff --git a/src/proto/common.mli b/src/proto/common.mli index eb1114cd4..32e007672 100644 --- a/src/proto/common.mli +++ b/src/proto/common.mli @@ -16,92 +16,161 @@ type any_value = | Kvlist_value of key_value_list | Bytes_value of bytes -and array_value = { - values : any_value list; +and array_value = private { + mutable values : any_value list; } -and key_value_list = { - values : key_value list; +and key_value_list = private { + mutable values : key_value list; } -and key_value = { - key : string; - value : any_value option; +and key_value = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) + mutable key : string; + mutable value : any_value option; } -type instrumentation_scope = { - name : string; - version : string; - attributes : key_value list; - dropped_attributes_count : int32; +type instrumentation_scope = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 3 fields *) + mutable name : string; + mutable version : string; + mutable attributes : key_value list; + mutable dropped_attributes_count : int32; +} + +type entity_ref = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 2 fields *) + mutable schema_url : string; + mutable type_ : string; + mutable id_keys : string list; + mutable description_keys : string list; } (** {2 Basic values} *) val default_any_value : unit -> any_value -(** [default_any_value ()] is the default value for type [any_value] *) +(** [default_any_value ()] is a new empty value for type [any_value] *) -val default_array_value : - ?values:any_value list -> - unit -> - array_value -(** [default_array_value ()] is the default value for type [array_value] *) +val default_array_value : unit -> array_value +(** [default_array_value ()] is a new empty value for type [array_value] *) -val default_key_value_list : - ?values:key_value list -> - unit -> - key_value_list -(** [default_key_value_list ()] is the default value for type [key_value_list] *) +val default_key_value_list : unit -> key_value_list +(** [default_key_value_list ()] is a new empty value for type [key_value_list] *) -val default_key_value : - ?key:string -> - ?value:any_value option -> - unit -> - key_value -(** [default_key_value ()] is the default value for type [key_value] *) +val default_key_value : unit -> key_value +(** [default_key_value ()] is a new empty value for type [key_value] *) -val default_instrumentation_scope : - ?name:string -> - ?version:string -> - ?attributes:key_value list -> - ?dropped_attributes_count:int32 -> - unit -> - instrumentation_scope -(** [default_instrumentation_scope ()] is the default value for type [instrumentation_scope] *) +val default_instrumentation_scope : unit -> instrumentation_scope +(** [default_instrumentation_scope ()] is a new empty value for type [instrumentation_scope] *) +val default_entity_ref : unit -> entity_ref +(** [default_entity_ref ()] is a new empty value for type [entity_ref] *) -(** {2 Make functions} *) +(** {2 Make functions} *) val make_array_value : - values:any_value list -> + ?values:any_value list -> unit -> array_value (** [make_array_value … ()] is a builder for type [array_value] *) +val copy_array_value : array_value -> array_value + +val array_value_set_values : array_value -> any_value list -> unit + (** set field values in array_value *) + val make_key_value_list : - values:key_value list -> + ?values:key_value list -> unit -> key_value_list (** [make_key_value_list … ()] is a builder for type [key_value_list] *) +val copy_key_value_list : key_value_list -> key_value_list + +val key_value_list_set_values : key_value_list -> key_value list -> unit + (** set field values in key_value_list *) + val make_key_value : - key:string -> - ?value:any_value option -> + ?key:string -> + ?value:any_value -> unit -> key_value (** [make_key_value … ()] is a builder for type [key_value] *) +val copy_key_value : key_value -> key_value + +val key_value_has_key : key_value -> bool + (** presence of field "key" in [key_value] *) + +val key_value_set_key : key_value -> string -> unit + (** set field key in key_value *) + +val key_value_set_value : key_value -> any_value -> unit + (** set field value in key_value *) + val make_instrumentation_scope : - name:string -> - version:string -> - attributes:key_value list -> - dropped_attributes_count:int32 -> + ?name:string -> + ?version:string -> + ?attributes:key_value list -> + ?dropped_attributes_count:int32 -> unit -> instrumentation_scope (** [make_instrumentation_scope … ()] is a builder for type [instrumentation_scope] *) +val copy_instrumentation_scope : instrumentation_scope -> instrumentation_scope + +val instrumentation_scope_has_name : instrumentation_scope -> bool + (** presence of field "name" in [instrumentation_scope] *) + +val instrumentation_scope_set_name : instrumentation_scope -> string -> unit + (** set field name in instrumentation_scope *) + +val instrumentation_scope_has_version : instrumentation_scope -> bool + (** presence of field "version" in [instrumentation_scope] *) + +val instrumentation_scope_set_version : instrumentation_scope -> string -> unit + (** set field version in instrumentation_scope *) + +val instrumentation_scope_set_attributes : instrumentation_scope -> key_value list -> unit + (** set field attributes in instrumentation_scope *) + +val instrumentation_scope_has_dropped_attributes_count : instrumentation_scope -> bool + (** presence of field "dropped_attributes_count" in [instrumentation_scope] *) + +val instrumentation_scope_set_dropped_attributes_count : instrumentation_scope -> int32 -> unit + (** set field dropped_attributes_count in instrumentation_scope *) + +val make_entity_ref : + ?schema_url:string -> + ?type_:string -> + ?id_keys:string list -> + ?description_keys:string list -> + unit -> + entity_ref +(** [make_entity_ref … ()] is a builder for type [entity_ref] *) + +val copy_entity_ref : entity_ref -> entity_ref + +val entity_ref_has_schema_url : entity_ref -> bool + (** presence of field "schema_url" in [entity_ref] *) + +val entity_ref_set_schema_url : entity_ref -> string -> unit + (** set field schema_url in entity_ref *) + +val entity_ref_has_type_ : entity_ref -> bool + (** presence of field "type_" in [entity_ref] *) + +val entity_ref_set_type_ : entity_ref -> string -> unit + (** set field type_ in entity_ref *) + +val entity_ref_set_id_keys : entity_ref -> string list -> unit + (** set field id_keys in entity_ref *) + +val entity_ref_set_description_keys : entity_ref -> string list -> unit + (** set field description_keys in entity_ref *) + (** {2 Formatters} *) @@ -120,6 +189,9 @@ val pp_key_value : Format.formatter -> key_value -> unit val pp_instrumentation_scope : Format.formatter -> instrumentation_scope -> unit (** [pp_instrumentation_scope v] formats v *) +val pp_entity_ref : Format.formatter -> entity_ref -> unit +(** [pp_entity_ref v] formats v *) + (** {2 Protobuf Encoding} *) @@ -138,6 +210,9 @@ val encode_pb_key_value : key_value -> Pbrt.Encoder.t -> unit val encode_pb_instrumentation_scope : instrumentation_scope -> Pbrt.Encoder.t -> unit (** [encode_pb_instrumentation_scope v encoder] encodes [v] with the given [encoder] *) +val encode_pb_entity_ref : entity_ref -> Pbrt.Encoder.t -> unit +(** [encode_pb_entity_ref v encoder] encodes [v] with the given [encoder] *) + (** {2 Protobuf Decoding} *) @@ -155,3 +230,48 @@ val decode_pb_key_value : Pbrt.Decoder.t -> key_value val decode_pb_instrumentation_scope : Pbrt.Decoder.t -> instrumentation_scope (** [decode_pb_instrumentation_scope decoder] decodes a [instrumentation_scope] binary value from [decoder] *) + +val decode_pb_entity_ref : Pbrt.Decoder.t -> entity_ref +(** [decode_pb_entity_ref decoder] decodes a [entity_ref] binary value from [decoder] *) + + +(** {2 Protobuf YoJson Encoding} *) + +val encode_json_any_value : any_value -> Yojson.Basic.t +(** [encode_json_any_value v encoder] encodes [v] to to json *) + +val encode_json_array_value : array_value -> Yojson.Basic.t +(** [encode_json_array_value v encoder] encodes [v] to to json *) + +val encode_json_key_value_list : key_value_list -> Yojson.Basic.t +(** [encode_json_key_value_list v encoder] encodes [v] to to json *) + +val encode_json_key_value : key_value -> Yojson.Basic.t +(** [encode_json_key_value v encoder] encodes [v] to to json *) + +val encode_json_instrumentation_scope : instrumentation_scope -> Yojson.Basic.t +(** [encode_json_instrumentation_scope v encoder] encodes [v] to to json *) + +val encode_json_entity_ref : entity_ref -> Yojson.Basic.t +(** [encode_json_entity_ref v encoder] encodes [v] to to json *) + + +(** {2 JSON Decoding} *) + +val decode_json_any_value : Yojson.Basic.t -> any_value +(** [decode_json_any_value decoder] decodes a [any_value] value from [decoder] *) + +val decode_json_array_value : Yojson.Basic.t -> array_value +(** [decode_json_array_value decoder] decodes a [array_value] value from [decoder] *) + +val decode_json_key_value_list : Yojson.Basic.t -> key_value_list +(** [decode_json_key_value_list decoder] decodes a [key_value_list] value from [decoder] *) + +val decode_json_key_value : Yojson.Basic.t -> key_value +(** [decode_json_key_value decoder] decodes a [key_value] value from [decoder] *) + +val decode_json_instrumentation_scope : Yojson.Basic.t -> instrumentation_scope +(** [decode_json_instrumentation_scope decoder] decodes a [instrumentation_scope] value from [decoder] *) + +val decode_json_entity_ref : Yojson.Basic.t -> entity_ref +(** [decode_json_entity_ref decoder] decodes a [entity_ref] value from [decoder] *) diff --git a/src/proto/dune b/src/proto/dune index 0cb339b30..6698d9cc8 100644 --- a/src/proto/dune +++ b/src/proto/dune @@ -3,7 +3,7 @@ (public_name opentelemetry.proto) (synopsis "Protobuf generated code for opentelemetry") (flags :standard -warn-error -a+8) - (libraries pbrt)) + (libraries pbrt pbrt_yojson)) ; ### protobuf rules ### @@ -16,7 +16,7 @@ (:file status.proto) (source_tree %{project_root}/vendor/opentelemetry-proto/)) (action - (run ocaml-protoc %{file} --ml_out . --pp --make --binary))) + (run ocaml-protoc %{file} --ml_out . --pp --make --binary --yojson))) (rule (alias lint) @@ -37,7 +37,8 @@ . --pp --make - --binary))) + --binary + --yojson))) (rule (alias lint) @@ -58,7 +59,8 @@ . --pp --make - --binary))) + --binary + --yojson))) (rule (alias lint) @@ -79,7 +81,8 @@ . --pp --make - --binary))) + --binary + --yojson))) (rule (alias lint) @@ -100,7 +103,8 @@ . --pp --make - --binary))) + --binary + --yojson))) (rule (alias lint) @@ -121,7 +125,8 @@ . --pp --make - --binary))) + --binary + --yojson))) (rule (alias lint) @@ -142,7 +147,8 @@ . --pp --make - --binary))) + --binary + --yojson))) (rule (alias lint) @@ -163,7 +169,8 @@ . --pp --make - --binary))) + --binary + --yojson))) (rule (alias lint) @@ -184,4 +191,5 @@ . --pp --make - --binary))) + --binary + --yojson))) diff --git a/src/proto/logs.ml b/src/proto/logs.ml index 375094207..168bef914 100644 --- a/src/proto/logs.ml +++ b/src/proto/logs.ml @@ -1,4 +1,4 @@ -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39-44"] type severity_number = | Severity_number_unspecified @@ -28,93 +28,7 @@ type severity_number = | Severity_number_fatal4 type log_record = { - time_unix_nano : int64; - observed_time_unix_nano : int64; - severity_number : severity_number; - severity_text : string; - body : Common.any_value option; - attributes : Common.key_value list; - dropped_attributes_count : int32; - flags : int32; - trace_id : bytes; - span_id : bytes; -} - -type scope_logs = { - scope : Common.instrumentation_scope option; - log_records : log_record list; - schema_url : string; -} - -type resource_logs = { - resource : Resource.resource option; - scope_logs : scope_logs list; - schema_url : string; -} - -type logs_data = { - resource_logs : resource_logs list; -} - -type log_record_flags = - | Log_record_flags_do_not_use - | Log_record_flags_trace_flags_mask - -let rec default_severity_number () = (Severity_number_unspecified:severity_number) - -let rec default_log_record - ?time_unix_nano:((time_unix_nano:int64) = 0L) - ?observed_time_unix_nano:((observed_time_unix_nano:int64) = 0L) - ?severity_number:((severity_number:severity_number) = default_severity_number ()) - ?severity_text:((severity_text:string) = "") - ?body:((body:Common.any_value option) = None) - ?attributes:((attributes:Common.key_value list) = []) - ?dropped_attributes_count:((dropped_attributes_count:int32) = 0l) - ?flags:((flags:int32) = 0l) - ?trace_id:((trace_id:bytes) = Bytes.create 0) - ?span_id:((span_id:bytes) = Bytes.create 0) - () : log_record = { - time_unix_nano; - observed_time_unix_nano; - severity_number; - severity_text; - body; - attributes; - dropped_attributes_count; - flags; - trace_id; - span_id; -} - -let rec default_scope_logs - ?scope:((scope:Common.instrumentation_scope option) = None) - ?log_records:((log_records:log_record list) = []) - ?schema_url:((schema_url:string) = "") - () : scope_logs = { - scope; - log_records; - schema_url; -} - -let rec default_resource_logs - ?resource:((resource:Resource.resource option) = None) - ?scope_logs:((scope_logs:scope_logs list) = []) - ?schema_url:((schema_url:string) = "") - () : resource_logs = { - resource; - scope_logs; - schema_url; -} - -let rec default_logs_data - ?resource_logs:((resource_logs:resource_logs list) = []) - () : logs_data = { - resource_logs; -} - -let rec default_log_record_flags () = (Log_record_flags_do_not_use:log_record_flags) - -type log_record_mutable = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 9 fields *) mutable time_unix_nano : int64; mutable observed_time_unix_nano : int64; mutable severity_number : severity_number; @@ -125,109 +39,227 @@ type log_record_mutable = { mutable flags : int32; mutable trace_id : bytes; mutable span_id : bytes; + mutable event_name : string; } -let default_log_record_mutable () : log_record_mutable = { - time_unix_nano = 0L; - observed_time_unix_nano = 0L; - severity_number = default_severity_number (); - severity_text = ""; - body = None; - attributes = []; - dropped_attributes_count = 0l; - flags = 0l; - trace_id = Bytes.create 0; - span_id = Bytes.create 0; -} - -type scope_logs_mutable = { +type scope_logs = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) mutable scope : Common.instrumentation_scope option; mutable log_records : log_record list; mutable schema_url : string; } -let default_scope_logs_mutable () : scope_logs_mutable = { - scope = None; - log_records = []; - schema_url = ""; -} - -type resource_logs_mutable = { +type resource_logs = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) mutable resource : Resource.resource option; mutable scope_logs : scope_logs list; mutable schema_url : string; } -let default_resource_logs_mutable () : resource_logs_mutable = { - resource = None; - scope_logs = []; - schema_url = ""; -} - -type logs_data_mutable = { +type logs_data = { mutable resource_logs : resource_logs list; } -let default_logs_data_mutable () : logs_data_mutable = { - resource_logs = []; -} - - -(** {2 Make functions} *) - +type log_record_flags = + | Log_record_flags_do_not_use + | Log_record_flags_trace_flags_mask -let rec make_log_record - ~(time_unix_nano:int64) - ~(observed_time_unix_nano:int64) - ~(severity_number:severity_number) - ~(severity_text:string) - ?body:((body:Common.any_value option) = None) - ~(attributes:Common.key_value list) - ~(dropped_attributes_count:int32) - ~(flags:int32) - ~(trace_id:bytes) - ~(span_id:bytes) - () : log_record = { - time_unix_nano; - observed_time_unix_nano; - severity_number; - severity_text; - body; - attributes; - dropped_attributes_count; - flags; - trace_id; - span_id; +let default_severity_number () = (Severity_number_unspecified:severity_number) + +let default_log_record (): log_record = +{ + _presence=Pbrt.Bitfield.empty; + time_unix_nano=0L; + observed_time_unix_nano=0L; + severity_number=default_severity_number (); + severity_text=""; + body=None; + attributes=[]; + dropped_attributes_count=0l; + flags=0l; + trace_id=Bytes.create 0; + span_id=Bytes.create 0; + event_name=""; } -let rec make_scope_logs - ?scope:((scope:Common.instrumentation_scope option) = None) - ~(log_records:log_record list) - ~(schema_url:string) - () : scope_logs = { - scope; - log_records; - schema_url; +let default_scope_logs (): scope_logs = +{ + _presence=Pbrt.Bitfield.empty; + scope=None; + log_records=[]; + schema_url=""; } -let rec make_resource_logs - ?resource:((resource:Resource.resource option) = None) - ~(scope_logs:scope_logs list) - ~(schema_url:string) - () : resource_logs = { - resource; - scope_logs; - schema_url; +let default_resource_logs (): resource_logs = +{ + _presence=Pbrt.Bitfield.empty; + resource=None; + scope_logs=[]; + schema_url=""; } -let rec make_logs_data - ~(resource_logs:resource_logs list) - () : logs_data = { - resource_logs; +let default_logs_data (): logs_data = +{ + resource_logs=[]; } +let default_log_record_flags () = (Log_record_flags_do_not_use:log_record_flags) -[@@@ocaml.warning "-27-30-39"] + +(** {2 Make functions} *) + +let[@inline] log_record_has_time_unix_nano (self:log_record) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] log_record_has_observed_time_unix_nano (self:log_record) : bool = (Pbrt.Bitfield.get self._presence 1) +let[@inline] log_record_has_severity_number (self:log_record) : bool = (Pbrt.Bitfield.get self._presence 2) +let[@inline] log_record_has_severity_text (self:log_record) : bool = (Pbrt.Bitfield.get self._presence 3) +let[@inline] log_record_has_dropped_attributes_count (self:log_record) : bool = (Pbrt.Bitfield.get self._presence 4) +let[@inline] log_record_has_flags (self:log_record) : bool = (Pbrt.Bitfield.get self._presence 5) +let[@inline] log_record_has_trace_id (self:log_record) : bool = (Pbrt.Bitfield.get self._presence 6) +let[@inline] log_record_has_span_id (self:log_record) : bool = (Pbrt.Bitfield.get self._presence 7) +let[@inline] log_record_has_event_name (self:log_record) : bool = (Pbrt.Bitfield.get self._presence 8) + +let[@inline] log_record_set_time_unix_nano (self:log_record) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.time_unix_nano <- x +let[@inline] log_record_set_observed_time_unix_nano (self:log_record) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.observed_time_unix_nano <- x +let[@inline] log_record_set_severity_number (self:log_record) (x:severity_number) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 2); self.severity_number <- x +let[@inline] log_record_set_severity_text (self:log_record) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 3); self.severity_text <- x +let[@inline] log_record_set_body (self:log_record) (x:Common.any_value) : unit = + self.body <- Some x +let[@inline] log_record_set_attributes (self:log_record) (x:Common.key_value list) : unit = + self.attributes <- x +let[@inline] log_record_set_dropped_attributes_count (self:log_record) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 4); self.dropped_attributes_count <- x +let[@inline] log_record_set_flags (self:log_record) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 5); self.flags <- x +let[@inline] log_record_set_trace_id (self:log_record) (x:bytes) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 6); self.trace_id <- x +let[@inline] log_record_set_span_id (self:log_record) (x:bytes) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 7); self.span_id <- x +let[@inline] log_record_set_event_name (self:log_record) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 8); self.event_name <- x + +let copy_log_record (self:log_record) : log_record = + { self with time_unix_nano = self.time_unix_nano } + +let make_log_record + ?(time_unix_nano:int64 option) + ?(observed_time_unix_nano:int64 option) + ?(severity_number:severity_number option) + ?(severity_text:string option) + ?(body:Common.any_value option) + ?(attributes=[]) + ?(dropped_attributes_count:int32 option) + ?(flags:int32 option) + ?(trace_id:bytes option) + ?(span_id:bytes option) + ?(event_name:string option) + () : log_record = + let _res = default_log_record () in + (match time_unix_nano with + | None -> () + | Some v -> log_record_set_time_unix_nano _res v); + (match observed_time_unix_nano with + | None -> () + | Some v -> log_record_set_observed_time_unix_nano _res v); + (match severity_number with + | None -> () + | Some v -> log_record_set_severity_number _res v); + (match severity_text with + | None -> () + | Some v -> log_record_set_severity_text _res v); + (match body with + | None -> () + | Some v -> log_record_set_body _res v); + log_record_set_attributes _res attributes; + (match dropped_attributes_count with + | None -> () + | Some v -> log_record_set_dropped_attributes_count _res v); + (match flags with + | None -> () + | Some v -> log_record_set_flags _res v); + (match trace_id with + | None -> () + | Some v -> log_record_set_trace_id _res v); + (match span_id with + | None -> () + | Some v -> log_record_set_span_id _res v); + (match event_name with + | None -> () + | Some v -> log_record_set_event_name _res v); + _res + +let[@inline] scope_logs_has_schema_url (self:scope_logs) : bool = (Pbrt.Bitfield.get self._presence 0) + +let[@inline] scope_logs_set_scope (self:scope_logs) (x:Common.instrumentation_scope) : unit = + self.scope <- Some x +let[@inline] scope_logs_set_log_records (self:scope_logs) (x:log_record list) : unit = + self.log_records <- x +let[@inline] scope_logs_set_schema_url (self:scope_logs) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.schema_url <- x + +let copy_scope_logs (self:scope_logs) : scope_logs = + { self with scope = self.scope } + +let make_scope_logs + ?(scope:Common.instrumentation_scope option) + ?(log_records=[]) + ?(schema_url:string option) + () : scope_logs = + let _res = default_scope_logs () in + (match scope with + | None -> () + | Some v -> scope_logs_set_scope _res v); + scope_logs_set_log_records _res log_records; + (match schema_url with + | None -> () + | Some v -> scope_logs_set_schema_url _res v); + _res + +let[@inline] resource_logs_has_schema_url (self:resource_logs) : bool = (Pbrt.Bitfield.get self._presence 0) + +let[@inline] resource_logs_set_resource (self:resource_logs) (x:Resource.resource) : unit = + self.resource <- Some x +let[@inline] resource_logs_set_scope_logs (self:resource_logs) (x:scope_logs list) : unit = + self.scope_logs <- x +let[@inline] resource_logs_set_schema_url (self:resource_logs) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.schema_url <- x + +let copy_resource_logs (self:resource_logs) : resource_logs = + { self with resource = self.resource } + +let make_resource_logs + ?(resource:Resource.resource option) + ?(scope_logs=[]) + ?(schema_url:string option) + () : resource_logs = + let _res = default_resource_logs () in + (match resource with + | None -> () + | Some v -> resource_logs_set_resource _res v); + resource_logs_set_scope_logs _res scope_logs; + (match schema_url with + | None -> () + | Some v -> resource_logs_set_schema_url _res v); + _res + + +let[@inline] logs_data_set_resource_logs (self:logs_data) (x:resource_logs list) : unit = + self.resource_logs <- x + +let copy_logs_data (self:logs_data) : logs_data = + { self with resource_logs = self.resource_logs } + +let make_logs_data + ?(resource_logs=[]) + () : logs_data = + let _res = default_logs_data () in + logs_data_set_resource_logs _res resource_logs; + _res + +[@@@ocaml.warning "-23-27-30-39"] (** {2 Formatters} *) @@ -261,16 +293,17 @@ let rec pp_severity_number fmt (v:severity_number) = let rec pp_log_record fmt (v:log_record) = let pp_i fmt () = - Pbrt.Pp.pp_record_field ~first:true "time_unix_nano" Pbrt.Pp.pp_int64 fmt v.time_unix_nano; - Pbrt.Pp.pp_record_field ~first:false "observed_time_unix_nano" Pbrt.Pp.pp_int64 fmt v.observed_time_unix_nano; - Pbrt.Pp.pp_record_field ~first:false "severity_number" pp_severity_number fmt v.severity_number; - Pbrt.Pp.pp_record_field ~first:false "severity_text" Pbrt.Pp.pp_string fmt v.severity_text; + Pbrt.Pp.pp_record_field ~absent:(not (log_record_has_time_unix_nano v)) ~first:true "time_unix_nano" Pbrt.Pp.pp_int64 fmt v.time_unix_nano; + Pbrt.Pp.pp_record_field ~absent:(not (log_record_has_observed_time_unix_nano v)) ~first:false "observed_time_unix_nano" Pbrt.Pp.pp_int64 fmt v.observed_time_unix_nano; + Pbrt.Pp.pp_record_field ~absent:(not (log_record_has_severity_number v)) ~first:false "severity_number" pp_severity_number fmt v.severity_number; + Pbrt.Pp.pp_record_field ~absent:(not (log_record_has_severity_text v)) ~first:false "severity_text" Pbrt.Pp.pp_string fmt v.severity_text; Pbrt.Pp.pp_record_field ~first:false "body" (Pbrt.Pp.pp_option Common.pp_any_value) fmt v.body; Pbrt.Pp.pp_record_field ~first:false "attributes" (Pbrt.Pp.pp_list Common.pp_key_value) fmt v.attributes; - Pbrt.Pp.pp_record_field ~first:false "dropped_attributes_count" Pbrt.Pp.pp_int32 fmt v.dropped_attributes_count; - Pbrt.Pp.pp_record_field ~first:false "flags" Pbrt.Pp.pp_int32 fmt v.flags; - Pbrt.Pp.pp_record_field ~first:false "trace_id" Pbrt.Pp.pp_bytes fmt v.trace_id; - Pbrt.Pp.pp_record_field ~first:false "span_id" Pbrt.Pp.pp_bytes fmt v.span_id; + Pbrt.Pp.pp_record_field ~absent:(not (log_record_has_dropped_attributes_count v)) ~first:false "dropped_attributes_count" Pbrt.Pp.pp_int32 fmt v.dropped_attributes_count; + Pbrt.Pp.pp_record_field ~absent:(not (log_record_has_flags v)) ~first:false "flags" Pbrt.Pp.pp_int32 fmt v.flags; + Pbrt.Pp.pp_record_field ~absent:(not (log_record_has_trace_id v)) ~first:false "trace_id" Pbrt.Pp.pp_bytes fmt v.trace_id; + Pbrt.Pp.pp_record_field ~absent:(not (log_record_has_span_id v)) ~first:false "span_id" Pbrt.Pp.pp_bytes fmt v.span_id; + Pbrt.Pp.pp_record_field ~absent:(not (log_record_has_event_name v)) ~first:false "event_name" Pbrt.Pp.pp_string fmt v.event_name; in Pbrt.Pp.pp_brk pp_i fmt () @@ -278,7 +311,7 @@ let rec pp_scope_logs fmt (v:scope_logs) = let pp_i fmt () = Pbrt.Pp.pp_record_field ~first:true "scope" (Pbrt.Pp.pp_option Common.pp_instrumentation_scope) fmt v.scope; Pbrt.Pp.pp_record_field ~first:false "log_records" (Pbrt.Pp.pp_list pp_log_record) fmt v.log_records; - Pbrt.Pp.pp_record_field ~first:false "schema_url" Pbrt.Pp.pp_string fmt v.schema_url; + Pbrt.Pp.pp_record_field ~absent:(not (scope_logs_has_schema_url v)) ~first:false "schema_url" Pbrt.Pp.pp_string fmt v.schema_url; in Pbrt.Pp.pp_brk pp_i fmt () @@ -286,7 +319,7 @@ let rec pp_resource_logs fmt (v:resource_logs) = let pp_i fmt () = Pbrt.Pp.pp_record_field ~first:true "resource" (Pbrt.Pp.pp_option Resource.pp_resource) fmt v.resource; Pbrt.Pp.pp_record_field ~first:false "scope_logs" (Pbrt.Pp.pp_list pp_scope_logs) fmt v.scope_logs; - Pbrt.Pp.pp_record_field ~first:false "schema_url" Pbrt.Pp.pp_string fmt v.schema_url; + Pbrt.Pp.pp_record_field ~absent:(not (resource_logs_has_schema_url v)) ~first:false "schema_url" Pbrt.Pp.pp_string fmt v.schema_url; in Pbrt.Pp.pp_brk pp_i fmt () @@ -301,7 +334,7 @@ let rec pp_log_record_flags fmt (v:log_record_flags) = | Log_record_flags_do_not_use -> Format.fprintf fmt "Log_record_flags_do_not_use" | Log_record_flags_trace_flags_mask -> Format.fprintf fmt "Log_record_flags_trace_flags_mask" -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Encoding} *) @@ -334,32 +367,52 @@ let rec encode_pb_severity_number (v:severity_number) encoder = | Severity_number_fatal4 -> Pbrt.Encoder.int_as_varint 24 encoder let rec encode_pb_log_record (v:log_record) encoder = - Pbrt.Encoder.int64_as_bits64 v.time_unix_nano encoder; - Pbrt.Encoder.key 1 Pbrt.Bits64 encoder; - Pbrt.Encoder.int64_as_bits64 v.observed_time_unix_nano encoder; - Pbrt.Encoder.key 11 Pbrt.Bits64 encoder; - encode_pb_severity_number v.severity_number encoder; - Pbrt.Encoder.key 2 Pbrt.Varint encoder; - Pbrt.Encoder.string v.severity_text encoder; - Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + if log_record_has_time_unix_nano v then ( + Pbrt.Encoder.int64_as_bits64 v.time_unix_nano encoder; + Pbrt.Encoder.key 1 Pbrt.Bits64 encoder; + ); + if log_record_has_observed_time_unix_nano v then ( + Pbrt.Encoder.int64_as_bits64 v.observed_time_unix_nano encoder; + Pbrt.Encoder.key 11 Pbrt.Bits64 encoder; + ); + if log_record_has_severity_number v then ( + encode_pb_severity_number v.severity_number encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + ); + if log_record_has_severity_text v then ( + Pbrt.Encoder.string v.severity_text encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + ); begin match v.body with | Some x -> Pbrt.Encoder.nested Common.encode_pb_any_value x encoder; Pbrt.Encoder.key 5 Pbrt.Bytes encoder; | None -> (); end; - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested Common.encode_pb_key_value x encoder; Pbrt.Encoder.key 6 Pbrt.Bytes encoder; ) v.attributes encoder; - Pbrt.Encoder.int32_as_varint v.dropped_attributes_count encoder; - Pbrt.Encoder.key 7 Pbrt.Varint encoder; - Pbrt.Encoder.int32_as_bits32 v.flags encoder; - Pbrt.Encoder.key 8 Pbrt.Bits32 encoder; - Pbrt.Encoder.bytes v.trace_id encoder; - Pbrt.Encoder.key 9 Pbrt.Bytes encoder; - Pbrt.Encoder.bytes v.span_id encoder; - Pbrt.Encoder.key 10 Pbrt.Bytes encoder; + if log_record_has_dropped_attributes_count v then ( + Pbrt.Encoder.int32_as_varint v.dropped_attributes_count encoder; + Pbrt.Encoder.key 7 Pbrt.Varint encoder; + ); + if log_record_has_flags v then ( + Pbrt.Encoder.int32_as_bits32 v.flags encoder; + Pbrt.Encoder.key 8 Pbrt.Bits32 encoder; + ); + if log_record_has_trace_id v then ( + Pbrt.Encoder.bytes v.trace_id encoder; + Pbrt.Encoder.key 9 Pbrt.Bytes encoder; + ); + if log_record_has_span_id v then ( + Pbrt.Encoder.bytes v.span_id encoder; + Pbrt.Encoder.key 10 Pbrt.Bytes encoder; + ); + if log_record_has_event_name v then ( + Pbrt.Encoder.string v.event_name encoder; + Pbrt.Encoder.key 12 Pbrt.Bytes encoder; + ); () let rec encode_pb_scope_logs (v:scope_logs) encoder = @@ -369,12 +422,14 @@ let rec encode_pb_scope_logs (v:scope_logs) encoder = Pbrt.Encoder.key 1 Pbrt.Bytes encoder; | None -> (); end; - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_log_record x encoder; Pbrt.Encoder.key 2 Pbrt.Bytes encoder; ) v.log_records encoder; - Pbrt.Encoder.string v.schema_url encoder; - Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + if scope_logs_has_schema_url v then ( + Pbrt.Encoder.string v.schema_url encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + ); () let rec encode_pb_resource_logs (v:resource_logs) encoder = @@ -384,16 +439,18 @@ let rec encode_pb_resource_logs (v:resource_logs) encoder = Pbrt.Encoder.key 1 Pbrt.Bytes encoder; | None -> (); end; - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_scope_logs x encoder; Pbrt.Encoder.key 2 Pbrt.Bytes encoder; ) v.scope_logs encoder; - Pbrt.Encoder.string v.schema_url encoder; - Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + if resource_logs_has_schema_url v then ( + Pbrt.Encoder.string v.schema_url encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + ); () let rec encode_pb_logs_data (v:logs_data) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_resource_logs x encoder; Pbrt.Encoder.key 1 Pbrt.Bytes encoder; ) v.resource_logs encoder; @@ -404,195 +461,454 @@ let rec encode_pb_log_record_flags (v:log_record_flags) encoder = | Log_record_flags_do_not_use -> Pbrt.Encoder.int_as_varint (0) encoder | Log_record_flags_trace_flags_mask -> Pbrt.Encoder.int_as_varint 255 encoder -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Decoding} *) -let rec decode_pb_severity_number d = +let rec decode_pb_severity_number d : severity_number = match Pbrt.Decoder.int_as_varint d with - | 0 -> (Severity_number_unspecified:severity_number) - | 1 -> (Severity_number_trace:severity_number) - | 2 -> (Severity_number_trace2:severity_number) - | 3 -> (Severity_number_trace3:severity_number) - | 4 -> (Severity_number_trace4:severity_number) - | 5 -> (Severity_number_debug:severity_number) - | 6 -> (Severity_number_debug2:severity_number) - | 7 -> (Severity_number_debug3:severity_number) - | 8 -> (Severity_number_debug4:severity_number) - | 9 -> (Severity_number_info:severity_number) - | 10 -> (Severity_number_info2:severity_number) - | 11 -> (Severity_number_info3:severity_number) - | 12 -> (Severity_number_info4:severity_number) - | 13 -> (Severity_number_warn:severity_number) - | 14 -> (Severity_number_warn2:severity_number) - | 15 -> (Severity_number_warn3:severity_number) - | 16 -> (Severity_number_warn4:severity_number) - | 17 -> (Severity_number_error:severity_number) - | 18 -> (Severity_number_error2:severity_number) - | 19 -> (Severity_number_error3:severity_number) - | 20 -> (Severity_number_error4:severity_number) - | 21 -> (Severity_number_fatal:severity_number) - | 22 -> (Severity_number_fatal2:severity_number) - | 23 -> (Severity_number_fatal3:severity_number) - | 24 -> (Severity_number_fatal4:severity_number) + | 0 -> Severity_number_unspecified + | 1 -> Severity_number_trace + | 2 -> Severity_number_trace2 + | 3 -> Severity_number_trace3 + | 4 -> Severity_number_trace4 + | 5 -> Severity_number_debug + | 6 -> Severity_number_debug2 + | 7 -> Severity_number_debug3 + | 8 -> Severity_number_debug4 + | 9 -> Severity_number_info + | 10 -> Severity_number_info2 + | 11 -> Severity_number_info3 + | 12 -> Severity_number_info4 + | 13 -> Severity_number_warn + | 14 -> Severity_number_warn2 + | 15 -> Severity_number_warn3 + | 16 -> Severity_number_warn4 + | 17 -> Severity_number_error + | 18 -> Severity_number_error2 + | 19 -> Severity_number_error3 + | 20 -> Severity_number_error4 + | 21 -> Severity_number_fatal + | 22 -> Severity_number_fatal2 + | 23 -> Severity_number_fatal3 + | 24 -> Severity_number_fatal4 | _ -> Pbrt.Decoder.malformed_variant "severity_number" let rec decode_pb_log_record d = - let v = default_log_record_mutable () in + let v = default_log_record () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.attributes <- List.rev v.attributes; + (* put lists in the correct order *) + log_record_set_attributes v (List.rev v.attributes); ); continue__ := false | Some (1, Pbrt.Bits64) -> begin - v.time_unix_nano <- Pbrt.Decoder.int64_as_bits64 d; + log_record_set_time_unix_nano v (Pbrt.Decoder.int64_as_bits64 d); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(log_record), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "log_record" 1 pk | Some (11, Pbrt.Bits64) -> begin - v.observed_time_unix_nano <- Pbrt.Decoder.int64_as_bits64 d; + log_record_set_observed_time_unix_nano v (Pbrt.Decoder.int64_as_bits64 d); end | Some (11, pk) -> - Pbrt.Decoder.unexpected_payload "Message(log_record), field(11)" pk + Pbrt.Decoder.unexpected_payload_message "log_record" 11 pk | Some (2, Pbrt.Varint) -> begin - v.severity_number <- decode_pb_severity_number d; + log_record_set_severity_number v (decode_pb_severity_number d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(log_record), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "log_record" 2 pk | Some (3, Pbrt.Bytes) -> begin - v.severity_text <- Pbrt.Decoder.string d; + log_record_set_severity_text v (Pbrt.Decoder.string d); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(log_record), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "log_record" 3 pk | Some (5, Pbrt.Bytes) -> begin - v.body <- Some (Common.decode_pb_any_value (Pbrt.Decoder.nested d)); + log_record_set_body v (Common.decode_pb_any_value (Pbrt.Decoder.nested d)); end | Some (5, pk) -> - Pbrt.Decoder.unexpected_payload "Message(log_record), field(5)" pk + Pbrt.Decoder.unexpected_payload_message "log_record" 5 pk | Some (6, Pbrt.Bytes) -> begin - v.attributes <- (Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes; + log_record_set_attributes v ((Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes); end | Some (6, pk) -> - Pbrt.Decoder.unexpected_payload "Message(log_record), field(6)" pk + Pbrt.Decoder.unexpected_payload_message "log_record" 6 pk | Some (7, Pbrt.Varint) -> begin - v.dropped_attributes_count <- Pbrt.Decoder.int32_as_varint d; + log_record_set_dropped_attributes_count v (Pbrt.Decoder.int32_as_varint d); end | Some (7, pk) -> - Pbrt.Decoder.unexpected_payload "Message(log_record), field(7)" pk + Pbrt.Decoder.unexpected_payload_message "log_record" 7 pk | Some (8, Pbrt.Bits32) -> begin - v.flags <- Pbrt.Decoder.int32_as_bits32 d; + log_record_set_flags v (Pbrt.Decoder.int32_as_bits32 d); end | Some (8, pk) -> - Pbrt.Decoder.unexpected_payload "Message(log_record), field(8)" pk + Pbrt.Decoder.unexpected_payload_message "log_record" 8 pk | Some (9, Pbrt.Bytes) -> begin - v.trace_id <- Pbrt.Decoder.bytes d; + log_record_set_trace_id v (Pbrt.Decoder.bytes d); end | Some (9, pk) -> - Pbrt.Decoder.unexpected_payload "Message(log_record), field(9)" pk + Pbrt.Decoder.unexpected_payload_message "log_record" 9 pk | Some (10, Pbrt.Bytes) -> begin - v.span_id <- Pbrt.Decoder.bytes d; + log_record_set_span_id v (Pbrt.Decoder.bytes d); end | Some (10, pk) -> - Pbrt.Decoder.unexpected_payload "Message(log_record), field(10)" pk + Pbrt.Decoder.unexpected_payload_message "log_record" 10 pk + | Some (12, Pbrt.Bytes) -> begin + log_record_set_event_name v (Pbrt.Decoder.string d); + end + | Some (12, pk) -> + Pbrt.Decoder.unexpected_payload_message "log_record" 12 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - time_unix_nano = v.time_unix_nano; - observed_time_unix_nano = v.observed_time_unix_nano; - severity_number = v.severity_number; - severity_text = v.severity_text; - body = v.body; - attributes = v.attributes; - dropped_attributes_count = v.dropped_attributes_count; - flags = v.flags; - trace_id = v.trace_id; - span_id = v.span_id; - } : log_record) + (v : log_record) let rec decode_pb_scope_logs d = - let v = default_scope_logs_mutable () in + let v = default_scope_logs () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.log_records <- List.rev v.log_records; + (* put lists in the correct order *) + scope_logs_set_log_records v (List.rev v.log_records); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.scope <- Some (Common.decode_pb_instrumentation_scope (Pbrt.Decoder.nested d)); + scope_logs_set_scope v (Common.decode_pb_instrumentation_scope (Pbrt.Decoder.nested d)); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(scope_logs), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "scope_logs" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.log_records <- (decode_pb_log_record (Pbrt.Decoder.nested d)) :: v.log_records; + scope_logs_set_log_records v ((decode_pb_log_record (Pbrt.Decoder.nested d)) :: v.log_records); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(scope_logs), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "scope_logs" 2 pk | Some (3, Pbrt.Bytes) -> begin - v.schema_url <- Pbrt.Decoder.string d; + scope_logs_set_schema_url v (Pbrt.Decoder.string d); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(scope_logs), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "scope_logs" 3 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - scope = v.scope; - log_records = v.log_records; - schema_url = v.schema_url; - } : scope_logs) + (v : scope_logs) let rec decode_pb_resource_logs d = - let v = default_resource_logs_mutable () in + let v = default_resource_logs () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.scope_logs <- List.rev v.scope_logs; + (* put lists in the correct order *) + resource_logs_set_scope_logs v (List.rev v.scope_logs); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.resource <- Some (Resource.decode_pb_resource (Pbrt.Decoder.nested d)); + resource_logs_set_resource v (Resource.decode_pb_resource (Pbrt.Decoder.nested d)); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(resource_logs), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "resource_logs" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.scope_logs <- (decode_pb_scope_logs (Pbrt.Decoder.nested d)) :: v.scope_logs; + resource_logs_set_scope_logs v ((decode_pb_scope_logs (Pbrt.Decoder.nested d)) :: v.scope_logs); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(resource_logs), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "resource_logs" 2 pk | Some (3, Pbrt.Bytes) -> begin - v.schema_url <- Pbrt.Decoder.string d; + resource_logs_set_schema_url v (Pbrt.Decoder.string d); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(resource_logs), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "resource_logs" 3 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - resource = v.resource; - scope_logs = v.scope_logs; - schema_url = v.schema_url; - } : resource_logs) + (v : resource_logs) let rec decode_pb_logs_data d = - let v = default_logs_data_mutable () in + let v = default_logs_data () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.resource_logs <- List.rev v.resource_logs; + (* put lists in the correct order *) + logs_data_set_resource_logs v (List.rev v.resource_logs); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.resource_logs <- (decode_pb_resource_logs (Pbrt.Decoder.nested d)) :: v.resource_logs; + logs_data_set_resource_logs v ((decode_pb_resource_logs (Pbrt.Decoder.nested d)) :: v.resource_logs); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(logs_data), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "logs_data" 1 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; + (v : logs_data) + +let rec decode_pb_log_record_flags d : log_record_flags = + match Pbrt.Decoder.int_as_varint d with + | 0 -> Log_record_flags_do_not_use + | 255 -> Log_record_flags_trace_flags_mask + | _ -> Pbrt.Decoder.malformed_variant "log_record_flags" + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 Protobuf YoJson Encoding} *) + +let rec encode_json_severity_number (v:severity_number) = + match v with + | Severity_number_unspecified -> `String "SEVERITY_NUMBER_UNSPECIFIED" + | Severity_number_trace -> `String "SEVERITY_NUMBER_TRACE" + | Severity_number_trace2 -> `String "SEVERITY_NUMBER_TRACE2" + | Severity_number_trace3 -> `String "SEVERITY_NUMBER_TRACE3" + | Severity_number_trace4 -> `String "SEVERITY_NUMBER_TRACE4" + | Severity_number_debug -> `String "SEVERITY_NUMBER_DEBUG" + | Severity_number_debug2 -> `String "SEVERITY_NUMBER_DEBUG2" + | Severity_number_debug3 -> `String "SEVERITY_NUMBER_DEBUG3" + | Severity_number_debug4 -> `String "SEVERITY_NUMBER_DEBUG4" + | Severity_number_info -> `String "SEVERITY_NUMBER_INFO" + | Severity_number_info2 -> `String "SEVERITY_NUMBER_INFO2" + | Severity_number_info3 -> `String "SEVERITY_NUMBER_INFO3" + | Severity_number_info4 -> `String "SEVERITY_NUMBER_INFO4" + | Severity_number_warn -> `String "SEVERITY_NUMBER_WARN" + | Severity_number_warn2 -> `String "SEVERITY_NUMBER_WARN2" + | Severity_number_warn3 -> `String "SEVERITY_NUMBER_WARN3" + | Severity_number_warn4 -> `String "SEVERITY_NUMBER_WARN4" + | Severity_number_error -> `String "SEVERITY_NUMBER_ERROR" + | Severity_number_error2 -> `String "SEVERITY_NUMBER_ERROR2" + | Severity_number_error3 -> `String "SEVERITY_NUMBER_ERROR3" + | Severity_number_error4 -> `String "SEVERITY_NUMBER_ERROR4" + | Severity_number_fatal -> `String "SEVERITY_NUMBER_FATAL" + | Severity_number_fatal2 -> `String "SEVERITY_NUMBER_FATAL2" + | Severity_number_fatal3 -> `String "SEVERITY_NUMBER_FATAL3" + | Severity_number_fatal4 -> `String "SEVERITY_NUMBER_FATAL4" + +let rec encode_json_log_record (v:log_record) = + let assoc = ref [] in + if log_record_has_time_unix_nano v then ( + assoc := ("timeUnixNano", Pbrt_yojson.make_string (Int64.to_string v.time_unix_nano)) :: !assoc; + ); + if log_record_has_observed_time_unix_nano v then ( + assoc := ("observedTimeUnixNano", Pbrt_yojson.make_string (Int64.to_string v.observed_time_unix_nano)) :: !assoc; + ); + if log_record_has_severity_number v then ( + assoc := ("severityNumber", encode_json_severity_number v.severity_number) :: !assoc; + ); + if log_record_has_severity_text v then ( + assoc := ("severityText", Pbrt_yojson.make_string v.severity_text) :: !assoc; + ); + assoc := (match v.body with + | None -> !assoc + | Some v -> ("body", Common.encode_json_any_value v) :: !assoc); + assoc := ( + let l = v.attributes |> List.map Common.encode_json_key_value in + ("attributes", `List l) :: !assoc + ); + if log_record_has_dropped_attributes_count v then ( + assoc := ("droppedAttributesCount", Pbrt_yojson.make_int (Int32.to_int v.dropped_attributes_count)) :: !assoc; + ); + if log_record_has_flags v then ( + assoc := ("flags", Pbrt_yojson.make_int (Int32.to_int v.flags)) :: !assoc; + ); + if log_record_has_trace_id v then ( + assoc := ("traceId", Pbrt_yojson.make_bytes v.trace_id) :: !assoc; + ); + if log_record_has_span_id v then ( + assoc := ("spanId", Pbrt_yojson.make_bytes v.span_id) :: !assoc; + ); + if log_record_has_event_name v then ( + assoc := ("eventName", Pbrt_yojson.make_string v.event_name) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_scope_logs (v:scope_logs) = + let assoc = ref [] in + assoc := (match v.scope with + | None -> !assoc + | Some v -> ("scope", Common.encode_json_instrumentation_scope v) :: !assoc); + assoc := ( + let l = v.log_records |> List.map encode_json_log_record in + ("logRecords", `List l) :: !assoc + ); + if scope_logs_has_schema_url v then ( + assoc := ("schemaUrl", Pbrt_yojson.make_string v.schema_url) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_resource_logs (v:resource_logs) = + let assoc = ref [] in + assoc := (match v.resource with + | None -> !assoc + | Some v -> ("resource", Resource.encode_json_resource v) :: !assoc); + assoc := ( + let l = v.scope_logs |> List.map encode_json_scope_logs in + ("scopeLogs", `List l) :: !assoc + ); + if resource_logs_has_schema_url v then ( + assoc := ("schemaUrl", Pbrt_yojson.make_string v.schema_url) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_logs_data (v:logs_data) = + let assoc = ref [] in + assoc := ( + let l = v.resource_logs |> List.map encode_json_resource_logs in + ("resourceLogs", `List l) :: !assoc + ); + `Assoc !assoc + +let rec encode_json_log_record_flags (v:log_record_flags) = + match v with + | Log_record_flags_do_not_use -> `String "LOG_RECORD_FLAGS_DO_NOT_USE" + | Log_record_flags_trace_flags_mask -> `String "LOG_RECORD_FLAGS_TRACE_FLAGS_MASK" + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 JSON Decoding} *) + +let rec decode_json_severity_number json = + match json with + | `String "SEVERITY_NUMBER_UNSPECIFIED" -> (Severity_number_unspecified : severity_number) + | `String "SEVERITY_NUMBER_TRACE" -> (Severity_number_trace : severity_number) + | `String "SEVERITY_NUMBER_TRACE2" -> (Severity_number_trace2 : severity_number) + | `String "SEVERITY_NUMBER_TRACE3" -> (Severity_number_trace3 : severity_number) + | `String "SEVERITY_NUMBER_TRACE4" -> (Severity_number_trace4 : severity_number) + | `String "SEVERITY_NUMBER_DEBUG" -> (Severity_number_debug : severity_number) + | `String "SEVERITY_NUMBER_DEBUG2" -> (Severity_number_debug2 : severity_number) + | `String "SEVERITY_NUMBER_DEBUG3" -> (Severity_number_debug3 : severity_number) + | `String "SEVERITY_NUMBER_DEBUG4" -> (Severity_number_debug4 : severity_number) + | `String "SEVERITY_NUMBER_INFO" -> (Severity_number_info : severity_number) + | `String "SEVERITY_NUMBER_INFO2" -> (Severity_number_info2 : severity_number) + | `String "SEVERITY_NUMBER_INFO3" -> (Severity_number_info3 : severity_number) + | `String "SEVERITY_NUMBER_INFO4" -> (Severity_number_info4 : severity_number) + | `String "SEVERITY_NUMBER_WARN" -> (Severity_number_warn : severity_number) + | `String "SEVERITY_NUMBER_WARN2" -> (Severity_number_warn2 : severity_number) + | `String "SEVERITY_NUMBER_WARN3" -> (Severity_number_warn3 : severity_number) + | `String "SEVERITY_NUMBER_WARN4" -> (Severity_number_warn4 : severity_number) + | `String "SEVERITY_NUMBER_ERROR" -> (Severity_number_error : severity_number) + | `String "SEVERITY_NUMBER_ERROR2" -> (Severity_number_error2 : severity_number) + | `String "SEVERITY_NUMBER_ERROR3" -> (Severity_number_error3 : severity_number) + | `String "SEVERITY_NUMBER_ERROR4" -> (Severity_number_error4 : severity_number) + | `String "SEVERITY_NUMBER_FATAL" -> (Severity_number_fatal : severity_number) + | `String "SEVERITY_NUMBER_FATAL2" -> (Severity_number_fatal2 : severity_number) + | `String "SEVERITY_NUMBER_FATAL3" -> (Severity_number_fatal3 : severity_number) + | `String "SEVERITY_NUMBER_FATAL4" -> (Severity_number_fatal4 : severity_number) + | _ -> Pbrt_yojson.E.malformed_variant "severity_number" + +let rec decode_json_log_record d = + let v = default_log_record () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("timeUnixNano", json_value) -> + log_record_set_time_unix_nano v (Pbrt_yojson.int64 json_value "log_record" "time_unix_nano") + | ("observedTimeUnixNano", json_value) -> + log_record_set_observed_time_unix_nano v (Pbrt_yojson.int64 json_value "log_record" "observed_time_unix_nano") + | ("severityNumber", json_value) -> + log_record_set_severity_number v ((decode_json_severity_number json_value)) + | ("severityText", json_value) -> + log_record_set_severity_text v (Pbrt_yojson.string json_value "log_record" "severity_text") + | ("body", json_value) -> + log_record_set_body v (Common.decode_json_any_value json_value) + | ("attributes", `List l) -> begin + log_record_set_attributes v @@ List.map (function + | json_value -> (Common.decode_json_key_value json_value) + ) l; + end + | ("droppedAttributesCount", json_value) -> + log_record_set_dropped_attributes_count v (Pbrt_yojson.int32 json_value "log_record" "dropped_attributes_count") + | ("flags", json_value) -> + log_record_set_flags v (Pbrt_yojson.int32 json_value "log_record" "flags") + | ("traceId", json_value) -> + log_record_set_trace_id v (Pbrt_yojson.bytes json_value "log_record" "trace_id") + | ("spanId", json_value) -> + log_record_set_span_id v (Pbrt_yojson.bytes json_value "log_record" "span_id") + | ("eventName", json_value) -> + log_record_set_event_name v (Pbrt_yojson.string json_value "log_record" "event_name") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + time_unix_nano = v.time_unix_nano; + observed_time_unix_nano = v.observed_time_unix_nano; + severity_number = v.severity_number; + severity_text = v.severity_text; + body = v.body; + attributes = v.attributes; + dropped_attributes_count = v.dropped_attributes_count; + flags = v.flags; + trace_id = v.trace_id; + span_id = v.span_id; + event_name = v.event_name; + } : log_record) + +let rec decode_json_scope_logs d = + let v = default_scope_logs () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("scope", json_value) -> + scope_logs_set_scope v (Common.decode_json_instrumentation_scope json_value) + | ("logRecords", `List l) -> begin + scope_logs_set_log_records v @@ List.map (function + | json_value -> (decode_json_log_record json_value) + ) l; + end + | ("schemaUrl", json_value) -> + scope_logs_set_schema_url v (Pbrt_yojson.string json_value "scope_logs" "schema_url") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + scope = v.scope; + log_records = v.log_records; + schema_url = v.schema_url; + } : scope_logs) + +let rec decode_json_resource_logs d = + let v = default_resource_logs () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("resource", json_value) -> + resource_logs_set_resource v (Resource.decode_json_resource json_value) + | ("scopeLogs", `List l) -> begin + resource_logs_set_scope_logs v @@ List.map (function + | json_value -> (decode_json_scope_logs json_value) + ) l; + end + | ("schemaUrl", json_value) -> + resource_logs_set_schema_url v (Pbrt_yojson.string json_value "resource_logs" "schema_url") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + resource = v.resource; + scope_logs = v.scope_logs; + schema_url = v.schema_url; + } : resource_logs) + +let rec decode_json_logs_data d = + let v = default_logs_data () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("resourceLogs", `List l) -> begin + logs_data_set_resource_logs v @@ List.map (function + | json_value -> (decode_json_resource_logs json_value) + ) l; + end + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; ({ resource_logs = v.resource_logs; } : logs_data) -let rec decode_pb_log_record_flags d = - match Pbrt.Decoder.int_as_varint d with - | 0 -> (Log_record_flags_do_not_use:log_record_flags) - | 255 -> (Log_record_flags_trace_flags_mask:log_record_flags) - | _ -> Pbrt.Decoder.malformed_variant "log_record_flags" +let rec decode_json_log_record_flags json = + match json with + | `String "LOG_RECORD_FLAGS_DO_NOT_USE" -> (Log_record_flags_do_not_use : log_record_flags) + | `String "LOG_RECORD_FLAGS_TRACE_FLAGS_MASK" -> (Log_record_flags_trace_flags_mask : log_record_flags) + | _ -> Pbrt_yojson.E.malformed_variant "log_record_flags" diff --git a/src/proto/logs.mli b/src/proto/logs.mli index 84dd9c0ce..5f5b00272 100644 --- a/src/proto/logs.mli +++ b/src/proto/logs.mli @@ -34,33 +34,37 @@ type severity_number = | Severity_number_fatal3 | Severity_number_fatal4 -type log_record = { - time_unix_nano : int64; - observed_time_unix_nano : int64; - severity_number : severity_number; - severity_text : string; - body : Common.any_value option; - attributes : Common.key_value list; - dropped_attributes_count : int32; - flags : int32; - trace_id : bytes; - span_id : bytes; +type log_record = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 9 fields *) + mutable time_unix_nano : int64; + mutable observed_time_unix_nano : int64; + mutable severity_number : severity_number; + mutable severity_text : string; + mutable body : Common.any_value option; + mutable attributes : Common.key_value list; + mutable dropped_attributes_count : int32; + mutable flags : int32; + mutable trace_id : bytes; + mutable span_id : bytes; + mutable event_name : string; } -type scope_logs = { - scope : Common.instrumentation_scope option; - log_records : log_record list; - schema_url : string; +type scope_logs = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) + mutable scope : Common.instrumentation_scope option; + mutable log_records : log_record list; + mutable schema_url : string; } -type resource_logs = { - resource : Resource.resource option; - scope_logs : scope_logs list; - schema_url : string; +type resource_logs = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) + mutable resource : Resource.resource option; + mutable scope_logs : scope_logs list; + mutable schema_url : string; } -type logs_data = { - resource_logs : resource_logs list; +type logs_data = private { + mutable resource_logs : resource_logs list; } type log_record_flags = @@ -71,89 +75,158 @@ type log_record_flags = (** {2 Basic values} *) val default_severity_number : unit -> severity_number -(** [default_severity_number ()] is the default value for type [severity_number] *) +(** [default_severity_number ()] is a new empty value for type [severity_number] *) -val default_log_record : +val default_log_record : unit -> log_record +(** [default_log_record ()] is a new empty value for type [log_record] *) + +val default_scope_logs : unit -> scope_logs +(** [default_scope_logs ()] is a new empty value for type [scope_logs] *) + +val default_resource_logs : unit -> resource_logs +(** [default_resource_logs ()] is a new empty value for type [resource_logs] *) + +val default_logs_data : unit -> logs_data +(** [default_logs_data ()] is a new empty value for type [logs_data] *) + +val default_log_record_flags : unit -> log_record_flags +(** [default_log_record_flags ()] is a new empty value for type [log_record_flags] *) + + +(** {2 Make functions} *) + +val make_log_record : ?time_unix_nano:int64 -> ?observed_time_unix_nano:int64 -> ?severity_number:severity_number -> ?severity_text:string -> - ?body:Common.any_value option -> + ?body:Common.any_value -> ?attributes:Common.key_value list -> ?dropped_attributes_count:int32 -> ?flags:int32 -> ?trace_id:bytes -> ?span_id:bytes -> + ?event_name:string -> unit -> log_record -(** [default_log_record ()] is the default value for type [log_record] *) +(** [make_log_record … ()] is a builder for type [log_record] *) -val default_scope_logs : - ?scope:Common.instrumentation_scope option -> - ?log_records:log_record list -> - ?schema_url:string -> - unit -> - scope_logs -(** [default_scope_logs ()] is the default value for type [scope_logs] *) +val copy_log_record : log_record -> log_record -val default_resource_logs : - ?resource:Resource.resource option -> - ?scope_logs:scope_logs list -> - ?schema_url:string -> - unit -> - resource_logs -(** [default_resource_logs ()] is the default value for type [resource_logs] *) +val log_record_has_time_unix_nano : log_record -> bool + (** presence of field "time_unix_nano" in [log_record] *) -val default_logs_data : - ?resource_logs:resource_logs list -> - unit -> - logs_data -(** [default_logs_data ()] is the default value for type [logs_data] *) +val log_record_set_time_unix_nano : log_record -> int64 -> unit + (** set field time_unix_nano in log_record *) -val default_log_record_flags : unit -> log_record_flags -(** [default_log_record_flags ()] is the default value for type [log_record_flags] *) +val log_record_has_observed_time_unix_nano : log_record -> bool + (** presence of field "observed_time_unix_nano" in [log_record] *) +val log_record_set_observed_time_unix_nano : log_record -> int64 -> unit + (** set field observed_time_unix_nano in log_record *) -(** {2 Make functions} *) +val log_record_has_severity_number : log_record -> bool + (** presence of field "severity_number" in [log_record] *) +val log_record_set_severity_number : log_record -> severity_number -> unit + (** set field severity_number in log_record *) -val make_log_record : - time_unix_nano:int64 -> - observed_time_unix_nano:int64 -> - severity_number:severity_number -> - severity_text:string -> - ?body:Common.any_value option -> - attributes:Common.key_value list -> - dropped_attributes_count:int32 -> - flags:int32 -> - trace_id:bytes -> - span_id:bytes -> - unit -> - log_record -(** [make_log_record … ()] is a builder for type [log_record] *) +val log_record_has_severity_text : log_record -> bool + (** presence of field "severity_text" in [log_record] *) + +val log_record_set_severity_text : log_record -> string -> unit + (** set field severity_text in log_record *) + +val log_record_set_body : log_record -> Common.any_value -> unit + (** set field body in log_record *) + +val log_record_set_attributes : log_record -> Common.key_value list -> unit + (** set field attributes in log_record *) + +val log_record_has_dropped_attributes_count : log_record -> bool + (** presence of field "dropped_attributes_count" in [log_record] *) + +val log_record_set_dropped_attributes_count : log_record -> int32 -> unit + (** set field dropped_attributes_count in log_record *) + +val log_record_has_flags : log_record -> bool + (** presence of field "flags" in [log_record] *) + +val log_record_set_flags : log_record -> int32 -> unit + (** set field flags in log_record *) + +val log_record_has_trace_id : log_record -> bool + (** presence of field "trace_id" in [log_record] *) + +val log_record_set_trace_id : log_record -> bytes -> unit + (** set field trace_id in log_record *) + +val log_record_has_span_id : log_record -> bool + (** presence of field "span_id" in [log_record] *) + +val log_record_set_span_id : log_record -> bytes -> unit + (** set field span_id in log_record *) + +val log_record_has_event_name : log_record -> bool + (** presence of field "event_name" in [log_record] *) + +val log_record_set_event_name : log_record -> string -> unit + (** set field event_name in log_record *) val make_scope_logs : - ?scope:Common.instrumentation_scope option -> - log_records:log_record list -> - schema_url:string -> + ?scope:Common.instrumentation_scope -> + ?log_records:log_record list -> + ?schema_url:string -> unit -> scope_logs (** [make_scope_logs … ()] is a builder for type [scope_logs] *) +val copy_scope_logs : scope_logs -> scope_logs + +val scope_logs_set_scope : scope_logs -> Common.instrumentation_scope -> unit + (** set field scope in scope_logs *) + +val scope_logs_set_log_records : scope_logs -> log_record list -> unit + (** set field log_records in scope_logs *) + +val scope_logs_has_schema_url : scope_logs -> bool + (** presence of field "schema_url" in [scope_logs] *) + +val scope_logs_set_schema_url : scope_logs -> string -> unit + (** set field schema_url in scope_logs *) + val make_resource_logs : - ?resource:Resource.resource option -> - scope_logs:scope_logs list -> - schema_url:string -> + ?resource:Resource.resource -> + ?scope_logs:scope_logs list -> + ?schema_url:string -> unit -> resource_logs (** [make_resource_logs … ()] is a builder for type [resource_logs] *) +val copy_resource_logs : resource_logs -> resource_logs + +val resource_logs_set_resource : resource_logs -> Resource.resource -> unit + (** set field resource in resource_logs *) + +val resource_logs_set_scope_logs : resource_logs -> scope_logs list -> unit + (** set field scope_logs in resource_logs *) + +val resource_logs_has_schema_url : resource_logs -> bool + (** presence of field "schema_url" in [resource_logs] *) + +val resource_logs_set_schema_url : resource_logs -> string -> unit + (** set field schema_url in resource_logs *) + val make_logs_data : - resource_logs:resource_logs list -> + ?resource_logs:resource_logs list -> unit -> logs_data (** [make_logs_data … ()] is a builder for type [logs_data] *) +val copy_logs_data : logs_data -> logs_data + +val logs_data_set_resource_logs : logs_data -> resource_logs list -> unit + (** set field resource_logs in logs_data *) (** {2 Formatters} *) @@ -217,3 +290,45 @@ val decode_pb_logs_data : Pbrt.Decoder.t -> logs_data val decode_pb_log_record_flags : Pbrt.Decoder.t -> log_record_flags (** [decode_pb_log_record_flags decoder] decodes a [log_record_flags] binary value from [decoder] *) + + +(** {2 Protobuf YoJson Encoding} *) + +val encode_json_severity_number : severity_number -> Yojson.Basic.t +(** [encode_json_severity_number v encoder] encodes [v] to to json *) + +val encode_json_log_record : log_record -> Yojson.Basic.t +(** [encode_json_log_record v encoder] encodes [v] to to json *) + +val encode_json_scope_logs : scope_logs -> Yojson.Basic.t +(** [encode_json_scope_logs v encoder] encodes [v] to to json *) + +val encode_json_resource_logs : resource_logs -> Yojson.Basic.t +(** [encode_json_resource_logs v encoder] encodes [v] to to json *) + +val encode_json_logs_data : logs_data -> Yojson.Basic.t +(** [encode_json_logs_data v encoder] encodes [v] to to json *) + +val encode_json_log_record_flags : log_record_flags -> Yojson.Basic.t +(** [encode_json_log_record_flags v encoder] encodes [v] to to json *) + + +(** {2 JSON Decoding} *) + +val decode_json_severity_number : Yojson.Basic.t -> severity_number +(** [decode_json_severity_number decoder] decodes a [severity_number] value from [decoder] *) + +val decode_json_log_record : Yojson.Basic.t -> log_record +(** [decode_json_log_record decoder] decodes a [log_record] value from [decoder] *) + +val decode_json_scope_logs : Yojson.Basic.t -> scope_logs +(** [decode_json_scope_logs decoder] decodes a [scope_logs] value from [decoder] *) + +val decode_json_resource_logs : Yojson.Basic.t -> resource_logs +(** [decode_json_resource_logs decoder] decodes a [resource_logs] value from [decoder] *) + +val decode_json_logs_data : Yojson.Basic.t -> logs_data +(** [decode_json_logs_data decoder] decodes a [logs_data] value from [decoder] *) + +val decode_json_log_record_flags : Yojson.Basic.t -> log_record_flags +(** [decode_json_log_record_flags decoder] decodes a [log_record_flags] value from [decoder] *) diff --git a/src/proto/logs_service.ml b/src/proto/logs_service.ml index 8e271c590..bed3da686 100644 --- a/src/proto/logs_service.ml +++ b/src/proto/logs_service.ml @@ -1,88 +1,94 @@ -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39-44"] type export_logs_service_request = { - resource_logs : Logs.resource_logs list; + mutable resource_logs : Logs.resource_logs list; } type export_logs_partial_success = { - rejected_log_records : int64; - error_message : string; + mutable _presence: Pbrt.Bitfield.t; (** presence for 2 fields *) + mutable rejected_log_records : int64; + mutable error_message : string; } type export_logs_service_response = { - partial_success : export_logs_partial_success option; + mutable partial_success : export_logs_partial_success option; } -let rec default_export_logs_service_request - ?resource_logs:((resource_logs:Logs.resource_logs list) = []) - () : export_logs_service_request = { - resource_logs; +let default_export_logs_service_request (): export_logs_service_request = +{ + resource_logs=[]; } -let rec default_export_logs_partial_success - ?rejected_log_records:((rejected_log_records:int64) = 0L) - ?error_message:((error_message:string) = "") - () : export_logs_partial_success = { - rejected_log_records; - error_message; +let default_export_logs_partial_success (): export_logs_partial_success = +{ + _presence=Pbrt.Bitfield.empty; + rejected_log_records=0L; + error_message=""; } -let rec default_export_logs_service_response - ?partial_success:((partial_success:export_logs_partial_success option) = None) - () : export_logs_service_response = { - partial_success; +let default_export_logs_service_response (): export_logs_service_response = +{ + partial_success=None; } -type export_logs_service_request_mutable = { - mutable resource_logs : Logs.resource_logs list; -} -let default_export_logs_service_request_mutable () : export_logs_service_request_mutable = { - resource_logs = []; -} +(** {2 Make functions} *) -type export_logs_partial_success_mutable = { - mutable rejected_log_records : int64; - mutable error_message : string; -} -let default_export_logs_partial_success_mutable () : export_logs_partial_success_mutable = { - rejected_log_records = 0L; - error_message = ""; -} +let[@inline] export_logs_service_request_set_resource_logs (self:export_logs_service_request) (x:Logs.resource_logs list) : unit = + self.resource_logs <- x -type export_logs_service_response_mutable = { - mutable partial_success : export_logs_partial_success option; -} +let copy_export_logs_service_request (self:export_logs_service_request) : export_logs_service_request = + { self with resource_logs = self.resource_logs } -let default_export_logs_service_response_mutable () : export_logs_service_response_mutable = { - partial_success = None; -} +let make_export_logs_service_request + ?(resource_logs=[]) + () : export_logs_service_request = + let _res = default_export_logs_service_request () in + export_logs_service_request_set_resource_logs _res resource_logs; + _res +let[@inline] export_logs_partial_success_has_rejected_log_records (self:export_logs_partial_success) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] export_logs_partial_success_has_error_message (self:export_logs_partial_success) : bool = (Pbrt.Bitfield.get self._presence 1) -(** {2 Make functions} *) +let[@inline] export_logs_partial_success_set_rejected_log_records (self:export_logs_partial_success) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.rejected_log_records <- x +let[@inline] export_logs_partial_success_set_error_message (self:export_logs_partial_success) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.error_message <- x -let rec make_export_logs_service_request - ~(resource_logs:Logs.resource_logs list) - () : export_logs_service_request = { - resource_logs; -} +let copy_export_logs_partial_success (self:export_logs_partial_success) : export_logs_partial_success = + { self with rejected_log_records = self.rejected_log_records } -let rec make_export_logs_partial_success - ~(rejected_log_records:int64) - ~(error_message:string) - () : export_logs_partial_success = { - rejected_log_records; - error_message; -} +let make_export_logs_partial_success + ?(rejected_log_records:int64 option) + ?(error_message:string option) + () : export_logs_partial_success = + let _res = default_export_logs_partial_success () in + (match rejected_log_records with + | None -> () + | Some v -> export_logs_partial_success_set_rejected_log_records _res v); + (match error_message with + | None -> () + | Some v -> export_logs_partial_success_set_error_message _res v); + _res -let rec make_export_logs_service_response - ?partial_success:((partial_success:export_logs_partial_success option) = None) - () : export_logs_service_response = { - partial_success; -} -[@@@ocaml.warning "-27-30-39"] +let[@inline] export_logs_service_response_set_partial_success (self:export_logs_service_response) (x:export_logs_partial_success) : unit = + self.partial_success <- Some x + +let copy_export_logs_service_response (self:export_logs_service_response) : export_logs_service_response = + { self with partial_success = self.partial_success } + +let make_export_logs_service_response + ?(partial_success:export_logs_partial_success option) + () : export_logs_service_response = + let _res = default_export_logs_service_response () in + (match partial_success with + | None -> () + | Some v -> export_logs_service_response_set_partial_success _res v); + _res + +[@@@ocaml.warning "-23-27-30-39"] (** {2 Formatters} *) @@ -94,8 +100,8 @@ let rec pp_export_logs_service_request fmt (v:export_logs_service_request) = let rec pp_export_logs_partial_success fmt (v:export_logs_partial_success) = let pp_i fmt () = - Pbrt.Pp.pp_record_field ~first:true "rejected_log_records" Pbrt.Pp.pp_int64 fmt v.rejected_log_records; - Pbrt.Pp.pp_record_field ~first:false "error_message" Pbrt.Pp.pp_string fmt v.error_message; + Pbrt.Pp.pp_record_field ~absent:(not (export_logs_partial_success_has_rejected_log_records v)) ~first:true "rejected_log_records" Pbrt.Pp.pp_int64 fmt v.rejected_log_records; + Pbrt.Pp.pp_record_field ~absent:(not (export_logs_partial_success_has_error_message v)) ~first:false "error_message" Pbrt.Pp.pp_string fmt v.error_message; in Pbrt.Pp.pp_brk pp_i fmt () @@ -105,22 +111,26 @@ let rec pp_export_logs_service_response fmt (v:export_logs_service_response) = in Pbrt.Pp.pp_brk pp_i fmt () -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Encoding} *) let rec encode_pb_export_logs_service_request (v:export_logs_service_request) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested Logs.encode_pb_resource_logs x encoder; Pbrt.Encoder.key 1 Pbrt.Bytes encoder; ) v.resource_logs encoder; () let rec encode_pb_export_logs_partial_success (v:export_logs_partial_success) encoder = - Pbrt.Encoder.int64_as_varint v.rejected_log_records encoder; - Pbrt.Encoder.key 1 Pbrt.Varint encoder; - Pbrt.Encoder.string v.error_message encoder; - Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + if export_logs_partial_success_has_rejected_log_records v then ( + Pbrt.Encoder.int64_as_varint v.rejected_log_records encoder; + Pbrt.Encoder.key 1 Pbrt.Varint encoder; + ); + if export_logs_partial_success_has_error_message v then ( + Pbrt.Encoder.string v.error_message encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + ); () let rec encode_pb_export_logs_service_response (v:export_logs_service_response) encoder = @@ -132,67 +142,149 @@ let rec encode_pb_export_logs_service_response (v:export_logs_service_response) end; () -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Decoding} *) let rec decode_pb_export_logs_service_request d = - let v = default_export_logs_service_request_mutable () in + let v = default_export_logs_service_request () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.resource_logs <- List.rev v.resource_logs; + (* put lists in the correct order *) + export_logs_service_request_set_resource_logs v (List.rev v.resource_logs); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.resource_logs <- (Logs.decode_pb_resource_logs (Pbrt.Decoder.nested d)) :: v.resource_logs; + export_logs_service_request_set_resource_logs v ((Logs.decode_pb_resource_logs (Pbrt.Decoder.nested d)) :: v.resource_logs); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(export_logs_service_request), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "export_logs_service_request" 1 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - resource_logs = v.resource_logs; - } : export_logs_service_request) + (v : export_logs_service_request) let rec decode_pb_export_logs_partial_success d = - let v = default_export_logs_partial_success_mutable () in + let v = default_export_logs_partial_success () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( ); continue__ := false | Some (1, Pbrt.Varint) -> begin - v.rejected_log_records <- Pbrt.Decoder.int64_as_varint d; + export_logs_partial_success_set_rejected_log_records v (Pbrt.Decoder.int64_as_varint d); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(export_logs_partial_success), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "export_logs_partial_success" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.error_message <- Pbrt.Decoder.string d; + export_logs_partial_success_set_error_message v (Pbrt.Decoder.string d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(export_logs_partial_success), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "export_logs_partial_success" 2 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - rejected_log_records = v.rejected_log_records; - error_message = v.error_message; - } : export_logs_partial_success) + (v : export_logs_partial_success) let rec decode_pb_export_logs_service_response d = - let v = default_export_logs_service_response_mutable () in + let v = default_export_logs_service_response () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.partial_success <- Some (decode_pb_export_logs_partial_success (Pbrt.Decoder.nested d)); + export_logs_service_response_set_partial_success v (decode_pb_export_logs_partial_success (Pbrt.Decoder.nested d)); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(export_logs_service_response), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "export_logs_service_response" 1 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; + (v : export_logs_service_response) + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 Protobuf YoJson Encoding} *) + +let rec encode_json_export_logs_service_request (v:export_logs_service_request) = + let assoc = ref [] in + assoc := ( + let l = v.resource_logs |> List.map Logs.encode_json_resource_logs in + ("resourceLogs", `List l) :: !assoc + ); + `Assoc !assoc + +let rec encode_json_export_logs_partial_success (v:export_logs_partial_success) = + let assoc = ref [] in + if export_logs_partial_success_has_rejected_log_records v then ( + assoc := ("rejectedLogRecords", Pbrt_yojson.make_string (Int64.to_string v.rejected_log_records)) :: !assoc; + ); + if export_logs_partial_success_has_error_message v then ( + assoc := ("errorMessage", Pbrt_yojson.make_string v.error_message) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_export_logs_service_response (v:export_logs_service_response) = + let assoc = ref [] in + assoc := (match v.partial_success with + | None -> !assoc + | Some v -> ("partialSuccess", encode_json_export_logs_partial_success v) :: !assoc); + `Assoc !assoc + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 JSON Decoding} *) + +let rec decode_json_export_logs_service_request d = + let v = default_export_logs_service_request () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("resourceLogs", `List l) -> begin + export_logs_service_request_set_resource_logs v @@ List.map (function + | json_value -> (Logs.decode_json_resource_logs json_value) + ) l; + end + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + resource_logs = v.resource_logs; + } : export_logs_service_request) + +let rec decode_json_export_logs_partial_success d = + let v = default_export_logs_partial_success () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("rejectedLogRecords", json_value) -> + export_logs_partial_success_set_rejected_log_records v (Pbrt_yojson.int64 json_value "export_logs_partial_success" "rejected_log_records") + | ("errorMessage", json_value) -> + export_logs_partial_success_set_error_message v (Pbrt_yojson.string json_value "export_logs_partial_success" "error_message") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + rejected_log_records = v.rejected_log_records; + error_message = v.error_message; + } : export_logs_partial_success) + +let rec decode_json_export_logs_service_response d = + let v = default_export_logs_service_response () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("partialSuccess", json_value) -> + export_logs_service_response_set_partial_success v (decode_json_export_logs_partial_success json_value) + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; ({ partial_success = v.partial_success; } : export_logs_service_response) diff --git a/src/proto/logs_service.mli b/src/proto/logs_service.mli index 5e3f24d9d..437d0c29e 100644 --- a/src/proto/logs_service.mli +++ b/src/proto/logs_service.mli @@ -7,63 +7,78 @@ (** {2 Types} *) -type export_logs_service_request = { - resource_logs : Logs.resource_logs list; +type export_logs_service_request = private { + mutable resource_logs : Logs.resource_logs list; } -type export_logs_partial_success = { - rejected_log_records : int64; - error_message : string; +type export_logs_partial_success = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 2 fields *) + mutable rejected_log_records : int64; + mutable error_message : string; } -type export_logs_service_response = { - partial_success : export_logs_partial_success option; +type export_logs_service_response = private { + mutable partial_success : export_logs_partial_success option; } (** {2 Basic values} *) -val default_export_logs_service_request : - ?resource_logs:Logs.resource_logs list -> - unit -> - export_logs_service_request -(** [default_export_logs_service_request ()] is the default value for type [export_logs_service_request] *) +val default_export_logs_service_request : unit -> export_logs_service_request +(** [default_export_logs_service_request ()] is a new empty value for type [export_logs_service_request] *) -val default_export_logs_partial_success : - ?rejected_log_records:int64 -> - ?error_message:string -> - unit -> - export_logs_partial_success -(** [default_export_logs_partial_success ()] is the default value for type [export_logs_partial_success] *) +val default_export_logs_partial_success : unit -> export_logs_partial_success +(** [default_export_logs_partial_success ()] is a new empty value for type [export_logs_partial_success] *) -val default_export_logs_service_response : - ?partial_success:export_logs_partial_success option -> - unit -> - export_logs_service_response -(** [default_export_logs_service_response ()] is the default value for type [export_logs_service_response] *) +val default_export_logs_service_response : unit -> export_logs_service_response +(** [default_export_logs_service_response ()] is a new empty value for type [export_logs_service_response] *) (** {2 Make functions} *) val make_export_logs_service_request : - resource_logs:Logs.resource_logs list -> + ?resource_logs:Logs.resource_logs list -> unit -> export_logs_service_request (** [make_export_logs_service_request … ()] is a builder for type [export_logs_service_request] *) +val copy_export_logs_service_request : export_logs_service_request -> export_logs_service_request + +val export_logs_service_request_set_resource_logs : export_logs_service_request -> Logs.resource_logs list -> unit + (** set field resource_logs in export_logs_service_request *) + val make_export_logs_partial_success : - rejected_log_records:int64 -> - error_message:string -> + ?rejected_log_records:int64 -> + ?error_message:string -> unit -> export_logs_partial_success (** [make_export_logs_partial_success … ()] is a builder for type [export_logs_partial_success] *) +val copy_export_logs_partial_success : export_logs_partial_success -> export_logs_partial_success + +val export_logs_partial_success_has_rejected_log_records : export_logs_partial_success -> bool + (** presence of field "rejected_log_records" in [export_logs_partial_success] *) + +val export_logs_partial_success_set_rejected_log_records : export_logs_partial_success -> int64 -> unit + (** set field rejected_log_records in export_logs_partial_success *) + +val export_logs_partial_success_has_error_message : export_logs_partial_success -> bool + (** presence of field "error_message" in [export_logs_partial_success] *) + +val export_logs_partial_success_set_error_message : export_logs_partial_success -> string -> unit + (** set field error_message in export_logs_partial_success *) + val make_export_logs_service_response : - ?partial_success:export_logs_partial_success option -> + ?partial_success:export_logs_partial_success -> unit -> export_logs_service_response (** [make_export_logs_service_response … ()] is a builder for type [export_logs_service_response] *) +val copy_export_logs_service_response : export_logs_service_response -> export_logs_service_response + +val export_logs_service_response_set_partial_success : export_logs_service_response -> export_logs_partial_success -> unit + (** set field partial_success in export_logs_service_response *) + (** {2 Formatters} *) @@ -99,3 +114,27 @@ val decode_pb_export_logs_partial_success : Pbrt.Decoder.t -> export_logs_partia val decode_pb_export_logs_service_response : Pbrt.Decoder.t -> export_logs_service_response (** [decode_pb_export_logs_service_response decoder] decodes a [export_logs_service_response] binary value from [decoder] *) + + +(** {2 Protobuf YoJson Encoding} *) + +val encode_json_export_logs_service_request : export_logs_service_request -> Yojson.Basic.t +(** [encode_json_export_logs_service_request v encoder] encodes [v] to to json *) + +val encode_json_export_logs_partial_success : export_logs_partial_success -> Yojson.Basic.t +(** [encode_json_export_logs_partial_success v encoder] encodes [v] to to json *) + +val encode_json_export_logs_service_response : export_logs_service_response -> Yojson.Basic.t +(** [encode_json_export_logs_service_response v encoder] encodes [v] to to json *) + + +(** {2 JSON Decoding} *) + +val decode_json_export_logs_service_request : Yojson.Basic.t -> export_logs_service_request +(** [decode_json_export_logs_service_request decoder] decodes a [export_logs_service_request] value from [decoder] *) + +val decode_json_export_logs_partial_success : Yojson.Basic.t -> export_logs_partial_success +(** [decode_json_export_logs_partial_success decoder] decodes a [export_logs_partial_success] value from [decoder] *) + +val decode_json_export_logs_service_response : Yojson.Basic.t -> export_logs_service_response +(** [decode_json_export_logs_service_response decoder] decodes a [export_logs_service_response] value from [decoder] *) diff --git a/src/proto/metrics.ml b/src/proto/metrics.ml index a829c10ba..bb6057f4b 100644 --- a/src/proto/metrics.ml +++ b/src/proto/metrics.ml @@ -1,509 +1,107 @@ -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39-44"] type exemplar_value = | As_double of float | As_int of int64 and exemplar = { - filtered_attributes : Common.key_value list; - time_unix_nano : int64; - value : exemplar_value; - span_id : bytes; - trace_id : bytes; -} - -type number_data_point_value = - | As_double of float - | As_int of int64 - -and number_data_point = { - attributes : Common.key_value list; - start_time_unix_nano : int64; - time_unix_nano : int64; - value : number_data_point_value; - exemplars : exemplar list; - flags : int32; -} - -type gauge = { - data_points : number_data_point list; -} - -type aggregation_temporality = - | Aggregation_temporality_unspecified - | Aggregation_temporality_delta - | Aggregation_temporality_cumulative - -type sum = { - data_points : number_data_point list; - aggregation_temporality : aggregation_temporality; - is_monotonic : bool; -} - -type histogram_data_point = { - attributes : Common.key_value list; - start_time_unix_nano : int64; - time_unix_nano : int64; - count : int64; - sum : float option; - bucket_counts : int64 list; - explicit_bounds : float list; - exemplars : exemplar list; - flags : int32; - min : float option; - max : float option; -} - -type histogram = { - data_points : histogram_data_point list; - aggregation_temporality : aggregation_temporality; -} - -type exponential_histogram_data_point_buckets = { - offset : int32; - bucket_counts : int64 list; -} - -type exponential_histogram_data_point = { - attributes : Common.key_value list; - start_time_unix_nano : int64; - time_unix_nano : int64; - count : int64; - sum : float option; - scale : int32; - zero_count : int64; - positive : exponential_histogram_data_point_buckets option; - negative : exponential_histogram_data_point_buckets option; - flags : int32; - exemplars : exemplar list; - min : float option; - max : float option; - zero_threshold : float; -} - -type exponential_histogram = { - data_points : exponential_histogram_data_point list; - aggregation_temporality : aggregation_temporality; -} - -type summary_data_point_value_at_quantile = { - quantile : float; - value : float; -} - -type summary_data_point = { - attributes : Common.key_value list; - start_time_unix_nano : int64; - time_unix_nano : int64; - count : int64; - sum : float; - quantile_values : summary_data_point_value_at_quantile list; - flags : int32; -} - -type summary = { - data_points : summary_data_point list; -} - -type metric_data = - | Gauge of gauge - | Sum of sum - | Histogram of histogram - | Exponential_histogram of exponential_histogram - | Summary of summary - -and metric = { - name : string; - description : string; - unit_ : string; - data : metric_data; -} - -type scope_metrics = { - scope : Common.instrumentation_scope option; - metrics : metric list; - schema_url : string; -} - -type resource_metrics = { - resource : Resource.resource option; - scope_metrics : scope_metrics list; - schema_url : string; -} - -type metrics_data = { - resource_metrics : resource_metrics list; -} - -type data_point_flags = - | Data_point_flags_do_not_use - | Data_point_flags_no_recorded_value_mask - -let rec default_exemplar_value () : exemplar_value = As_double (0.) - -and default_exemplar - ?filtered_attributes:((filtered_attributes:Common.key_value list) = []) - ?time_unix_nano:((time_unix_nano:int64) = 0L) - ?value:((value:exemplar_value) = As_double (0.)) - ?span_id:((span_id:bytes) = Bytes.create 0) - ?trace_id:((trace_id:bytes) = Bytes.create 0) - () : exemplar = { - filtered_attributes; - time_unix_nano; - value; - span_id; - trace_id; -} - -let rec default_number_data_point_value () : number_data_point_value = As_double (0.) - -and default_number_data_point - ?attributes:((attributes:Common.key_value list) = []) - ?start_time_unix_nano:((start_time_unix_nano:int64) = 0L) - ?time_unix_nano:((time_unix_nano:int64) = 0L) - ?value:((value:number_data_point_value) = As_double (0.)) - ?exemplars:((exemplars:exemplar list) = []) - ?flags:((flags:int32) = 0l) - () : number_data_point = { - attributes; - start_time_unix_nano; - time_unix_nano; - value; - exemplars; - flags; -} - -let rec default_gauge - ?data_points:((data_points:number_data_point list) = []) - () : gauge = { - data_points; -} - -let rec default_aggregation_temporality () = (Aggregation_temporality_unspecified:aggregation_temporality) - -let rec default_sum - ?data_points:((data_points:number_data_point list) = []) - ?aggregation_temporality:((aggregation_temporality:aggregation_temporality) = default_aggregation_temporality ()) - ?is_monotonic:((is_monotonic:bool) = false) - () : sum = { - data_points; - aggregation_temporality; - is_monotonic; -} - -let rec default_histogram_data_point - ?attributes:((attributes:Common.key_value list) = []) - ?start_time_unix_nano:((start_time_unix_nano:int64) = 0L) - ?time_unix_nano:((time_unix_nano:int64) = 0L) - ?count:((count:int64) = 0L) - ?sum:((sum:float option) = None) - ?bucket_counts:((bucket_counts:int64 list) = []) - ?explicit_bounds:((explicit_bounds:float list) = []) - ?exemplars:((exemplars:exemplar list) = []) - ?flags:((flags:int32) = 0l) - ?min:((min:float option) = None) - ?max:((max:float option) = None) - () : histogram_data_point = { - attributes; - start_time_unix_nano; - time_unix_nano; - count; - sum; - bucket_counts; - explicit_bounds; - exemplars; - flags; - min; - max; -} - -let rec default_histogram - ?data_points:((data_points:histogram_data_point list) = []) - ?aggregation_temporality:((aggregation_temporality:aggregation_temporality) = default_aggregation_temporality ()) - () : histogram = { - data_points; - aggregation_temporality; -} - -let rec default_exponential_histogram_data_point_buckets - ?offset:((offset:int32) = 0l) - ?bucket_counts:((bucket_counts:int64 list) = []) - () : exponential_histogram_data_point_buckets = { - offset; - bucket_counts; -} - -let rec default_exponential_histogram_data_point - ?attributes:((attributes:Common.key_value list) = []) - ?start_time_unix_nano:((start_time_unix_nano:int64) = 0L) - ?time_unix_nano:((time_unix_nano:int64) = 0L) - ?count:((count:int64) = 0L) - ?sum:((sum:float option) = None) - ?scale:((scale:int32) = 0l) - ?zero_count:((zero_count:int64) = 0L) - ?positive:((positive:exponential_histogram_data_point_buckets option) = None) - ?negative:((negative:exponential_histogram_data_point_buckets option) = None) - ?flags:((flags:int32) = 0l) - ?exemplars:((exemplars:exemplar list) = []) - ?min:((min:float option) = None) - ?max:((max:float option) = None) - ?zero_threshold:((zero_threshold:float) = 0.) - () : exponential_histogram_data_point = { - attributes; - start_time_unix_nano; - time_unix_nano; - count; - sum; - scale; - zero_count; - positive; - negative; - flags; - exemplars; - min; - max; - zero_threshold; -} - -let rec default_exponential_histogram - ?data_points:((data_points:exponential_histogram_data_point list) = []) - ?aggregation_temporality:((aggregation_temporality:aggregation_temporality) = default_aggregation_temporality ()) - () : exponential_histogram = { - data_points; - aggregation_temporality; -} - -let rec default_summary_data_point_value_at_quantile - ?quantile:((quantile:float) = 0.) - ?value:((value:float) = 0.) - () : summary_data_point_value_at_quantile = { - quantile; - value; -} - -let rec default_summary_data_point - ?attributes:((attributes:Common.key_value list) = []) - ?start_time_unix_nano:((start_time_unix_nano:int64) = 0L) - ?time_unix_nano:((time_unix_nano:int64) = 0L) - ?count:((count:int64) = 0L) - ?sum:((sum:float) = 0.) - ?quantile_values:((quantile_values:summary_data_point_value_at_quantile list) = []) - ?flags:((flags:int32) = 0l) - () : summary_data_point = { - attributes; - start_time_unix_nano; - time_unix_nano; - count; - sum; - quantile_values; - flags; -} - -let rec default_summary - ?data_points:((data_points:summary_data_point list) = []) - () : summary = { - data_points; -} - -let rec default_metric_data () : metric_data = Gauge (default_gauge ()) - -and default_metric - ?name:((name:string) = "") - ?description:((description:string) = "") - ?unit_:((unit_:string) = "") - ?data:((data:metric_data) = Gauge (default_gauge ())) - () : metric = { - name; - description; - unit_; - data; -} - -let rec default_scope_metrics - ?scope:((scope:Common.instrumentation_scope option) = None) - ?metrics:((metrics:metric list) = []) - ?schema_url:((schema_url:string) = "") - () : scope_metrics = { - scope; - metrics; - schema_url; -} - -let rec default_resource_metrics - ?resource:((resource:Resource.resource option) = None) - ?scope_metrics:((scope_metrics:scope_metrics list) = []) - ?schema_url:((schema_url:string) = "") - () : resource_metrics = { - resource; - scope_metrics; - schema_url; -} - -let rec default_metrics_data - ?resource_metrics:((resource_metrics:resource_metrics list) = []) - () : metrics_data = { - resource_metrics; -} - -let rec default_data_point_flags () = (Data_point_flags_do_not_use:data_point_flags) - -type exemplar_mutable = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 3 fields *) mutable filtered_attributes : Common.key_value list; mutable time_unix_nano : int64; - mutable value : exemplar_value; + mutable value : exemplar_value option; mutable span_id : bytes; mutable trace_id : bytes; } -let default_exemplar_mutable () : exemplar_mutable = { - filtered_attributes = []; - time_unix_nano = 0L; - value = As_double (0.); - span_id = Bytes.create 0; - trace_id = Bytes.create 0; -} +type number_data_point_value = + | As_double of float + | As_int of int64 -type number_data_point_mutable = { +and number_data_point = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 3 fields *) mutable attributes : Common.key_value list; mutable start_time_unix_nano : int64; mutable time_unix_nano : int64; - mutable value : number_data_point_value; + mutable value : number_data_point_value option; mutable exemplars : exemplar list; mutable flags : int32; } -let default_number_data_point_mutable () : number_data_point_mutable = { - attributes = []; - start_time_unix_nano = 0L; - time_unix_nano = 0L; - value = As_double (0.); - exemplars = []; - flags = 0l; -} - -type gauge_mutable = { +type gauge = { mutable data_points : number_data_point list; } -let default_gauge_mutable () : gauge_mutable = { - data_points = []; -} +type aggregation_temporality = + | Aggregation_temporality_unspecified + | Aggregation_temporality_delta + | Aggregation_temporality_cumulative -type sum_mutable = { +type sum = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 2 fields *) mutable data_points : number_data_point list; mutable aggregation_temporality : aggregation_temporality; mutable is_monotonic : bool; } -let default_sum_mutable () : sum_mutable = { - data_points = []; - aggregation_temporality = default_aggregation_temporality (); - is_monotonic = false; -} - -type histogram_data_point_mutable = { +type histogram_data_point = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 7 fields *) mutable attributes : Common.key_value list; mutable start_time_unix_nano : int64; mutable time_unix_nano : int64; mutable count : int64; - mutable sum : float option; + mutable sum : float; mutable bucket_counts : int64 list; mutable explicit_bounds : float list; mutable exemplars : exemplar list; mutable flags : int32; - mutable min : float option; - mutable max : float option; -} - -let default_histogram_data_point_mutable () : histogram_data_point_mutable = { - attributes = []; - start_time_unix_nano = 0L; - time_unix_nano = 0L; - count = 0L; - sum = None; - bucket_counts = []; - explicit_bounds = []; - exemplars = []; - flags = 0l; - min = None; - max = None; + mutable min : float; + mutable max : float; } -type histogram_mutable = { +type histogram = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) mutable data_points : histogram_data_point list; mutable aggregation_temporality : aggregation_temporality; } -let default_histogram_mutable () : histogram_mutable = { - data_points = []; - aggregation_temporality = default_aggregation_temporality (); -} - -type exponential_histogram_data_point_buckets_mutable = { +type exponential_histogram_data_point_buckets = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) mutable offset : int32; mutable bucket_counts : int64 list; } -let default_exponential_histogram_data_point_buckets_mutable () : exponential_histogram_data_point_buckets_mutable = { - offset = 0l; - bucket_counts = []; -} - -type exponential_histogram_data_point_mutable = { +type exponential_histogram_data_point = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 10 fields *) mutable attributes : Common.key_value list; mutable start_time_unix_nano : int64; mutable time_unix_nano : int64; mutable count : int64; - mutable sum : float option; + mutable sum : float; mutable scale : int32; mutable zero_count : int64; mutable positive : exponential_histogram_data_point_buckets option; mutable negative : exponential_histogram_data_point_buckets option; mutable flags : int32; mutable exemplars : exemplar list; - mutable min : float option; - mutable max : float option; + mutable min : float; + mutable max : float; mutable zero_threshold : float; } -let default_exponential_histogram_data_point_mutable () : exponential_histogram_data_point_mutable = { - attributes = []; - start_time_unix_nano = 0L; - time_unix_nano = 0L; - count = 0L; - sum = None; - scale = 0l; - zero_count = 0L; - positive = None; - negative = None; - flags = 0l; - exemplars = []; - min = None; - max = None; - zero_threshold = 0.; -} - -type exponential_histogram_mutable = { +type exponential_histogram = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) mutable data_points : exponential_histogram_data_point list; mutable aggregation_temporality : aggregation_temporality; } -let default_exponential_histogram_mutable () : exponential_histogram_mutable = { - data_points = []; - aggregation_temporality = default_aggregation_temporality (); -} - -type summary_data_point_value_at_quantile_mutable = { +type summary_data_point_value_at_quantile = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 2 fields *) mutable quantile : float; mutable value : float; } -let default_summary_data_point_value_at_quantile_mutable () : summary_data_point_value_at_quantile_mutable = { - quantile = 0.; - value = 0.; -} - -type summary_data_point_mutable = { +type summary_data_point = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 5 fields *) mutable attributes : Common.key_value list; mutable start_time_unix_nano : int64; mutable time_unix_nano : int64; @@ -513,277 +111,773 @@ type summary_data_point_mutable = { mutable flags : int32; } -let default_summary_data_point_mutable () : summary_data_point_mutable = { - attributes = []; - start_time_unix_nano = 0L; - time_unix_nano = 0L; - count = 0L; - sum = 0.; - quantile_values = []; - flags = 0l; -} - -type summary_mutable = { +type summary = { mutable data_points : summary_data_point list; } -let default_summary_mutable () : summary_mutable = { - data_points = []; -} +type metric_data = + | Gauge of gauge + | Sum of sum + | Histogram of histogram + | Exponential_histogram of exponential_histogram + | Summary of summary -type metric_mutable = { +and metric = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 3 fields *) mutable name : string; mutable description : string; mutable unit_ : string; - mutable data : metric_data; + mutable data : metric_data option; + mutable metadata : Common.key_value list; } -let default_metric_mutable () : metric_mutable = { - name = ""; - description = ""; - unit_ = ""; - data = Gauge (default_gauge ()); -} - -type scope_metrics_mutable = { +type scope_metrics = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) mutable scope : Common.instrumentation_scope option; mutable metrics : metric list; mutable schema_url : string; } -let default_scope_metrics_mutable () : scope_metrics_mutable = { - scope = None; - metrics = []; - schema_url = ""; -} - -type resource_metrics_mutable = { +type resource_metrics = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) mutable resource : Resource.resource option; mutable scope_metrics : scope_metrics list; mutable schema_url : string; } -let default_resource_metrics_mutable () : resource_metrics_mutable = { - resource = None; - scope_metrics = []; - schema_url = ""; -} - -type metrics_data_mutable = { +type metrics_data = { mutable resource_metrics : resource_metrics list; } -let default_metrics_data_mutable () : metrics_data_mutable = { - resource_metrics = []; -} - - -(** {2 Make functions} *) - - -let rec make_exemplar - ~(filtered_attributes:Common.key_value list) - ~(time_unix_nano:int64) - ~(value:exemplar_value) - ~(span_id:bytes) - ~(trace_id:bytes) - () : exemplar = { - filtered_attributes; - time_unix_nano; - value; - span_id; - trace_id; -} - - -let rec make_number_data_point - ~(attributes:Common.key_value list) - ~(start_time_unix_nano:int64) - ~(time_unix_nano:int64) - ~(value:number_data_point_value) - ~(exemplars:exemplar list) - ~(flags:int32) - () : number_data_point = { - attributes; - start_time_unix_nano; - time_unix_nano; - value; - exemplars; - flags; -} - -let rec make_gauge - ~(data_points:number_data_point list) - () : gauge = { - data_points; -} +type data_point_flags = + | Data_point_flags_do_not_use + | Data_point_flags_no_recorded_value_mask +let default_exemplar_value (): exemplar_value = As_double (0.) + +let default_exemplar (): exemplar = +{ + _presence=Pbrt.Bitfield.empty; + filtered_attributes=[]; + time_unix_nano=0L; + value=None; + span_id=Bytes.create 0; + trace_id=Bytes.create 0; +} + +let default_number_data_point_value (): number_data_point_value = As_double (0.) + +let default_number_data_point (): number_data_point = +{ + _presence=Pbrt.Bitfield.empty; + attributes=[]; + start_time_unix_nano=0L; + time_unix_nano=0L; + value=None; + exemplars=[]; + flags=0l; +} + +let default_gauge (): gauge = +{ + data_points=[]; +} + +let default_aggregation_temporality () = (Aggregation_temporality_unspecified:aggregation_temporality) + +let default_sum (): sum = +{ + _presence=Pbrt.Bitfield.empty; + data_points=[]; + aggregation_temporality=default_aggregation_temporality (); + is_monotonic=false; +} + +let default_histogram_data_point (): histogram_data_point = +{ + _presence=Pbrt.Bitfield.empty; + attributes=[]; + start_time_unix_nano=0L; + time_unix_nano=0L; + count=0L; + sum=0.; + bucket_counts=[]; + explicit_bounds=[]; + exemplars=[]; + flags=0l; + min=0.; + max=0.; +} -let rec make_sum - ~(data_points:number_data_point list) - ~(aggregation_temporality:aggregation_temporality) - ~(is_monotonic:bool) - () : sum = { - data_points; - aggregation_temporality; - is_monotonic; +let default_histogram (): histogram = +{ + _presence=Pbrt.Bitfield.empty; + data_points=[]; + aggregation_temporality=default_aggregation_temporality (); } -let rec make_histogram_data_point - ~(attributes:Common.key_value list) - ~(start_time_unix_nano:int64) - ~(time_unix_nano:int64) - ~(count:int64) - ?sum:((sum:float option) = None) - ~(bucket_counts:int64 list) - ~(explicit_bounds:float list) - ~(exemplars:exemplar list) - ~(flags:int32) - ?min:((min:float option) = None) - ?max:((max:float option) = None) - () : histogram_data_point = { - attributes; - start_time_unix_nano; - time_unix_nano; - count; - sum; - bucket_counts; - explicit_bounds; - exemplars; - flags; - min; - max; +let default_exponential_histogram_data_point_buckets (): exponential_histogram_data_point_buckets = +{ + _presence=Pbrt.Bitfield.empty; + offset=0l; + bucket_counts=[]; } -let rec make_histogram - ~(data_points:histogram_data_point list) - ~(aggregation_temporality:aggregation_temporality) - () : histogram = { - data_points; - aggregation_temporality; +let default_exponential_histogram_data_point (): exponential_histogram_data_point = +{ + _presence=Pbrt.Bitfield.empty; + attributes=[]; + start_time_unix_nano=0L; + time_unix_nano=0L; + count=0L; + sum=0.; + scale=0l; + zero_count=0L; + positive=None; + negative=None; + flags=0l; + exemplars=[]; + min=0.; + max=0.; + zero_threshold=0.; } -let rec make_exponential_histogram_data_point_buckets - ~(offset:int32) - ~(bucket_counts:int64 list) - () : exponential_histogram_data_point_buckets = { - offset; - bucket_counts; +let default_exponential_histogram (): exponential_histogram = +{ + _presence=Pbrt.Bitfield.empty; + data_points=[]; + aggregation_temporality=default_aggregation_temporality (); } -let rec make_exponential_histogram_data_point - ~(attributes:Common.key_value list) - ~(start_time_unix_nano:int64) - ~(time_unix_nano:int64) - ~(count:int64) - ?sum:((sum:float option) = None) - ~(scale:int32) - ~(zero_count:int64) - ?positive:((positive:exponential_histogram_data_point_buckets option) = None) - ?negative:((negative:exponential_histogram_data_point_buckets option) = None) - ~(flags:int32) - ~(exemplars:exemplar list) - ?min:((min:float option) = None) - ?max:((max:float option) = None) - ~(zero_threshold:float) - () : exponential_histogram_data_point = { - attributes; - start_time_unix_nano; - time_unix_nano; - count; - sum; - scale; - zero_count; - positive; - negative; - flags; - exemplars; - min; - max; - zero_threshold; +let default_summary_data_point_value_at_quantile (): summary_data_point_value_at_quantile = +{ + _presence=Pbrt.Bitfield.empty; + quantile=0.; + value=0.; } - -let rec make_exponential_histogram - ~(data_points:exponential_histogram_data_point list) - ~(aggregation_temporality:aggregation_temporality) - () : exponential_histogram = { - data_points; - aggregation_temporality; + +let default_summary_data_point (): summary_data_point = +{ + _presence=Pbrt.Bitfield.empty; + attributes=[]; + start_time_unix_nano=0L; + time_unix_nano=0L; + count=0L; + sum=0.; + quantile_values=[]; + flags=0l; } - -let rec make_summary_data_point_value_at_quantile - ~(quantile:float) - ~(value:float) - () : summary_data_point_value_at_quantile = { - quantile; - value; + +let default_summary (): summary = +{ + data_points=[]; } -let rec make_summary_data_point - ~(attributes:Common.key_value list) - ~(start_time_unix_nano:int64) - ~(time_unix_nano:int64) - ~(count:int64) - ~(sum:float) - ~(quantile_values:summary_data_point_value_at_quantile list) - ~(flags:int32) - () : summary_data_point = { - attributes; - start_time_unix_nano; - time_unix_nano; - count; - sum; - quantile_values; - flags; -} +let default_metric_data (): metric_data = Gauge (default_gauge ()) -let rec make_summary - ~(data_points:summary_data_point list) - () : summary = { - data_points; +let default_metric (): metric = +{ + _presence=Pbrt.Bitfield.empty; + name=""; + description=""; + unit_=""; + data=None; + metadata=[]; +} + +let default_scope_metrics (): scope_metrics = +{ + _presence=Pbrt.Bitfield.empty; + scope=None; + metrics=[]; + schema_url=""; } - - -let rec make_metric - ~(name:string) - ~(description:string) - ~(unit_:string) - ~(data:metric_data) - () : metric = { - name; - description; - unit_; - data; + +let default_resource_metrics (): resource_metrics = +{ + _presence=Pbrt.Bitfield.empty; + resource=None; + scope_metrics=[]; + schema_url=""; } -let rec make_scope_metrics - ?scope:((scope:Common.instrumentation_scope option) = None) - ~(metrics:metric list) - ~(schema_url:string) - () : scope_metrics = { - scope; - metrics; - schema_url; +let default_metrics_data (): metrics_data = +{ + resource_metrics=[]; } -let rec make_resource_metrics - ?resource:((resource:Resource.resource option) = None) - ~(scope_metrics:scope_metrics list) - ~(schema_url:string) - () : resource_metrics = { - resource; - scope_metrics; - schema_url; -} +let default_data_point_flags () = (Data_point_flags_do_not_use:data_point_flags) -let rec make_metrics_data - ~(resource_metrics:resource_metrics list) - () : metrics_data = { - resource_metrics; -} +(** {2 Make functions} *) -[@@@ocaml.warning "-27-30-39"] +let[@inline] exemplar_has_time_unix_nano (self:exemplar) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] exemplar_has_span_id (self:exemplar) : bool = (Pbrt.Bitfield.get self._presence 1) +let[@inline] exemplar_has_trace_id (self:exemplar) : bool = (Pbrt.Bitfield.get self._presence 2) + +let[@inline] exemplar_set_filtered_attributes (self:exemplar) (x:Common.key_value list) : unit = + self.filtered_attributes <- x +let[@inline] exemplar_set_time_unix_nano (self:exemplar) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.time_unix_nano <- x +let[@inline] exemplar_set_value (self:exemplar) (x:exemplar_value) : unit = + self.value <- Some x +let[@inline] exemplar_set_span_id (self:exemplar) (x:bytes) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.span_id <- x +let[@inline] exemplar_set_trace_id (self:exemplar) (x:bytes) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 2); self.trace_id <- x + +let copy_exemplar (self:exemplar) : exemplar = + { self with filtered_attributes = self.filtered_attributes } + +let make_exemplar + ?(filtered_attributes=[]) + ?(time_unix_nano:int64 option) + ?(value:exemplar_value option) + ?(span_id:bytes option) + ?(trace_id:bytes option) + () : exemplar = + let _res = default_exemplar () in + exemplar_set_filtered_attributes _res filtered_attributes; + (match time_unix_nano with + | None -> () + | Some v -> exemplar_set_time_unix_nano _res v); + (match value with + | None -> () + | Some v -> exemplar_set_value _res v); + (match span_id with + | None -> () + | Some v -> exemplar_set_span_id _res v); + (match trace_id with + | None -> () + | Some v -> exemplar_set_trace_id _res v); + _res + +let[@inline] number_data_point_has_start_time_unix_nano (self:number_data_point) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] number_data_point_has_time_unix_nano (self:number_data_point) : bool = (Pbrt.Bitfield.get self._presence 1) +let[@inline] number_data_point_has_flags (self:number_data_point) : bool = (Pbrt.Bitfield.get self._presence 2) + +let[@inline] number_data_point_set_attributes (self:number_data_point) (x:Common.key_value list) : unit = + self.attributes <- x +let[@inline] number_data_point_set_start_time_unix_nano (self:number_data_point) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.start_time_unix_nano <- x +let[@inline] number_data_point_set_time_unix_nano (self:number_data_point) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.time_unix_nano <- x +let[@inline] number_data_point_set_value (self:number_data_point) (x:number_data_point_value) : unit = + self.value <- Some x +let[@inline] number_data_point_set_exemplars (self:number_data_point) (x:exemplar list) : unit = + self.exemplars <- x +let[@inline] number_data_point_set_flags (self:number_data_point) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 2); self.flags <- x + +let copy_number_data_point (self:number_data_point) : number_data_point = + { self with attributes = self.attributes } + +let make_number_data_point + ?(attributes=[]) + ?(start_time_unix_nano:int64 option) + ?(time_unix_nano:int64 option) + ?(value:number_data_point_value option) + ?(exemplars=[]) + ?(flags:int32 option) + () : number_data_point = + let _res = default_number_data_point () in + number_data_point_set_attributes _res attributes; + (match start_time_unix_nano with + | None -> () + | Some v -> number_data_point_set_start_time_unix_nano _res v); + (match time_unix_nano with + | None -> () + | Some v -> number_data_point_set_time_unix_nano _res v); + (match value with + | None -> () + | Some v -> number_data_point_set_value _res v); + number_data_point_set_exemplars _res exemplars; + (match flags with + | None -> () + | Some v -> number_data_point_set_flags _res v); + _res + + +let[@inline] gauge_set_data_points (self:gauge) (x:number_data_point list) : unit = + self.data_points <- x + +let copy_gauge (self:gauge) : gauge = + { self with data_points = self.data_points } + +let make_gauge + ?(data_points=[]) + () : gauge = + let _res = default_gauge () in + gauge_set_data_points _res data_points; + _res + +let[@inline] sum_has_aggregation_temporality (self:sum) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] sum_has_is_monotonic (self:sum) : bool = (Pbrt.Bitfield.get self._presence 1) + +let[@inline] sum_set_data_points (self:sum) (x:number_data_point list) : unit = + self.data_points <- x +let[@inline] sum_set_aggregation_temporality (self:sum) (x:aggregation_temporality) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.aggregation_temporality <- x +let[@inline] sum_set_is_monotonic (self:sum) (x:bool) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.is_monotonic <- x + +let copy_sum (self:sum) : sum = + { self with data_points = self.data_points } + +let make_sum + ?(data_points=[]) + ?(aggregation_temporality:aggregation_temporality option) + ?(is_monotonic:bool option) + () : sum = + let _res = default_sum () in + sum_set_data_points _res data_points; + (match aggregation_temporality with + | None -> () + | Some v -> sum_set_aggregation_temporality _res v); + (match is_monotonic with + | None -> () + | Some v -> sum_set_is_monotonic _res v); + _res + +let[@inline] histogram_data_point_has_start_time_unix_nano (self:histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] histogram_data_point_has_time_unix_nano (self:histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 1) +let[@inline] histogram_data_point_has_count (self:histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 2) +let[@inline] histogram_data_point_has_sum (self:histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 3) +let[@inline] histogram_data_point_has_flags (self:histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 4) +let[@inline] histogram_data_point_has_min (self:histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 5) +let[@inline] histogram_data_point_has_max (self:histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 6) + +let[@inline] histogram_data_point_set_attributes (self:histogram_data_point) (x:Common.key_value list) : unit = + self.attributes <- x +let[@inline] histogram_data_point_set_start_time_unix_nano (self:histogram_data_point) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.start_time_unix_nano <- x +let[@inline] histogram_data_point_set_time_unix_nano (self:histogram_data_point) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.time_unix_nano <- x +let[@inline] histogram_data_point_set_count (self:histogram_data_point) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 2); self.count <- x +let[@inline] histogram_data_point_set_sum (self:histogram_data_point) (x:float) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 3); self.sum <- x +let[@inline] histogram_data_point_set_bucket_counts (self:histogram_data_point) (x:int64 list) : unit = + self.bucket_counts <- x +let[@inline] histogram_data_point_set_explicit_bounds (self:histogram_data_point) (x:float list) : unit = + self.explicit_bounds <- x +let[@inline] histogram_data_point_set_exemplars (self:histogram_data_point) (x:exemplar list) : unit = + self.exemplars <- x +let[@inline] histogram_data_point_set_flags (self:histogram_data_point) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 4); self.flags <- x +let[@inline] histogram_data_point_set_min (self:histogram_data_point) (x:float) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 5); self.min <- x +let[@inline] histogram_data_point_set_max (self:histogram_data_point) (x:float) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 6); self.max <- x + +let copy_histogram_data_point (self:histogram_data_point) : histogram_data_point = + { self with attributes = self.attributes } + +let make_histogram_data_point + ?(attributes=[]) + ?(start_time_unix_nano:int64 option) + ?(time_unix_nano:int64 option) + ?(count:int64 option) + ?(sum:float option) + ?(bucket_counts=[]) + ?(explicit_bounds=[]) + ?(exemplars=[]) + ?(flags:int32 option) + ?(min:float option) + ?(max:float option) + () : histogram_data_point = + let _res = default_histogram_data_point () in + histogram_data_point_set_attributes _res attributes; + (match start_time_unix_nano with + | None -> () + | Some v -> histogram_data_point_set_start_time_unix_nano _res v); + (match time_unix_nano with + | None -> () + | Some v -> histogram_data_point_set_time_unix_nano _res v); + (match count with + | None -> () + | Some v -> histogram_data_point_set_count _res v); + (match sum with + | None -> () + | Some v -> histogram_data_point_set_sum _res v); + histogram_data_point_set_bucket_counts _res bucket_counts; + histogram_data_point_set_explicit_bounds _res explicit_bounds; + histogram_data_point_set_exemplars _res exemplars; + (match flags with + | None -> () + | Some v -> histogram_data_point_set_flags _res v); + (match min with + | None -> () + | Some v -> histogram_data_point_set_min _res v); + (match max with + | None -> () + | Some v -> histogram_data_point_set_max _res v); + _res + +let[@inline] histogram_has_aggregation_temporality (self:histogram) : bool = (Pbrt.Bitfield.get self._presence 0) + +let[@inline] histogram_set_data_points (self:histogram) (x:histogram_data_point list) : unit = + self.data_points <- x +let[@inline] histogram_set_aggregation_temporality (self:histogram) (x:aggregation_temporality) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.aggregation_temporality <- x + +let copy_histogram (self:histogram) : histogram = + { self with data_points = self.data_points } + +let make_histogram + ?(data_points=[]) + ?(aggregation_temporality:aggregation_temporality option) + () : histogram = + let _res = default_histogram () in + histogram_set_data_points _res data_points; + (match aggregation_temporality with + | None -> () + | Some v -> histogram_set_aggregation_temporality _res v); + _res + +let[@inline] exponential_histogram_data_point_buckets_has_offset (self:exponential_histogram_data_point_buckets) : bool = (Pbrt.Bitfield.get self._presence 0) + +let[@inline] exponential_histogram_data_point_buckets_set_offset (self:exponential_histogram_data_point_buckets) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.offset <- x +let[@inline] exponential_histogram_data_point_buckets_set_bucket_counts (self:exponential_histogram_data_point_buckets) (x:int64 list) : unit = + self.bucket_counts <- x + +let copy_exponential_histogram_data_point_buckets (self:exponential_histogram_data_point_buckets) : exponential_histogram_data_point_buckets = + { self with offset = self.offset } + +let make_exponential_histogram_data_point_buckets + ?(offset:int32 option) + ?(bucket_counts=[]) + () : exponential_histogram_data_point_buckets = + let _res = default_exponential_histogram_data_point_buckets () in + (match offset with + | None -> () + | Some v -> exponential_histogram_data_point_buckets_set_offset _res v); + exponential_histogram_data_point_buckets_set_bucket_counts _res bucket_counts; + _res + +let[@inline] exponential_histogram_data_point_has_start_time_unix_nano (self:exponential_histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] exponential_histogram_data_point_has_time_unix_nano (self:exponential_histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 1) +let[@inline] exponential_histogram_data_point_has_count (self:exponential_histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 2) +let[@inline] exponential_histogram_data_point_has_sum (self:exponential_histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 3) +let[@inline] exponential_histogram_data_point_has_scale (self:exponential_histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 4) +let[@inline] exponential_histogram_data_point_has_zero_count (self:exponential_histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 5) +let[@inline] exponential_histogram_data_point_has_flags (self:exponential_histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 6) +let[@inline] exponential_histogram_data_point_has_min (self:exponential_histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 7) +let[@inline] exponential_histogram_data_point_has_max (self:exponential_histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 8) +let[@inline] exponential_histogram_data_point_has_zero_threshold (self:exponential_histogram_data_point) : bool = (Pbrt.Bitfield.get self._presence 9) + +let[@inline] exponential_histogram_data_point_set_attributes (self:exponential_histogram_data_point) (x:Common.key_value list) : unit = + self.attributes <- x +let[@inline] exponential_histogram_data_point_set_start_time_unix_nano (self:exponential_histogram_data_point) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.start_time_unix_nano <- x +let[@inline] exponential_histogram_data_point_set_time_unix_nano (self:exponential_histogram_data_point) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.time_unix_nano <- x +let[@inline] exponential_histogram_data_point_set_count (self:exponential_histogram_data_point) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 2); self.count <- x +let[@inline] exponential_histogram_data_point_set_sum (self:exponential_histogram_data_point) (x:float) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 3); self.sum <- x +let[@inline] exponential_histogram_data_point_set_scale (self:exponential_histogram_data_point) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 4); self.scale <- x +let[@inline] exponential_histogram_data_point_set_zero_count (self:exponential_histogram_data_point) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 5); self.zero_count <- x +let[@inline] exponential_histogram_data_point_set_positive (self:exponential_histogram_data_point) (x:exponential_histogram_data_point_buckets) : unit = + self.positive <- Some x +let[@inline] exponential_histogram_data_point_set_negative (self:exponential_histogram_data_point) (x:exponential_histogram_data_point_buckets) : unit = + self.negative <- Some x +let[@inline] exponential_histogram_data_point_set_flags (self:exponential_histogram_data_point) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 6); self.flags <- x +let[@inline] exponential_histogram_data_point_set_exemplars (self:exponential_histogram_data_point) (x:exemplar list) : unit = + self.exemplars <- x +let[@inline] exponential_histogram_data_point_set_min (self:exponential_histogram_data_point) (x:float) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 7); self.min <- x +let[@inline] exponential_histogram_data_point_set_max (self:exponential_histogram_data_point) (x:float) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 8); self.max <- x +let[@inline] exponential_histogram_data_point_set_zero_threshold (self:exponential_histogram_data_point) (x:float) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 9); self.zero_threshold <- x + +let copy_exponential_histogram_data_point (self:exponential_histogram_data_point) : exponential_histogram_data_point = + { self with attributes = self.attributes } + +let make_exponential_histogram_data_point + ?(attributes=[]) + ?(start_time_unix_nano:int64 option) + ?(time_unix_nano:int64 option) + ?(count:int64 option) + ?(sum:float option) + ?(scale:int32 option) + ?(zero_count:int64 option) + ?(positive:exponential_histogram_data_point_buckets option) + ?(negative:exponential_histogram_data_point_buckets option) + ?(flags:int32 option) + ?(exemplars=[]) + ?(min:float option) + ?(max:float option) + ?(zero_threshold:float option) + () : exponential_histogram_data_point = + let _res = default_exponential_histogram_data_point () in + exponential_histogram_data_point_set_attributes _res attributes; + (match start_time_unix_nano with + | None -> () + | Some v -> exponential_histogram_data_point_set_start_time_unix_nano _res v); + (match time_unix_nano with + | None -> () + | Some v -> exponential_histogram_data_point_set_time_unix_nano _res v); + (match count with + | None -> () + | Some v -> exponential_histogram_data_point_set_count _res v); + (match sum with + | None -> () + | Some v -> exponential_histogram_data_point_set_sum _res v); + (match scale with + | None -> () + | Some v -> exponential_histogram_data_point_set_scale _res v); + (match zero_count with + | None -> () + | Some v -> exponential_histogram_data_point_set_zero_count _res v); + (match positive with + | None -> () + | Some v -> exponential_histogram_data_point_set_positive _res v); + (match negative with + | None -> () + | Some v -> exponential_histogram_data_point_set_negative _res v); + (match flags with + | None -> () + | Some v -> exponential_histogram_data_point_set_flags _res v); + exponential_histogram_data_point_set_exemplars _res exemplars; + (match min with + | None -> () + | Some v -> exponential_histogram_data_point_set_min _res v); + (match max with + | None -> () + | Some v -> exponential_histogram_data_point_set_max _res v); + (match zero_threshold with + | None -> () + | Some v -> exponential_histogram_data_point_set_zero_threshold _res v); + _res + +let[@inline] exponential_histogram_has_aggregation_temporality (self:exponential_histogram) : bool = (Pbrt.Bitfield.get self._presence 0) + +let[@inline] exponential_histogram_set_data_points (self:exponential_histogram) (x:exponential_histogram_data_point list) : unit = + self.data_points <- x +let[@inline] exponential_histogram_set_aggregation_temporality (self:exponential_histogram) (x:aggregation_temporality) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.aggregation_temporality <- x + +let copy_exponential_histogram (self:exponential_histogram) : exponential_histogram = + { self with data_points = self.data_points } + +let make_exponential_histogram + ?(data_points=[]) + ?(aggregation_temporality:aggregation_temporality option) + () : exponential_histogram = + let _res = default_exponential_histogram () in + exponential_histogram_set_data_points _res data_points; + (match aggregation_temporality with + | None -> () + | Some v -> exponential_histogram_set_aggregation_temporality _res v); + _res + +let[@inline] summary_data_point_value_at_quantile_has_quantile (self:summary_data_point_value_at_quantile) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] summary_data_point_value_at_quantile_has_value (self:summary_data_point_value_at_quantile) : bool = (Pbrt.Bitfield.get self._presence 1) + +let[@inline] summary_data_point_value_at_quantile_set_quantile (self:summary_data_point_value_at_quantile) (x:float) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.quantile <- x +let[@inline] summary_data_point_value_at_quantile_set_value (self:summary_data_point_value_at_quantile) (x:float) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.value <- x + +let copy_summary_data_point_value_at_quantile (self:summary_data_point_value_at_quantile) : summary_data_point_value_at_quantile = + { self with quantile = self.quantile } + +let make_summary_data_point_value_at_quantile + ?(quantile:float option) + ?(value:float option) + () : summary_data_point_value_at_quantile = + let _res = default_summary_data_point_value_at_quantile () in + (match quantile with + | None -> () + | Some v -> summary_data_point_value_at_quantile_set_quantile _res v); + (match value with + | None -> () + | Some v -> summary_data_point_value_at_quantile_set_value _res v); + _res + +let[@inline] summary_data_point_has_start_time_unix_nano (self:summary_data_point) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] summary_data_point_has_time_unix_nano (self:summary_data_point) : bool = (Pbrt.Bitfield.get self._presence 1) +let[@inline] summary_data_point_has_count (self:summary_data_point) : bool = (Pbrt.Bitfield.get self._presence 2) +let[@inline] summary_data_point_has_sum (self:summary_data_point) : bool = (Pbrt.Bitfield.get self._presence 3) +let[@inline] summary_data_point_has_flags (self:summary_data_point) : bool = (Pbrt.Bitfield.get self._presence 4) + +let[@inline] summary_data_point_set_attributes (self:summary_data_point) (x:Common.key_value list) : unit = + self.attributes <- x +let[@inline] summary_data_point_set_start_time_unix_nano (self:summary_data_point) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.start_time_unix_nano <- x +let[@inline] summary_data_point_set_time_unix_nano (self:summary_data_point) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.time_unix_nano <- x +let[@inline] summary_data_point_set_count (self:summary_data_point) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 2); self.count <- x +let[@inline] summary_data_point_set_sum (self:summary_data_point) (x:float) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 3); self.sum <- x +let[@inline] summary_data_point_set_quantile_values (self:summary_data_point) (x:summary_data_point_value_at_quantile list) : unit = + self.quantile_values <- x +let[@inline] summary_data_point_set_flags (self:summary_data_point) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 4); self.flags <- x + +let copy_summary_data_point (self:summary_data_point) : summary_data_point = + { self with attributes = self.attributes } + +let make_summary_data_point + ?(attributes=[]) + ?(start_time_unix_nano:int64 option) + ?(time_unix_nano:int64 option) + ?(count:int64 option) + ?(sum:float option) + ?(quantile_values=[]) + ?(flags:int32 option) + () : summary_data_point = + let _res = default_summary_data_point () in + summary_data_point_set_attributes _res attributes; + (match start_time_unix_nano with + | None -> () + | Some v -> summary_data_point_set_start_time_unix_nano _res v); + (match time_unix_nano with + | None -> () + | Some v -> summary_data_point_set_time_unix_nano _res v); + (match count with + | None -> () + | Some v -> summary_data_point_set_count _res v); + (match sum with + | None -> () + | Some v -> summary_data_point_set_sum _res v); + summary_data_point_set_quantile_values _res quantile_values; + (match flags with + | None -> () + | Some v -> summary_data_point_set_flags _res v); + _res + + +let[@inline] summary_set_data_points (self:summary) (x:summary_data_point list) : unit = + self.data_points <- x + +let copy_summary (self:summary) : summary = + { self with data_points = self.data_points } + +let make_summary + ?(data_points=[]) + () : summary = + let _res = default_summary () in + summary_set_data_points _res data_points; + _res + +let[@inline] metric_has_name (self:metric) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] metric_has_description (self:metric) : bool = (Pbrt.Bitfield.get self._presence 1) +let[@inline] metric_has_unit_ (self:metric) : bool = (Pbrt.Bitfield.get self._presence 2) + +let[@inline] metric_set_name (self:metric) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.name <- x +let[@inline] metric_set_description (self:metric) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.description <- x +let[@inline] metric_set_unit_ (self:metric) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 2); self.unit_ <- x +let[@inline] metric_set_data (self:metric) (x:metric_data) : unit = + self.data <- Some x +let[@inline] metric_set_metadata (self:metric) (x:Common.key_value list) : unit = + self.metadata <- x + +let copy_metric (self:metric) : metric = + { self with name = self.name } + +let make_metric + ?(name:string option) + ?(description:string option) + ?(unit_:string option) + ?(data:metric_data option) + ?(metadata=[]) + () : metric = + let _res = default_metric () in + (match name with + | None -> () + | Some v -> metric_set_name _res v); + (match description with + | None -> () + | Some v -> metric_set_description _res v); + (match unit_ with + | None -> () + | Some v -> metric_set_unit_ _res v); + (match data with + | None -> () + | Some v -> metric_set_data _res v); + metric_set_metadata _res metadata; + _res + +let[@inline] scope_metrics_has_schema_url (self:scope_metrics) : bool = (Pbrt.Bitfield.get self._presence 0) + +let[@inline] scope_metrics_set_scope (self:scope_metrics) (x:Common.instrumentation_scope) : unit = + self.scope <- Some x +let[@inline] scope_metrics_set_metrics (self:scope_metrics) (x:metric list) : unit = + self.metrics <- x +let[@inline] scope_metrics_set_schema_url (self:scope_metrics) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.schema_url <- x + +let copy_scope_metrics (self:scope_metrics) : scope_metrics = + { self with scope = self.scope } + +let make_scope_metrics + ?(scope:Common.instrumentation_scope option) + ?(metrics=[]) + ?(schema_url:string option) + () : scope_metrics = + let _res = default_scope_metrics () in + (match scope with + | None -> () + | Some v -> scope_metrics_set_scope _res v); + scope_metrics_set_metrics _res metrics; + (match schema_url with + | None -> () + | Some v -> scope_metrics_set_schema_url _res v); + _res + +let[@inline] resource_metrics_has_schema_url (self:resource_metrics) : bool = (Pbrt.Bitfield.get self._presence 0) + +let[@inline] resource_metrics_set_resource (self:resource_metrics) (x:Resource.resource) : unit = + self.resource <- Some x +let[@inline] resource_metrics_set_scope_metrics (self:resource_metrics) (x:scope_metrics list) : unit = + self.scope_metrics <- x +let[@inline] resource_metrics_set_schema_url (self:resource_metrics) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.schema_url <- x + +let copy_resource_metrics (self:resource_metrics) : resource_metrics = + { self with resource = self.resource } + +let make_resource_metrics + ?(resource:Resource.resource option) + ?(scope_metrics=[]) + ?(schema_url:string option) + () : resource_metrics = + let _res = default_resource_metrics () in + (match resource with + | None -> () + | Some v -> resource_metrics_set_resource _res v); + resource_metrics_set_scope_metrics _res scope_metrics; + (match schema_url with + | None -> () + | Some v -> resource_metrics_set_schema_url _res v); + _res + + +let[@inline] metrics_data_set_resource_metrics (self:metrics_data) (x:resource_metrics list) : unit = + self.resource_metrics <- x + +let copy_metrics_data (self:metrics_data) : metrics_data = + { self with resource_metrics = self.resource_metrics } + +let make_metrics_data + ?(resource_metrics=[]) + () : metrics_data = + let _res = default_metrics_data () in + metrics_data_set_resource_metrics _res resource_metrics; + _res + +[@@@ocaml.warning "-23-27-30-39"] (** {2 Formatters} *) @@ -795,10 +889,10 @@ let rec pp_exemplar_value fmt (v:exemplar_value) = and pp_exemplar fmt (v:exemplar) = let pp_i fmt () = Pbrt.Pp.pp_record_field ~first:true "filtered_attributes" (Pbrt.Pp.pp_list Common.pp_key_value) fmt v.filtered_attributes; - Pbrt.Pp.pp_record_field ~first:false "time_unix_nano" Pbrt.Pp.pp_int64 fmt v.time_unix_nano; - Pbrt.Pp.pp_record_field ~first:false "value" pp_exemplar_value fmt v.value; - Pbrt.Pp.pp_record_field ~first:false "span_id" Pbrt.Pp.pp_bytes fmt v.span_id; - Pbrt.Pp.pp_record_field ~first:false "trace_id" Pbrt.Pp.pp_bytes fmt v.trace_id; + Pbrt.Pp.pp_record_field ~absent:(not (exemplar_has_time_unix_nano v)) ~first:false "time_unix_nano" Pbrt.Pp.pp_int64 fmt v.time_unix_nano; + Pbrt.Pp.pp_record_field ~first:false "value" (Pbrt.Pp.pp_option pp_exemplar_value) fmt v.value; + Pbrt.Pp.pp_record_field ~absent:(not (exemplar_has_span_id v)) ~first:false "span_id" Pbrt.Pp.pp_bytes fmt v.span_id; + Pbrt.Pp.pp_record_field ~absent:(not (exemplar_has_trace_id v)) ~first:false "trace_id" Pbrt.Pp.pp_bytes fmt v.trace_id; in Pbrt.Pp.pp_brk pp_i fmt () @@ -810,11 +904,11 @@ let rec pp_number_data_point_value fmt (v:number_data_point_value) = and pp_number_data_point fmt (v:number_data_point) = let pp_i fmt () = Pbrt.Pp.pp_record_field ~first:true "attributes" (Pbrt.Pp.pp_list Common.pp_key_value) fmt v.attributes; - Pbrt.Pp.pp_record_field ~first:false "start_time_unix_nano" Pbrt.Pp.pp_int64 fmt v.start_time_unix_nano; - Pbrt.Pp.pp_record_field ~first:false "time_unix_nano" Pbrt.Pp.pp_int64 fmt v.time_unix_nano; - Pbrt.Pp.pp_record_field ~first:false "value" pp_number_data_point_value fmt v.value; + Pbrt.Pp.pp_record_field ~absent:(not (number_data_point_has_start_time_unix_nano v)) ~first:false "start_time_unix_nano" Pbrt.Pp.pp_int64 fmt v.start_time_unix_nano; + Pbrt.Pp.pp_record_field ~absent:(not (number_data_point_has_time_unix_nano v)) ~first:false "time_unix_nano" Pbrt.Pp.pp_int64 fmt v.time_unix_nano; + Pbrt.Pp.pp_record_field ~first:false "value" (Pbrt.Pp.pp_option pp_number_data_point_value) fmt v.value; Pbrt.Pp.pp_record_field ~first:false "exemplars" (Pbrt.Pp.pp_list pp_exemplar) fmt v.exemplars; - Pbrt.Pp.pp_record_field ~first:false "flags" Pbrt.Pp.pp_int32 fmt v.flags; + Pbrt.Pp.pp_record_field ~absent:(not (number_data_point_has_flags v)) ~first:false "flags" Pbrt.Pp.pp_int32 fmt v.flags; in Pbrt.Pp.pp_brk pp_i fmt () @@ -833,37 +927,37 @@ let rec pp_aggregation_temporality fmt (v:aggregation_temporality) = let rec pp_sum fmt (v:sum) = let pp_i fmt () = Pbrt.Pp.pp_record_field ~first:true "data_points" (Pbrt.Pp.pp_list pp_number_data_point) fmt v.data_points; - Pbrt.Pp.pp_record_field ~first:false "aggregation_temporality" pp_aggregation_temporality fmt v.aggregation_temporality; - Pbrt.Pp.pp_record_field ~first:false "is_monotonic" Pbrt.Pp.pp_bool fmt v.is_monotonic; + Pbrt.Pp.pp_record_field ~absent:(not (sum_has_aggregation_temporality v)) ~first:false "aggregation_temporality" pp_aggregation_temporality fmt v.aggregation_temporality; + Pbrt.Pp.pp_record_field ~absent:(not (sum_has_is_monotonic v)) ~first:false "is_monotonic" Pbrt.Pp.pp_bool fmt v.is_monotonic; in Pbrt.Pp.pp_brk pp_i fmt () let rec pp_histogram_data_point fmt (v:histogram_data_point) = let pp_i fmt () = Pbrt.Pp.pp_record_field ~first:true "attributes" (Pbrt.Pp.pp_list Common.pp_key_value) fmt v.attributes; - Pbrt.Pp.pp_record_field ~first:false "start_time_unix_nano" Pbrt.Pp.pp_int64 fmt v.start_time_unix_nano; - Pbrt.Pp.pp_record_field ~first:false "time_unix_nano" Pbrt.Pp.pp_int64 fmt v.time_unix_nano; - Pbrt.Pp.pp_record_field ~first:false "count" Pbrt.Pp.pp_int64 fmt v.count; - Pbrt.Pp.pp_record_field ~first:false "sum" (Pbrt.Pp.pp_option Pbrt.Pp.pp_float) fmt v.sum; + Pbrt.Pp.pp_record_field ~absent:(not (histogram_data_point_has_start_time_unix_nano v)) ~first:false "start_time_unix_nano" Pbrt.Pp.pp_int64 fmt v.start_time_unix_nano; + Pbrt.Pp.pp_record_field ~absent:(not (histogram_data_point_has_time_unix_nano v)) ~first:false "time_unix_nano" Pbrt.Pp.pp_int64 fmt v.time_unix_nano; + Pbrt.Pp.pp_record_field ~absent:(not (histogram_data_point_has_count v)) ~first:false "count" Pbrt.Pp.pp_int64 fmt v.count; + Pbrt.Pp.pp_record_field ~absent:(not (histogram_data_point_has_sum v)) ~first:false "sum" Pbrt.Pp.pp_float fmt v.sum; Pbrt.Pp.pp_record_field ~first:false "bucket_counts" (Pbrt.Pp.pp_list Pbrt.Pp.pp_int64) fmt v.bucket_counts; Pbrt.Pp.pp_record_field ~first:false "explicit_bounds" (Pbrt.Pp.pp_list Pbrt.Pp.pp_float) fmt v.explicit_bounds; Pbrt.Pp.pp_record_field ~first:false "exemplars" (Pbrt.Pp.pp_list pp_exemplar) fmt v.exemplars; - Pbrt.Pp.pp_record_field ~first:false "flags" Pbrt.Pp.pp_int32 fmt v.flags; - Pbrt.Pp.pp_record_field ~first:false "min" (Pbrt.Pp.pp_option Pbrt.Pp.pp_float) fmt v.min; - Pbrt.Pp.pp_record_field ~first:false "max" (Pbrt.Pp.pp_option Pbrt.Pp.pp_float) fmt v.max; + Pbrt.Pp.pp_record_field ~absent:(not (histogram_data_point_has_flags v)) ~first:false "flags" Pbrt.Pp.pp_int32 fmt v.flags; + Pbrt.Pp.pp_record_field ~absent:(not (histogram_data_point_has_min v)) ~first:false "min" Pbrt.Pp.pp_float fmt v.min; + Pbrt.Pp.pp_record_field ~absent:(not (histogram_data_point_has_max v)) ~first:false "max" Pbrt.Pp.pp_float fmt v.max; in Pbrt.Pp.pp_brk pp_i fmt () let rec pp_histogram fmt (v:histogram) = let pp_i fmt () = Pbrt.Pp.pp_record_field ~first:true "data_points" (Pbrt.Pp.pp_list pp_histogram_data_point) fmt v.data_points; - Pbrt.Pp.pp_record_field ~first:false "aggregation_temporality" pp_aggregation_temporality fmt v.aggregation_temporality; + Pbrt.Pp.pp_record_field ~absent:(not (histogram_has_aggregation_temporality v)) ~first:false "aggregation_temporality" pp_aggregation_temporality fmt v.aggregation_temporality; in Pbrt.Pp.pp_brk pp_i fmt () let rec pp_exponential_histogram_data_point_buckets fmt (v:exponential_histogram_data_point_buckets) = let pp_i fmt () = - Pbrt.Pp.pp_record_field ~first:true "offset" Pbrt.Pp.pp_int32 fmt v.offset; + Pbrt.Pp.pp_record_field ~absent:(not (exponential_histogram_data_point_buckets_has_offset v)) ~first:true "offset" Pbrt.Pp.pp_int32 fmt v.offset; Pbrt.Pp.pp_record_field ~first:false "bucket_counts" (Pbrt.Pp.pp_list Pbrt.Pp.pp_int64) fmt v.bucket_counts; in Pbrt.Pp.pp_brk pp_i fmt () @@ -871,45 +965,45 @@ let rec pp_exponential_histogram_data_point_buckets fmt (v:exponential_histogram let rec pp_exponential_histogram_data_point fmt (v:exponential_histogram_data_point) = let pp_i fmt () = Pbrt.Pp.pp_record_field ~first:true "attributes" (Pbrt.Pp.pp_list Common.pp_key_value) fmt v.attributes; - Pbrt.Pp.pp_record_field ~first:false "start_time_unix_nano" Pbrt.Pp.pp_int64 fmt v.start_time_unix_nano; - Pbrt.Pp.pp_record_field ~first:false "time_unix_nano" Pbrt.Pp.pp_int64 fmt v.time_unix_nano; - Pbrt.Pp.pp_record_field ~first:false "count" Pbrt.Pp.pp_int64 fmt v.count; - Pbrt.Pp.pp_record_field ~first:false "sum" (Pbrt.Pp.pp_option Pbrt.Pp.pp_float) fmt v.sum; - Pbrt.Pp.pp_record_field ~first:false "scale" Pbrt.Pp.pp_int32 fmt v.scale; - Pbrt.Pp.pp_record_field ~first:false "zero_count" Pbrt.Pp.pp_int64 fmt v.zero_count; + Pbrt.Pp.pp_record_field ~absent:(not (exponential_histogram_data_point_has_start_time_unix_nano v)) ~first:false "start_time_unix_nano" Pbrt.Pp.pp_int64 fmt v.start_time_unix_nano; + Pbrt.Pp.pp_record_field ~absent:(not (exponential_histogram_data_point_has_time_unix_nano v)) ~first:false "time_unix_nano" Pbrt.Pp.pp_int64 fmt v.time_unix_nano; + Pbrt.Pp.pp_record_field ~absent:(not (exponential_histogram_data_point_has_count v)) ~first:false "count" Pbrt.Pp.pp_int64 fmt v.count; + Pbrt.Pp.pp_record_field ~absent:(not (exponential_histogram_data_point_has_sum v)) ~first:false "sum" Pbrt.Pp.pp_float fmt v.sum; + Pbrt.Pp.pp_record_field ~absent:(not (exponential_histogram_data_point_has_scale v)) ~first:false "scale" Pbrt.Pp.pp_int32 fmt v.scale; + Pbrt.Pp.pp_record_field ~absent:(not (exponential_histogram_data_point_has_zero_count v)) ~first:false "zero_count" Pbrt.Pp.pp_int64 fmt v.zero_count; Pbrt.Pp.pp_record_field ~first:false "positive" (Pbrt.Pp.pp_option pp_exponential_histogram_data_point_buckets) fmt v.positive; Pbrt.Pp.pp_record_field ~first:false "negative" (Pbrt.Pp.pp_option pp_exponential_histogram_data_point_buckets) fmt v.negative; - Pbrt.Pp.pp_record_field ~first:false "flags" Pbrt.Pp.pp_int32 fmt v.flags; + Pbrt.Pp.pp_record_field ~absent:(not (exponential_histogram_data_point_has_flags v)) ~first:false "flags" Pbrt.Pp.pp_int32 fmt v.flags; Pbrt.Pp.pp_record_field ~first:false "exemplars" (Pbrt.Pp.pp_list pp_exemplar) fmt v.exemplars; - Pbrt.Pp.pp_record_field ~first:false "min" (Pbrt.Pp.pp_option Pbrt.Pp.pp_float) fmt v.min; - Pbrt.Pp.pp_record_field ~first:false "max" (Pbrt.Pp.pp_option Pbrt.Pp.pp_float) fmt v.max; - Pbrt.Pp.pp_record_field ~first:false "zero_threshold" Pbrt.Pp.pp_float fmt v.zero_threshold; + Pbrt.Pp.pp_record_field ~absent:(not (exponential_histogram_data_point_has_min v)) ~first:false "min" Pbrt.Pp.pp_float fmt v.min; + Pbrt.Pp.pp_record_field ~absent:(not (exponential_histogram_data_point_has_max v)) ~first:false "max" Pbrt.Pp.pp_float fmt v.max; + Pbrt.Pp.pp_record_field ~absent:(not (exponential_histogram_data_point_has_zero_threshold v)) ~first:false "zero_threshold" Pbrt.Pp.pp_float fmt v.zero_threshold; in Pbrt.Pp.pp_brk pp_i fmt () let rec pp_exponential_histogram fmt (v:exponential_histogram) = let pp_i fmt () = Pbrt.Pp.pp_record_field ~first:true "data_points" (Pbrt.Pp.pp_list pp_exponential_histogram_data_point) fmt v.data_points; - Pbrt.Pp.pp_record_field ~first:false "aggregation_temporality" pp_aggregation_temporality fmt v.aggregation_temporality; + Pbrt.Pp.pp_record_field ~absent:(not (exponential_histogram_has_aggregation_temporality v)) ~first:false "aggregation_temporality" pp_aggregation_temporality fmt v.aggregation_temporality; in Pbrt.Pp.pp_brk pp_i fmt () let rec pp_summary_data_point_value_at_quantile fmt (v:summary_data_point_value_at_quantile) = let pp_i fmt () = - Pbrt.Pp.pp_record_field ~first:true "quantile" Pbrt.Pp.pp_float fmt v.quantile; - Pbrt.Pp.pp_record_field ~first:false "value" Pbrt.Pp.pp_float fmt v.value; + Pbrt.Pp.pp_record_field ~absent:(not (summary_data_point_value_at_quantile_has_quantile v)) ~first:true "quantile" Pbrt.Pp.pp_float fmt v.quantile; + Pbrt.Pp.pp_record_field ~absent:(not (summary_data_point_value_at_quantile_has_value v)) ~first:false "value" Pbrt.Pp.pp_float fmt v.value; in Pbrt.Pp.pp_brk pp_i fmt () let rec pp_summary_data_point fmt (v:summary_data_point) = let pp_i fmt () = Pbrt.Pp.pp_record_field ~first:true "attributes" (Pbrt.Pp.pp_list Common.pp_key_value) fmt v.attributes; - Pbrt.Pp.pp_record_field ~first:false "start_time_unix_nano" Pbrt.Pp.pp_int64 fmt v.start_time_unix_nano; - Pbrt.Pp.pp_record_field ~first:false "time_unix_nano" Pbrt.Pp.pp_int64 fmt v.time_unix_nano; - Pbrt.Pp.pp_record_field ~first:false "count" Pbrt.Pp.pp_int64 fmt v.count; - Pbrt.Pp.pp_record_field ~first:false "sum" Pbrt.Pp.pp_float fmt v.sum; + Pbrt.Pp.pp_record_field ~absent:(not (summary_data_point_has_start_time_unix_nano v)) ~first:false "start_time_unix_nano" Pbrt.Pp.pp_int64 fmt v.start_time_unix_nano; + Pbrt.Pp.pp_record_field ~absent:(not (summary_data_point_has_time_unix_nano v)) ~first:false "time_unix_nano" Pbrt.Pp.pp_int64 fmt v.time_unix_nano; + Pbrt.Pp.pp_record_field ~absent:(not (summary_data_point_has_count v)) ~first:false "count" Pbrt.Pp.pp_int64 fmt v.count; + Pbrt.Pp.pp_record_field ~absent:(not (summary_data_point_has_sum v)) ~first:false "sum" Pbrt.Pp.pp_float fmt v.sum; Pbrt.Pp.pp_record_field ~first:false "quantile_values" (Pbrt.Pp.pp_list pp_summary_data_point_value_at_quantile) fmt v.quantile_values; - Pbrt.Pp.pp_record_field ~first:false "flags" Pbrt.Pp.pp_int32 fmt v.flags; + Pbrt.Pp.pp_record_field ~absent:(not (summary_data_point_has_flags v)) ~first:false "flags" Pbrt.Pp.pp_int32 fmt v.flags; in Pbrt.Pp.pp_brk pp_i fmt () @@ -929,10 +1023,11 @@ let rec pp_metric_data fmt (v:metric_data) = and pp_metric fmt (v:metric) = let pp_i fmt () = - Pbrt.Pp.pp_record_field ~first:true "name" Pbrt.Pp.pp_string fmt v.name; - Pbrt.Pp.pp_record_field ~first:false "description" Pbrt.Pp.pp_string fmt v.description; - Pbrt.Pp.pp_record_field ~first:false "unit_" Pbrt.Pp.pp_string fmt v.unit_; - Pbrt.Pp.pp_record_field ~first:false "data" pp_metric_data fmt v.data; + Pbrt.Pp.pp_record_field ~absent:(not (metric_has_name v)) ~first:true "name" Pbrt.Pp.pp_string fmt v.name; + Pbrt.Pp.pp_record_field ~absent:(not (metric_has_description v)) ~first:false "description" Pbrt.Pp.pp_string fmt v.description; + Pbrt.Pp.pp_record_field ~absent:(not (metric_has_unit_ v)) ~first:false "unit_" Pbrt.Pp.pp_string fmt v.unit_; + Pbrt.Pp.pp_record_field ~first:false "data" (Pbrt.Pp.pp_option pp_metric_data) fmt v.data; + Pbrt.Pp.pp_record_field ~first:false "metadata" (Pbrt.Pp.pp_list Common.pp_key_value) fmt v.metadata; in Pbrt.Pp.pp_brk pp_i fmt () @@ -940,7 +1035,7 @@ let rec pp_scope_metrics fmt (v:scope_metrics) = let pp_i fmt () = Pbrt.Pp.pp_record_field ~first:true "scope" (Pbrt.Pp.pp_option Common.pp_instrumentation_scope) fmt v.scope; Pbrt.Pp.pp_record_field ~first:false "metrics" (Pbrt.Pp.pp_list pp_metric) fmt v.metrics; - Pbrt.Pp.pp_record_field ~first:false "schema_url" Pbrt.Pp.pp_string fmt v.schema_url; + Pbrt.Pp.pp_record_field ~absent:(not (scope_metrics_has_schema_url v)) ~first:false "schema_url" Pbrt.Pp.pp_string fmt v.schema_url; in Pbrt.Pp.pp_brk pp_i fmt () @@ -948,7 +1043,7 @@ let rec pp_resource_metrics fmt (v:resource_metrics) = let pp_i fmt () = Pbrt.Pp.pp_record_field ~first:true "resource" (Pbrt.Pp.pp_option Resource.pp_resource) fmt v.resource; Pbrt.Pp.pp_record_field ~first:false "scope_metrics" (Pbrt.Pp.pp_list pp_scope_metrics) fmt v.scope_metrics; - Pbrt.Pp.pp_record_field ~first:false "schema_url" Pbrt.Pp.pp_string fmt v.schema_url; + Pbrt.Pp.pp_record_field ~absent:(not (resource_metrics_has_schema_url v)) ~first:false "schema_url" Pbrt.Pp.pp_string fmt v.schema_url; in Pbrt.Pp.pp_brk pp_i fmt () @@ -963,7 +1058,7 @@ let rec pp_data_point_flags fmt (v:data_point_flags) = | Data_point_flags_do_not_use -> Format.fprintf fmt "Data_point_flags_do_not_use" | Data_point_flags_no_recorded_value_mask -> Format.fprintf fmt "Data_point_flags_no_recorded_value_mask" -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Encoding} *) @@ -978,24 +1073,31 @@ let rec encode_pb_exemplar_value (v:exemplar_value) encoder = end and encode_pb_exemplar (v:exemplar) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested Common.encode_pb_key_value x encoder; Pbrt.Encoder.key 7 Pbrt.Bytes encoder; ) v.filtered_attributes encoder; - Pbrt.Encoder.int64_as_bits64 v.time_unix_nano encoder; - Pbrt.Encoder.key 2 Pbrt.Bits64 encoder; + if exemplar_has_time_unix_nano v then ( + Pbrt.Encoder.int64_as_bits64 v.time_unix_nano encoder; + Pbrt.Encoder.key 2 Pbrt.Bits64 encoder; + ); begin match v.value with - | As_double x -> + | None -> () + | Some (As_double x) -> Pbrt.Encoder.float_as_bits64 x encoder; Pbrt.Encoder.key 3 Pbrt.Bits64 encoder; - | As_int x -> + | Some (As_int x) -> Pbrt.Encoder.int64_as_bits64 x encoder; Pbrt.Encoder.key 6 Pbrt.Bits64 encoder; end; - Pbrt.Encoder.bytes v.span_id encoder; - Pbrt.Encoder.key 4 Pbrt.Bytes encoder; - Pbrt.Encoder.bytes v.trace_id encoder; - Pbrt.Encoder.key 5 Pbrt.Bytes encoder; + if exemplar_has_span_id v then ( + Pbrt.Encoder.bytes v.span_id encoder; + Pbrt.Encoder.key 4 Pbrt.Bytes encoder; + ); + if exemplar_has_trace_id v then ( + Pbrt.Encoder.bytes v.trace_id encoder; + Pbrt.Encoder.key 5 Pbrt.Bytes encoder; + ); () let rec encode_pb_number_data_point_value (v:number_data_point_value) encoder = @@ -1009,32 +1111,39 @@ let rec encode_pb_number_data_point_value (v:number_data_point_value) encoder = end and encode_pb_number_data_point (v:number_data_point) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested Common.encode_pb_key_value x encoder; Pbrt.Encoder.key 7 Pbrt.Bytes encoder; ) v.attributes encoder; - Pbrt.Encoder.int64_as_bits64 v.start_time_unix_nano encoder; - Pbrt.Encoder.key 2 Pbrt.Bits64 encoder; - Pbrt.Encoder.int64_as_bits64 v.time_unix_nano encoder; - Pbrt.Encoder.key 3 Pbrt.Bits64 encoder; + if number_data_point_has_start_time_unix_nano v then ( + Pbrt.Encoder.int64_as_bits64 v.start_time_unix_nano encoder; + Pbrt.Encoder.key 2 Pbrt.Bits64 encoder; + ); + if number_data_point_has_time_unix_nano v then ( + Pbrt.Encoder.int64_as_bits64 v.time_unix_nano encoder; + Pbrt.Encoder.key 3 Pbrt.Bits64 encoder; + ); begin match v.value with - | As_double x -> + | None -> () + | Some (As_double x) -> Pbrt.Encoder.float_as_bits64 x encoder; Pbrt.Encoder.key 4 Pbrt.Bits64 encoder; - | As_int x -> + | Some (As_int x) -> Pbrt.Encoder.int64_as_bits64 x encoder; Pbrt.Encoder.key 6 Pbrt.Bits64 encoder; end; - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_exemplar x encoder; Pbrt.Encoder.key 5 Pbrt.Bytes encoder; ) v.exemplars encoder; - Pbrt.Encoder.int32_as_varint v.flags encoder; - Pbrt.Encoder.key 8 Pbrt.Varint encoder; + if number_data_point_has_flags v then ( + Pbrt.Encoder.int32_as_varint v.flags encoder; + Pbrt.Encoder.key 8 Pbrt.Varint encoder; + ); () let rec encode_pb_gauge (v:gauge) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_number_data_point x encoder; Pbrt.Encoder.key 1 Pbrt.Bytes encoder; ) v.data_points encoder; @@ -1047,79 +1156,89 @@ let rec encode_pb_aggregation_temporality (v:aggregation_temporality) encoder = | Aggregation_temporality_cumulative -> Pbrt.Encoder.int_as_varint 2 encoder let rec encode_pb_sum (v:sum) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_number_data_point x encoder; Pbrt.Encoder.key 1 Pbrt.Bytes encoder; ) v.data_points encoder; - encode_pb_aggregation_temporality v.aggregation_temporality encoder; - Pbrt.Encoder.key 2 Pbrt.Varint encoder; - Pbrt.Encoder.bool v.is_monotonic encoder; - Pbrt.Encoder.key 3 Pbrt.Varint encoder; + if sum_has_aggregation_temporality v then ( + encode_pb_aggregation_temporality v.aggregation_temporality encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + ); + if sum_has_is_monotonic v then ( + Pbrt.Encoder.bool v.is_monotonic encoder; + Pbrt.Encoder.key 3 Pbrt.Varint encoder; + ); () let rec encode_pb_histogram_data_point (v:histogram_data_point) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested Common.encode_pb_key_value x encoder; Pbrt.Encoder.key 9 Pbrt.Bytes encoder; ) v.attributes encoder; - Pbrt.Encoder.int64_as_bits64 v.start_time_unix_nano encoder; - Pbrt.Encoder.key 2 Pbrt.Bits64 encoder; - Pbrt.Encoder.int64_as_bits64 v.time_unix_nano encoder; - Pbrt.Encoder.key 3 Pbrt.Bits64 encoder; - Pbrt.Encoder.int64_as_bits64 v.count encoder; - Pbrt.Encoder.key 4 Pbrt.Bits64 encoder; - begin match v.sum with - | Some x -> - Pbrt.Encoder.float_as_bits64 x encoder; + if histogram_data_point_has_start_time_unix_nano v then ( + Pbrt.Encoder.int64_as_bits64 v.start_time_unix_nano encoder; + Pbrt.Encoder.key 2 Pbrt.Bits64 encoder; + ); + if histogram_data_point_has_time_unix_nano v then ( + Pbrt.Encoder.int64_as_bits64 v.time_unix_nano encoder; + Pbrt.Encoder.key 3 Pbrt.Bits64 encoder; + ); + if histogram_data_point_has_count v then ( + Pbrt.Encoder.int64_as_bits64 v.count encoder; + Pbrt.Encoder.key 4 Pbrt.Bits64 encoder; + ); + if histogram_data_point_has_sum v then ( + Pbrt.Encoder.float_as_bits64 v.sum encoder; Pbrt.Encoder.key 5 Pbrt.Bits64 encoder; - | None -> (); - end; + ); Pbrt.Encoder.nested (fun lst encoder -> - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.int64_as_bits64 x encoder; ) lst encoder; ) v.bucket_counts encoder; Pbrt.Encoder.key 6 Pbrt.Bytes encoder; Pbrt.Encoder.nested (fun lst encoder -> - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.float_as_bits64 x encoder; ) lst encoder; ) v.explicit_bounds encoder; Pbrt.Encoder.key 7 Pbrt.Bytes encoder; - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_exemplar x encoder; Pbrt.Encoder.key 8 Pbrt.Bytes encoder; ) v.exemplars encoder; - Pbrt.Encoder.int32_as_varint v.flags encoder; - Pbrt.Encoder.key 10 Pbrt.Varint encoder; - begin match v.min with - | Some x -> - Pbrt.Encoder.float_as_bits64 x encoder; + if histogram_data_point_has_flags v then ( + Pbrt.Encoder.int32_as_varint v.flags encoder; + Pbrt.Encoder.key 10 Pbrt.Varint encoder; + ); + if histogram_data_point_has_min v then ( + Pbrt.Encoder.float_as_bits64 v.min encoder; Pbrt.Encoder.key 11 Pbrt.Bits64 encoder; - | None -> (); - end; - begin match v.max with - | Some x -> - Pbrt.Encoder.float_as_bits64 x encoder; + ); + if histogram_data_point_has_max v then ( + Pbrt.Encoder.float_as_bits64 v.max encoder; Pbrt.Encoder.key 12 Pbrt.Bits64 encoder; - | None -> (); - end; + ); () let rec encode_pb_histogram (v:histogram) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_histogram_data_point x encoder; Pbrt.Encoder.key 1 Pbrt.Bytes encoder; ) v.data_points encoder; - encode_pb_aggregation_temporality v.aggregation_temporality encoder; - Pbrt.Encoder.key 2 Pbrt.Varint encoder; + if histogram_has_aggregation_temporality v then ( + encode_pb_aggregation_temporality v.aggregation_temporality encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + ); () let rec encode_pb_exponential_histogram_data_point_buckets (v:exponential_histogram_data_point_buckets) encoder = - Pbrt.Encoder.int32_as_zigzag v.offset encoder; - Pbrt.Encoder.key 1 Pbrt.Varint encoder; + if exponential_histogram_data_point_buckets_has_offset v then ( + Pbrt.Encoder.int32_as_zigzag v.offset encoder; + Pbrt.Encoder.key 1 Pbrt.Varint encoder; + ); Pbrt.Encoder.nested (fun lst encoder -> - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.int64_as_varint x encoder; ) lst encoder; ) v.bucket_counts encoder; @@ -1127,26 +1246,34 @@ let rec encode_pb_exponential_histogram_data_point_buckets (v:exponential_histog () let rec encode_pb_exponential_histogram_data_point (v:exponential_histogram_data_point) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested Common.encode_pb_key_value x encoder; Pbrt.Encoder.key 1 Pbrt.Bytes encoder; ) v.attributes encoder; - Pbrt.Encoder.int64_as_bits64 v.start_time_unix_nano encoder; - Pbrt.Encoder.key 2 Pbrt.Bits64 encoder; - Pbrt.Encoder.int64_as_bits64 v.time_unix_nano encoder; - Pbrt.Encoder.key 3 Pbrt.Bits64 encoder; - Pbrt.Encoder.int64_as_bits64 v.count encoder; - Pbrt.Encoder.key 4 Pbrt.Bits64 encoder; - begin match v.sum with - | Some x -> - Pbrt.Encoder.float_as_bits64 x encoder; + if exponential_histogram_data_point_has_start_time_unix_nano v then ( + Pbrt.Encoder.int64_as_bits64 v.start_time_unix_nano encoder; + Pbrt.Encoder.key 2 Pbrt.Bits64 encoder; + ); + if exponential_histogram_data_point_has_time_unix_nano v then ( + Pbrt.Encoder.int64_as_bits64 v.time_unix_nano encoder; + Pbrt.Encoder.key 3 Pbrt.Bits64 encoder; + ); + if exponential_histogram_data_point_has_count v then ( + Pbrt.Encoder.int64_as_bits64 v.count encoder; + Pbrt.Encoder.key 4 Pbrt.Bits64 encoder; + ); + if exponential_histogram_data_point_has_sum v then ( + Pbrt.Encoder.float_as_bits64 v.sum encoder; Pbrt.Encoder.key 5 Pbrt.Bits64 encoder; - | None -> (); - end; - Pbrt.Encoder.int32_as_zigzag v.scale encoder; - Pbrt.Encoder.key 6 Pbrt.Varint encoder; - Pbrt.Encoder.int64_as_bits64 v.zero_count encoder; - Pbrt.Encoder.key 7 Pbrt.Bits64 encoder; + ); + if exponential_histogram_data_point_has_scale v then ( + Pbrt.Encoder.int32_as_zigzag v.scale encoder; + Pbrt.Encoder.key 6 Pbrt.Varint encoder; + ); + if exponential_histogram_data_point_has_zero_count v then ( + Pbrt.Encoder.int64_as_bits64 v.zero_count encoder; + Pbrt.Encoder.key 7 Pbrt.Bits64 encoder; + ); begin match v.positive with | Some x -> Pbrt.Encoder.nested encode_pb_exponential_histogram_data_point_buckets x encoder; @@ -1159,67 +1286,83 @@ let rec encode_pb_exponential_histogram_data_point (v:exponential_histogram_data Pbrt.Encoder.key 9 Pbrt.Bytes encoder; | None -> (); end; - Pbrt.Encoder.int32_as_varint v.flags encoder; - Pbrt.Encoder.key 10 Pbrt.Varint encoder; - Pbrt.List_util.rev_iter_with (fun x encoder -> + if exponential_histogram_data_point_has_flags v then ( + Pbrt.Encoder.int32_as_varint v.flags encoder; + Pbrt.Encoder.key 10 Pbrt.Varint encoder; + ); + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_exemplar x encoder; Pbrt.Encoder.key 11 Pbrt.Bytes encoder; ) v.exemplars encoder; - begin match v.min with - | Some x -> - Pbrt.Encoder.float_as_bits64 x encoder; + if exponential_histogram_data_point_has_min v then ( + Pbrt.Encoder.float_as_bits64 v.min encoder; Pbrt.Encoder.key 12 Pbrt.Bits64 encoder; - | None -> (); - end; - begin match v.max with - | Some x -> - Pbrt.Encoder.float_as_bits64 x encoder; + ); + if exponential_histogram_data_point_has_max v then ( + Pbrt.Encoder.float_as_bits64 v.max encoder; Pbrt.Encoder.key 13 Pbrt.Bits64 encoder; - | None -> (); - end; - Pbrt.Encoder.float_as_bits64 v.zero_threshold encoder; - Pbrt.Encoder.key 14 Pbrt.Bits64 encoder; + ); + if exponential_histogram_data_point_has_zero_threshold v then ( + Pbrt.Encoder.float_as_bits64 v.zero_threshold encoder; + Pbrt.Encoder.key 14 Pbrt.Bits64 encoder; + ); () let rec encode_pb_exponential_histogram (v:exponential_histogram) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_exponential_histogram_data_point x encoder; Pbrt.Encoder.key 1 Pbrt.Bytes encoder; ) v.data_points encoder; - encode_pb_aggregation_temporality v.aggregation_temporality encoder; - Pbrt.Encoder.key 2 Pbrt.Varint encoder; + if exponential_histogram_has_aggregation_temporality v then ( + encode_pb_aggregation_temporality v.aggregation_temporality encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + ); () let rec encode_pb_summary_data_point_value_at_quantile (v:summary_data_point_value_at_quantile) encoder = - Pbrt.Encoder.float_as_bits64 v.quantile encoder; - Pbrt.Encoder.key 1 Pbrt.Bits64 encoder; - Pbrt.Encoder.float_as_bits64 v.value encoder; - Pbrt.Encoder.key 2 Pbrt.Bits64 encoder; + if summary_data_point_value_at_quantile_has_quantile v then ( + Pbrt.Encoder.float_as_bits64 v.quantile encoder; + Pbrt.Encoder.key 1 Pbrt.Bits64 encoder; + ); + if summary_data_point_value_at_quantile_has_value v then ( + Pbrt.Encoder.float_as_bits64 v.value encoder; + Pbrt.Encoder.key 2 Pbrt.Bits64 encoder; + ); () let rec encode_pb_summary_data_point (v:summary_data_point) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested Common.encode_pb_key_value x encoder; Pbrt.Encoder.key 7 Pbrt.Bytes encoder; ) v.attributes encoder; - Pbrt.Encoder.int64_as_bits64 v.start_time_unix_nano encoder; - Pbrt.Encoder.key 2 Pbrt.Bits64 encoder; - Pbrt.Encoder.int64_as_bits64 v.time_unix_nano encoder; - Pbrt.Encoder.key 3 Pbrt.Bits64 encoder; - Pbrt.Encoder.int64_as_bits64 v.count encoder; - Pbrt.Encoder.key 4 Pbrt.Bits64 encoder; - Pbrt.Encoder.float_as_bits64 v.sum encoder; - Pbrt.Encoder.key 5 Pbrt.Bits64 encoder; - Pbrt.List_util.rev_iter_with (fun x encoder -> + if summary_data_point_has_start_time_unix_nano v then ( + Pbrt.Encoder.int64_as_bits64 v.start_time_unix_nano encoder; + Pbrt.Encoder.key 2 Pbrt.Bits64 encoder; + ); + if summary_data_point_has_time_unix_nano v then ( + Pbrt.Encoder.int64_as_bits64 v.time_unix_nano encoder; + Pbrt.Encoder.key 3 Pbrt.Bits64 encoder; + ); + if summary_data_point_has_count v then ( + Pbrt.Encoder.int64_as_bits64 v.count encoder; + Pbrt.Encoder.key 4 Pbrt.Bits64 encoder; + ); + if summary_data_point_has_sum v then ( + Pbrt.Encoder.float_as_bits64 v.sum encoder; + Pbrt.Encoder.key 5 Pbrt.Bits64 encoder; + ); + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_summary_data_point_value_at_quantile x encoder; Pbrt.Encoder.key 6 Pbrt.Bytes encoder; ) v.quantile_values encoder; - Pbrt.Encoder.int32_as_varint v.flags encoder; - Pbrt.Encoder.key 8 Pbrt.Varint encoder; + if summary_data_point_has_flags v then ( + Pbrt.Encoder.int32_as_varint v.flags encoder; + Pbrt.Encoder.key 8 Pbrt.Varint encoder; + ); () let rec encode_pb_summary (v:summary) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_summary_data_point x encoder; Pbrt.Encoder.key 1 Pbrt.Bytes encoder; ) v.data_points encoder; @@ -1245,29 +1388,40 @@ let rec encode_pb_metric_data (v:metric_data) encoder = end and encode_pb_metric (v:metric) encoder = - Pbrt.Encoder.string v.name encoder; - Pbrt.Encoder.key 1 Pbrt.Bytes encoder; - Pbrt.Encoder.string v.description encoder; - Pbrt.Encoder.key 2 Pbrt.Bytes encoder; - Pbrt.Encoder.string v.unit_ encoder; - Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + if metric_has_name v then ( + Pbrt.Encoder.string v.name encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ); + if metric_has_description v then ( + Pbrt.Encoder.string v.description encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + ); + if metric_has_unit_ v then ( + Pbrt.Encoder.string v.unit_ encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + ); begin match v.data with - | Gauge x -> + | None -> () + | Some (Gauge x) -> Pbrt.Encoder.nested encode_pb_gauge x encoder; Pbrt.Encoder.key 5 Pbrt.Bytes encoder; - | Sum x -> + | Some (Sum x) -> Pbrt.Encoder.nested encode_pb_sum x encoder; Pbrt.Encoder.key 7 Pbrt.Bytes encoder; - | Histogram x -> + | Some (Histogram x) -> Pbrt.Encoder.nested encode_pb_histogram x encoder; Pbrt.Encoder.key 9 Pbrt.Bytes encoder; - | Exponential_histogram x -> + | Some (Exponential_histogram x) -> Pbrt.Encoder.nested encode_pb_exponential_histogram x encoder; Pbrt.Encoder.key 10 Pbrt.Bytes encoder; - | Summary x -> + | Some (Summary x) -> Pbrt.Encoder.nested encode_pb_summary x encoder; Pbrt.Encoder.key 11 Pbrt.Bytes encoder; end; + Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.Encoder.nested Common.encode_pb_key_value x encoder; + Pbrt.Encoder.key 12 Pbrt.Bytes encoder; + ) v.metadata encoder; () let rec encode_pb_scope_metrics (v:scope_metrics) encoder = @@ -1277,12 +1431,14 @@ let rec encode_pb_scope_metrics (v:scope_metrics) encoder = Pbrt.Encoder.key 1 Pbrt.Bytes encoder; | None -> (); end; - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_metric x encoder; Pbrt.Encoder.key 2 Pbrt.Bytes encoder; ) v.metrics encoder; - Pbrt.Encoder.string v.schema_url encoder; - Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + if scope_metrics_has_schema_url v then ( + Pbrt.Encoder.string v.schema_url encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + ); () let rec encode_pb_resource_metrics (v:resource_metrics) encoder = @@ -1292,16 +1448,18 @@ let rec encode_pb_resource_metrics (v:resource_metrics) encoder = Pbrt.Encoder.key 1 Pbrt.Bytes encoder; | None -> (); end; - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_scope_metrics x encoder; Pbrt.Encoder.key 2 Pbrt.Bytes encoder; ) v.scope_metrics encoder; - Pbrt.Encoder.string v.schema_url encoder; - Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + if resource_metrics_has_schema_url v then ( + Pbrt.Encoder.string v.schema_url encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + ); () let rec encode_pb_metrics_data (v:metrics_data) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_resource_metrics x encoder; Pbrt.Encoder.key 1 Pbrt.Bytes encoder; ) v.resource_metrics encoder; @@ -1312,7 +1470,7 @@ let rec encode_pb_data_point_flags (v:data_point_flags) encoder = | Data_point_flags_do_not_use -> Pbrt.Encoder.int_as_varint (0) encoder | Data_point_flags_no_recorded_value_mask -> Pbrt.Encoder.int_as_varint 1 encoder -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Decoding} *) @@ -1332,52 +1490,47 @@ let rec decode_pb_exemplar_value d = loop () and decode_pb_exemplar d = - let v = default_exemplar_mutable () in + let v = default_exemplar () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.filtered_attributes <- List.rev v.filtered_attributes; + (* put lists in the correct order *) + exemplar_set_filtered_attributes v (List.rev v.filtered_attributes); ); continue__ := false | Some (7, Pbrt.Bytes) -> begin - v.filtered_attributes <- (Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.filtered_attributes; + exemplar_set_filtered_attributes v ((Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.filtered_attributes); end | Some (7, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exemplar), field(7)" pk + Pbrt.Decoder.unexpected_payload_message "exemplar" 7 pk | Some (2, Pbrt.Bits64) -> begin - v.time_unix_nano <- Pbrt.Decoder.int64_as_bits64 d; + exemplar_set_time_unix_nano v (Pbrt.Decoder.int64_as_bits64 d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exemplar), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "exemplar" 2 pk | Some (3, Pbrt.Bits64) -> begin - v.value <- As_double (Pbrt.Decoder.float_as_bits64 d); + exemplar_set_value v (As_double (Pbrt.Decoder.float_as_bits64 d)); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exemplar), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "exemplar" 3 pk | Some (6, Pbrt.Bits64) -> begin - v.value <- As_int (Pbrt.Decoder.int64_as_bits64 d); + exemplar_set_value v (As_int (Pbrt.Decoder.int64_as_bits64 d)); end | Some (6, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exemplar), field(6)" pk + Pbrt.Decoder.unexpected_payload_message "exemplar" 6 pk | Some (4, Pbrt.Bytes) -> begin - v.span_id <- Pbrt.Decoder.bytes d; + exemplar_set_span_id v (Pbrt.Decoder.bytes d); end | Some (4, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exemplar), field(4)" pk + Pbrt.Decoder.unexpected_payload_message "exemplar" 4 pk | Some (5, Pbrt.Bytes) -> begin - v.trace_id <- Pbrt.Decoder.bytes d; + exemplar_set_trace_id v (Pbrt.Decoder.bytes d); end | Some (5, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exemplar), field(5)" pk + Pbrt.Decoder.unexpected_payload_message "exemplar" 5 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - filtered_attributes = v.filtered_attributes; - time_unix_nano = v.time_unix_nano; - value = v.value; - span_id = v.span_id; - trace_id = v.trace_id; - } : exemplar) + (v : exemplar) let rec decode_pb_number_data_point_value d = let rec loop () = @@ -1395,470 +1548,418 @@ let rec decode_pb_number_data_point_value d = loop () and decode_pb_number_data_point d = - let v = default_number_data_point_mutable () in + let v = default_number_data_point () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.exemplars <- List.rev v.exemplars; - v.attributes <- List.rev v.attributes; + (* put lists in the correct order *) + number_data_point_set_exemplars v (List.rev v.exemplars); + number_data_point_set_attributes v (List.rev v.attributes); ); continue__ := false | Some (7, Pbrt.Bytes) -> begin - v.attributes <- (Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes; + number_data_point_set_attributes v ((Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes); end | Some (7, pk) -> - Pbrt.Decoder.unexpected_payload "Message(number_data_point), field(7)" pk + Pbrt.Decoder.unexpected_payload_message "number_data_point" 7 pk | Some (2, Pbrt.Bits64) -> begin - v.start_time_unix_nano <- Pbrt.Decoder.int64_as_bits64 d; + number_data_point_set_start_time_unix_nano v (Pbrt.Decoder.int64_as_bits64 d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(number_data_point), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "number_data_point" 2 pk | Some (3, Pbrt.Bits64) -> begin - v.time_unix_nano <- Pbrt.Decoder.int64_as_bits64 d; + number_data_point_set_time_unix_nano v (Pbrt.Decoder.int64_as_bits64 d); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(number_data_point), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "number_data_point" 3 pk | Some (4, Pbrt.Bits64) -> begin - v.value <- As_double (Pbrt.Decoder.float_as_bits64 d); + number_data_point_set_value v (As_double (Pbrt.Decoder.float_as_bits64 d)); end | Some (4, pk) -> - Pbrt.Decoder.unexpected_payload "Message(number_data_point), field(4)" pk + Pbrt.Decoder.unexpected_payload_message "number_data_point" 4 pk | Some (6, Pbrt.Bits64) -> begin - v.value <- As_int (Pbrt.Decoder.int64_as_bits64 d); + number_data_point_set_value v (As_int (Pbrt.Decoder.int64_as_bits64 d)); end | Some (6, pk) -> - Pbrt.Decoder.unexpected_payload "Message(number_data_point), field(6)" pk + Pbrt.Decoder.unexpected_payload_message "number_data_point" 6 pk | Some (5, Pbrt.Bytes) -> begin - v.exemplars <- (decode_pb_exemplar (Pbrt.Decoder.nested d)) :: v.exemplars; + number_data_point_set_exemplars v ((decode_pb_exemplar (Pbrt.Decoder.nested d)) :: v.exemplars); end | Some (5, pk) -> - Pbrt.Decoder.unexpected_payload "Message(number_data_point), field(5)" pk + Pbrt.Decoder.unexpected_payload_message "number_data_point" 5 pk | Some (8, Pbrt.Varint) -> begin - v.flags <- Pbrt.Decoder.int32_as_varint d; + number_data_point_set_flags v (Pbrt.Decoder.int32_as_varint d); end | Some (8, pk) -> - Pbrt.Decoder.unexpected_payload "Message(number_data_point), field(8)" pk + Pbrt.Decoder.unexpected_payload_message "number_data_point" 8 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - attributes = v.attributes; - start_time_unix_nano = v.start_time_unix_nano; - time_unix_nano = v.time_unix_nano; - value = v.value; - exemplars = v.exemplars; - flags = v.flags; - } : number_data_point) + (v : number_data_point) let rec decode_pb_gauge d = - let v = default_gauge_mutable () in + let v = default_gauge () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.data_points <- List.rev v.data_points; + (* put lists in the correct order *) + gauge_set_data_points v (List.rev v.data_points); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.data_points <- (decode_pb_number_data_point (Pbrt.Decoder.nested d)) :: v.data_points; + gauge_set_data_points v ((decode_pb_number_data_point (Pbrt.Decoder.nested d)) :: v.data_points); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(gauge), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "gauge" 1 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - data_points = v.data_points; - } : gauge) + (v : gauge) -let rec decode_pb_aggregation_temporality d = +let rec decode_pb_aggregation_temporality d : aggregation_temporality = match Pbrt.Decoder.int_as_varint d with - | 0 -> (Aggregation_temporality_unspecified:aggregation_temporality) - | 1 -> (Aggregation_temporality_delta:aggregation_temporality) - | 2 -> (Aggregation_temporality_cumulative:aggregation_temporality) + | 0 -> Aggregation_temporality_unspecified + | 1 -> Aggregation_temporality_delta + | 2 -> Aggregation_temporality_cumulative | _ -> Pbrt.Decoder.malformed_variant "aggregation_temporality" let rec decode_pb_sum d = - let v = default_sum_mutable () in + let v = default_sum () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.data_points <- List.rev v.data_points; + (* put lists in the correct order *) + sum_set_data_points v (List.rev v.data_points); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.data_points <- (decode_pb_number_data_point (Pbrt.Decoder.nested d)) :: v.data_points; + sum_set_data_points v ((decode_pb_number_data_point (Pbrt.Decoder.nested d)) :: v.data_points); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(sum), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "sum" 1 pk | Some (2, Pbrt.Varint) -> begin - v.aggregation_temporality <- decode_pb_aggregation_temporality d; + sum_set_aggregation_temporality v (decode_pb_aggregation_temporality d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(sum), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "sum" 2 pk | Some (3, Pbrt.Varint) -> begin - v.is_monotonic <- Pbrt.Decoder.bool d; + sum_set_is_monotonic v (Pbrt.Decoder.bool d); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(sum), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "sum" 3 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - data_points = v.data_points; - aggregation_temporality = v.aggregation_temporality; - is_monotonic = v.is_monotonic; - } : sum) + (v : sum) let rec decode_pb_histogram_data_point d = - let v = default_histogram_data_point_mutable () in + let v = default_histogram_data_point () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.exemplars <- List.rev v.exemplars; - v.explicit_bounds <- List.rev v.explicit_bounds; - v.bucket_counts <- List.rev v.bucket_counts; - v.attributes <- List.rev v.attributes; + (* put lists in the correct order *) + histogram_data_point_set_exemplars v (List.rev v.exemplars); + histogram_data_point_set_explicit_bounds v (List.rev v.explicit_bounds); + histogram_data_point_set_bucket_counts v (List.rev v.bucket_counts); + histogram_data_point_set_attributes v (List.rev v.attributes); ); continue__ := false | Some (9, Pbrt.Bytes) -> begin - v.attributes <- (Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes; + histogram_data_point_set_attributes v ((Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes); end | Some (9, pk) -> - Pbrt.Decoder.unexpected_payload "Message(histogram_data_point), field(9)" pk + Pbrt.Decoder.unexpected_payload_message "histogram_data_point" 9 pk | Some (2, Pbrt.Bits64) -> begin - v.start_time_unix_nano <- Pbrt.Decoder.int64_as_bits64 d; + histogram_data_point_set_start_time_unix_nano v (Pbrt.Decoder.int64_as_bits64 d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(histogram_data_point), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "histogram_data_point" 2 pk | Some (3, Pbrt.Bits64) -> begin - v.time_unix_nano <- Pbrt.Decoder.int64_as_bits64 d; + histogram_data_point_set_time_unix_nano v (Pbrt.Decoder.int64_as_bits64 d); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(histogram_data_point), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "histogram_data_point" 3 pk | Some (4, Pbrt.Bits64) -> begin - v.count <- Pbrt.Decoder.int64_as_bits64 d; + histogram_data_point_set_count v (Pbrt.Decoder.int64_as_bits64 d); end | Some (4, pk) -> - Pbrt.Decoder.unexpected_payload "Message(histogram_data_point), field(4)" pk + Pbrt.Decoder.unexpected_payload_message "histogram_data_point" 4 pk | Some (5, Pbrt.Bits64) -> begin - v.sum <- Some (Pbrt.Decoder.float_as_bits64 d); + histogram_data_point_set_sum v (Pbrt.Decoder.float_as_bits64 d); end | Some (5, pk) -> - Pbrt.Decoder.unexpected_payload "Message(histogram_data_point), field(5)" pk + Pbrt.Decoder.unexpected_payload_message "histogram_data_point" 5 pk | Some (6, Pbrt.Bytes) -> begin - v.bucket_counts <- Pbrt.Decoder.packed_fold (fun l d -> (Pbrt.Decoder.int64_as_bits64 d)::l) [] d; + histogram_data_point_set_bucket_counts v @@ Pbrt.Decoder.packed_fold (fun l d -> (Pbrt.Decoder.int64_as_bits64 d)::l) [] d; end | Some (6, pk) -> - Pbrt.Decoder.unexpected_payload "Message(histogram_data_point), field(6)" pk + Pbrt.Decoder.unexpected_payload_message "histogram_data_point" 6 pk | Some (7, Pbrt.Bytes) -> begin - v.explicit_bounds <- Pbrt.Decoder.packed_fold (fun l d -> (Pbrt.Decoder.float_as_bits64 d)::l) [] d; + histogram_data_point_set_explicit_bounds v @@ Pbrt.Decoder.packed_fold (fun l d -> (Pbrt.Decoder.float_as_bits64 d)::l) [] d; end | Some (7, pk) -> - Pbrt.Decoder.unexpected_payload "Message(histogram_data_point), field(7)" pk + Pbrt.Decoder.unexpected_payload_message "histogram_data_point" 7 pk | Some (8, Pbrt.Bytes) -> begin - v.exemplars <- (decode_pb_exemplar (Pbrt.Decoder.nested d)) :: v.exemplars; + histogram_data_point_set_exemplars v ((decode_pb_exemplar (Pbrt.Decoder.nested d)) :: v.exemplars); end | Some (8, pk) -> - Pbrt.Decoder.unexpected_payload "Message(histogram_data_point), field(8)" pk + Pbrt.Decoder.unexpected_payload_message "histogram_data_point" 8 pk | Some (10, Pbrt.Varint) -> begin - v.flags <- Pbrt.Decoder.int32_as_varint d; + histogram_data_point_set_flags v (Pbrt.Decoder.int32_as_varint d); end | Some (10, pk) -> - Pbrt.Decoder.unexpected_payload "Message(histogram_data_point), field(10)" pk + Pbrt.Decoder.unexpected_payload_message "histogram_data_point" 10 pk | Some (11, Pbrt.Bits64) -> begin - v.min <- Some (Pbrt.Decoder.float_as_bits64 d); + histogram_data_point_set_min v (Pbrt.Decoder.float_as_bits64 d); end | Some (11, pk) -> - Pbrt.Decoder.unexpected_payload "Message(histogram_data_point), field(11)" pk + Pbrt.Decoder.unexpected_payload_message "histogram_data_point" 11 pk | Some (12, Pbrt.Bits64) -> begin - v.max <- Some (Pbrt.Decoder.float_as_bits64 d); + histogram_data_point_set_max v (Pbrt.Decoder.float_as_bits64 d); end | Some (12, pk) -> - Pbrt.Decoder.unexpected_payload "Message(histogram_data_point), field(12)" pk + Pbrt.Decoder.unexpected_payload_message "histogram_data_point" 12 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - attributes = v.attributes; - start_time_unix_nano = v.start_time_unix_nano; - time_unix_nano = v.time_unix_nano; - count = v.count; - sum = v.sum; - bucket_counts = v.bucket_counts; - explicit_bounds = v.explicit_bounds; - exemplars = v.exemplars; - flags = v.flags; - min = v.min; - max = v.max; - } : histogram_data_point) + (v : histogram_data_point) let rec decode_pb_histogram d = - let v = default_histogram_mutable () in + let v = default_histogram () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.data_points <- List.rev v.data_points; + (* put lists in the correct order *) + histogram_set_data_points v (List.rev v.data_points); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.data_points <- (decode_pb_histogram_data_point (Pbrt.Decoder.nested d)) :: v.data_points; + histogram_set_data_points v ((decode_pb_histogram_data_point (Pbrt.Decoder.nested d)) :: v.data_points); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(histogram), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "histogram" 1 pk | Some (2, Pbrt.Varint) -> begin - v.aggregation_temporality <- decode_pb_aggregation_temporality d; + histogram_set_aggregation_temporality v (decode_pb_aggregation_temporality d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(histogram), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "histogram" 2 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - data_points = v.data_points; - aggregation_temporality = v.aggregation_temporality; - } : histogram) + (v : histogram) let rec decode_pb_exponential_histogram_data_point_buckets d = - let v = default_exponential_histogram_data_point_buckets_mutable () in + let v = default_exponential_histogram_data_point_buckets () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.bucket_counts <- List.rev v.bucket_counts; + (* put lists in the correct order *) + exponential_histogram_data_point_buckets_set_bucket_counts v (List.rev v.bucket_counts); ); continue__ := false | Some (1, Pbrt.Varint) -> begin - v.offset <- Pbrt.Decoder.int32_as_zigzag d; + exponential_histogram_data_point_buckets_set_offset v (Pbrt.Decoder.int32_as_zigzag d); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram_data_point_buckets), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram_data_point_buckets" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.bucket_counts <- Pbrt.Decoder.packed_fold (fun l d -> (Pbrt.Decoder.int64_as_varint d)::l) [] d; + exponential_histogram_data_point_buckets_set_bucket_counts v @@ Pbrt.Decoder.packed_fold (fun l d -> (Pbrt.Decoder.int64_as_varint d)::l) [] d; end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram_data_point_buckets), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram_data_point_buckets" 2 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - offset = v.offset; - bucket_counts = v.bucket_counts; - } : exponential_histogram_data_point_buckets) + (v : exponential_histogram_data_point_buckets) let rec decode_pb_exponential_histogram_data_point d = - let v = default_exponential_histogram_data_point_mutable () in + let v = default_exponential_histogram_data_point () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.exemplars <- List.rev v.exemplars; - v.attributes <- List.rev v.attributes; + (* put lists in the correct order *) + exponential_histogram_data_point_set_exemplars v (List.rev v.exemplars); + exponential_histogram_data_point_set_attributes v (List.rev v.attributes); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.attributes <- (Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes; + exponential_histogram_data_point_set_attributes v ((Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram_data_point), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram_data_point" 1 pk | Some (2, Pbrt.Bits64) -> begin - v.start_time_unix_nano <- Pbrt.Decoder.int64_as_bits64 d; + exponential_histogram_data_point_set_start_time_unix_nano v (Pbrt.Decoder.int64_as_bits64 d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram_data_point), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram_data_point" 2 pk | Some (3, Pbrt.Bits64) -> begin - v.time_unix_nano <- Pbrt.Decoder.int64_as_bits64 d; + exponential_histogram_data_point_set_time_unix_nano v (Pbrt.Decoder.int64_as_bits64 d); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram_data_point), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram_data_point" 3 pk | Some (4, Pbrt.Bits64) -> begin - v.count <- Pbrt.Decoder.int64_as_bits64 d; + exponential_histogram_data_point_set_count v (Pbrt.Decoder.int64_as_bits64 d); end | Some (4, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram_data_point), field(4)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram_data_point" 4 pk | Some (5, Pbrt.Bits64) -> begin - v.sum <- Some (Pbrt.Decoder.float_as_bits64 d); + exponential_histogram_data_point_set_sum v (Pbrt.Decoder.float_as_bits64 d); end | Some (5, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram_data_point), field(5)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram_data_point" 5 pk | Some (6, Pbrt.Varint) -> begin - v.scale <- Pbrt.Decoder.int32_as_zigzag d; + exponential_histogram_data_point_set_scale v (Pbrt.Decoder.int32_as_zigzag d); end | Some (6, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram_data_point), field(6)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram_data_point" 6 pk | Some (7, Pbrt.Bits64) -> begin - v.zero_count <- Pbrt.Decoder.int64_as_bits64 d; + exponential_histogram_data_point_set_zero_count v (Pbrt.Decoder.int64_as_bits64 d); end | Some (7, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram_data_point), field(7)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram_data_point" 7 pk | Some (8, Pbrt.Bytes) -> begin - v.positive <- Some (decode_pb_exponential_histogram_data_point_buckets (Pbrt.Decoder.nested d)); + exponential_histogram_data_point_set_positive v (decode_pb_exponential_histogram_data_point_buckets (Pbrt.Decoder.nested d)); end | Some (8, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram_data_point), field(8)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram_data_point" 8 pk | Some (9, Pbrt.Bytes) -> begin - v.negative <- Some (decode_pb_exponential_histogram_data_point_buckets (Pbrt.Decoder.nested d)); + exponential_histogram_data_point_set_negative v (decode_pb_exponential_histogram_data_point_buckets (Pbrt.Decoder.nested d)); end | Some (9, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram_data_point), field(9)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram_data_point" 9 pk | Some (10, Pbrt.Varint) -> begin - v.flags <- Pbrt.Decoder.int32_as_varint d; + exponential_histogram_data_point_set_flags v (Pbrt.Decoder.int32_as_varint d); end | Some (10, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram_data_point), field(10)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram_data_point" 10 pk | Some (11, Pbrt.Bytes) -> begin - v.exemplars <- (decode_pb_exemplar (Pbrt.Decoder.nested d)) :: v.exemplars; + exponential_histogram_data_point_set_exemplars v ((decode_pb_exemplar (Pbrt.Decoder.nested d)) :: v.exemplars); end | Some (11, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram_data_point), field(11)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram_data_point" 11 pk | Some (12, Pbrt.Bits64) -> begin - v.min <- Some (Pbrt.Decoder.float_as_bits64 d); + exponential_histogram_data_point_set_min v (Pbrt.Decoder.float_as_bits64 d); end | Some (12, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram_data_point), field(12)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram_data_point" 12 pk | Some (13, Pbrt.Bits64) -> begin - v.max <- Some (Pbrt.Decoder.float_as_bits64 d); + exponential_histogram_data_point_set_max v (Pbrt.Decoder.float_as_bits64 d); end | Some (13, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram_data_point), field(13)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram_data_point" 13 pk | Some (14, Pbrt.Bits64) -> begin - v.zero_threshold <- Pbrt.Decoder.float_as_bits64 d; + exponential_histogram_data_point_set_zero_threshold v (Pbrt.Decoder.float_as_bits64 d); end | Some (14, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram_data_point), field(14)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram_data_point" 14 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - attributes = v.attributes; - start_time_unix_nano = v.start_time_unix_nano; - time_unix_nano = v.time_unix_nano; - count = v.count; - sum = v.sum; - scale = v.scale; - zero_count = v.zero_count; - positive = v.positive; - negative = v.negative; - flags = v.flags; - exemplars = v.exemplars; - min = v.min; - max = v.max; - zero_threshold = v.zero_threshold; - } : exponential_histogram_data_point) + (v : exponential_histogram_data_point) let rec decode_pb_exponential_histogram d = - let v = default_exponential_histogram_mutable () in + let v = default_exponential_histogram () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.data_points <- List.rev v.data_points; + (* put lists in the correct order *) + exponential_histogram_set_data_points v (List.rev v.data_points); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.data_points <- (decode_pb_exponential_histogram_data_point (Pbrt.Decoder.nested d)) :: v.data_points; + exponential_histogram_set_data_points v ((decode_pb_exponential_histogram_data_point (Pbrt.Decoder.nested d)) :: v.data_points); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram" 1 pk | Some (2, Pbrt.Varint) -> begin - v.aggregation_temporality <- decode_pb_aggregation_temporality d; + exponential_histogram_set_aggregation_temporality v (decode_pb_aggregation_temporality d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(exponential_histogram), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "exponential_histogram" 2 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - data_points = v.data_points; - aggregation_temporality = v.aggregation_temporality; - } : exponential_histogram) + (v : exponential_histogram) let rec decode_pb_summary_data_point_value_at_quantile d = - let v = default_summary_data_point_value_at_quantile_mutable () in + let v = default_summary_data_point_value_at_quantile () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( ); continue__ := false | Some (1, Pbrt.Bits64) -> begin - v.quantile <- Pbrt.Decoder.float_as_bits64 d; + summary_data_point_value_at_quantile_set_quantile v (Pbrt.Decoder.float_as_bits64 d); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(summary_data_point_value_at_quantile), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "summary_data_point_value_at_quantile" 1 pk | Some (2, Pbrt.Bits64) -> begin - v.value <- Pbrt.Decoder.float_as_bits64 d; + summary_data_point_value_at_quantile_set_value v (Pbrt.Decoder.float_as_bits64 d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(summary_data_point_value_at_quantile), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "summary_data_point_value_at_quantile" 2 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - quantile = v.quantile; - value = v.value; - } : summary_data_point_value_at_quantile) + (v : summary_data_point_value_at_quantile) let rec decode_pb_summary_data_point d = - let v = default_summary_data_point_mutable () in + let v = default_summary_data_point () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.quantile_values <- List.rev v.quantile_values; - v.attributes <- List.rev v.attributes; + (* put lists in the correct order *) + summary_data_point_set_quantile_values v (List.rev v.quantile_values); + summary_data_point_set_attributes v (List.rev v.attributes); ); continue__ := false | Some (7, Pbrt.Bytes) -> begin - v.attributes <- (Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes; + summary_data_point_set_attributes v ((Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes); end | Some (7, pk) -> - Pbrt.Decoder.unexpected_payload "Message(summary_data_point), field(7)" pk + Pbrt.Decoder.unexpected_payload_message "summary_data_point" 7 pk | Some (2, Pbrt.Bits64) -> begin - v.start_time_unix_nano <- Pbrt.Decoder.int64_as_bits64 d; + summary_data_point_set_start_time_unix_nano v (Pbrt.Decoder.int64_as_bits64 d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(summary_data_point), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "summary_data_point" 2 pk | Some (3, Pbrt.Bits64) -> begin - v.time_unix_nano <- Pbrt.Decoder.int64_as_bits64 d; + summary_data_point_set_time_unix_nano v (Pbrt.Decoder.int64_as_bits64 d); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(summary_data_point), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "summary_data_point" 3 pk | Some (4, Pbrt.Bits64) -> begin - v.count <- Pbrt.Decoder.int64_as_bits64 d; + summary_data_point_set_count v (Pbrt.Decoder.int64_as_bits64 d); end | Some (4, pk) -> - Pbrt.Decoder.unexpected_payload "Message(summary_data_point), field(4)" pk + Pbrt.Decoder.unexpected_payload_message "summary_data_point" 4 pk | Some (5, Pbrt.Bits64) -> begin - v.sum <- Pbrt.Decoder.float_as_bits64 d; + summary_data_point_set_sum v (Pbrt.Decoder.float_as_bits64 d); end | Some (5, pk) -> - Pbrt.Decoder.unexpected_payload "Message(summary_data_point), field(5)" pk + Pbrt.Decoder.unexpected_payload_message "summary_data_point" 5 pk | Some (6, Pbrt.Bytes) -> begin - v.quantile_values <- (decode_pb_summary_data_point_value_at_quantile (Pbrt.Decoder.nested d)) :: v.quantile_values; + summary_data_point_set_quantile_values v ((decode_pb_summary_data_point_value_at_quantile (Pbrt.Decoder.nested d)) :: v.quantile_values); end | Some (6, pk) -> - Pbrt.Decoder.unexpected_payload "Message(summary_data_point), field(6)" pk + Pbrt.Decoder.unexpected_payload_message "summary_data_point" 6 pk | Some (8, Pbrt.Varint) -> begin - v.flags <- Pbrt.Decoder.int32_as_varint d; + summary_data_point_set_flags v (Pbrt.Decoder.int32_as_varint d); end | Some (8, pk) -> - Pbrt.Decoder.unexpected_payload "Message(summary_data_point), field(8)" pk + Pbrt.Decoder.unexpected_payload_message "summary_data_point" 8 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - attributes = v.attributes; - start_time_unix_nano = v.start_time_unix_nano; - time_unix_nano = v.time_unix_nano; - count = v.count; - sum = v.sum; - quantile_values = v.quantile_values; - flags = v.flags; - } : summary_data_point) + (v : summary_data_point) let rec decode_pb_summary d = - let v = default_summary_mutable () in + let v = default_summary () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.data_points <- List.rev v.data_points; + (* put lists in the correct order *) + summary_set_data_points v (List.rev v.data_points); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.data_points <- (decode_pb_summary_data_point (Pbrt.Decoder.nested d)) :: v.data_points; + summary_set_data_points v ((decode_pb_summary_data_point (Pbrt.Decoder.nested d)) :: v.data_points); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(summary), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "summary" 1 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - data_points = v.data_points; - } : summary) + (v : summary) let rec decode_pb_metric_data d = let rec loop () = @@ -1879,144 +1980,1044 @@ let rec decode_pb_metric_data d = loop () and decode_pb_metric d = - let v = default_metric_mutable () in + let v = default_metric () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( + (* put lists in the correct order *) + metric_set_metadata v (List.rev v.metadata); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.name <- Pbrt.Decoder.string d; + metric_set_name v (Pbrt.Decoder.string d); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(metric), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "metric" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.description <- Pbrt.Decoder.string d; + metric_set_description v (Pbrt.Decoder.string d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(metric), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "metric" 2 pk | Some (3, Pbrt.Bytes) -> begin - v.unit_ <- Pbrt.Decoder.string d; + metric_set_unit_ v (Pbrt.Decoder.string d); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(metric), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "metric" 3 pk | Some (5, Pbrt.Bytes) -> begin - v.data <- Gauge (decode_pb_gauge (Pbrt.Decoder.nested d)); + metric_set_data v (Gauge (decode_pb_gauge (Pbrt.Decoder.nested d))); end | Some (5, pk) -> - Pbrt.Decoder.unexpected_payload "Message(metric), field(5)" pk + Pbrt.Decoder.unexpected_payload_message "metric" 5 pk | Some (7, Pbrt.Bytes) -> begin - v.data <- Sum (decode_pb_sum (Pbrt.Decoder.nested d)); + metric_set_data v (Sum (decode_pb_sum (Pbrt.Decoder.nested d))); end | Some (7, pk) -> - Pbrt.Decoder.unexpected_payload "Message(metric), field(7)" pk + Pbrt.Decoder.unexpected_payload_message "metric" 7 pk | Some (9, Pbrt.Bytes) -> begin - v.data <- Histogram (decode_pb_histogram (Pbrt.Decoder.nested d)); + metric_set_data v (Histogram (decode_pb_histogram (Pbrt.Decoder.nested d))); end | Some (9, pk) -> - Pbrt.Decoder.unexpected_payload "Message(metric), field(9)" pk + Pbrt.Decoder.unexpected_payload_message "metric" 9 pk | Some (10, Pbrt.Bytes) -> begin - v.data <- Exponential_histogram (decode_pb_exponential_histogram (Pbrt.Decoder.nested d)); + metric_set_data v (Exponential_histogram (decode_pb_exponential_histogram (Pbrt.Decoder.nested d))); end | Some (10, pk) -> - Pbrt.Decoder.unexpected_payload "Message(metric), field(10)" pk + Pbrt.Decoder.unexpected_payload_message "metric" 10 pk | Some (11, Pbrt.Bytes) -> begin - v.data <- Summary (decode_pb_summary (Pbrt.Decoder.nested d)); + metric_set_data v (Summary (decode_pb_summary (Pbrt.Decoder.nested d))); end | Some (11, pk) -> - Pbrt.Decoder.unexpected_payload "Message(metric), field(11)" pk + Pbrt.Decoder.unexpected_payload_message "metric" 11 pk + | Some (12, Pbrt.Bytes) -> begin + metric_set_metadata v ((Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.metadata); + end + | Some (12, pk) -> + Pbrt.Decoder.unexpected_payload_message "metric" 12 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - name = v.name; - description = v.description; - unit_ = v.unit_; - data = v.data; - } : metric) + (v : metric) let rec decode_pb_scope_metrics d = - let v = default_scope_metrics_mutable () in + let v = default_scope_metrics () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.metrics <- List.rev v.metrics; + (* put lists in the correct order *) + scope_metrics_set_metrics v (List.rev v.metrics); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.scope <- Some (Common.decode_pb_instrumentation_scope (Pbrt.Decoder.nested d)); + scope_metrics_set_scope v (Common.decode_pb_instrumentation_scope (Pbrt.Decoder.nested d)); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(scope_metrics), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "scope_metrics" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.metrics <- (decode_pb_metric (Pbrt.Decoder.nested d)) :: v.metrics; + scope_metrics_set_metrics v ((decode_pb_metric (Pbrt.Decoder.nested d)) :: v.metrics); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(scope_metrics), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "scope_metrics" 2 pk | Some (3, Pbrt.Bytes) -> begin - v.schema_url <- Pbrt.Decoder.string d; + scope_metrics_set_schema_url v (Pbrt.Decoder.string d); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(scope_metrics), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "scope_metrics" 3 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - scope = v.scope; - metrics = v.metrics; - schema_url = v.schema_url; - } : scope_metrics) + (v : scope_metrics) let rec decode_pb_resource_metrics d = - let v = default_resource_metrics_mutable () in + let v = default_resource_metrics () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.scope_metrics <- List.rev v.scope_metrics; + (* put lists in the correct order *) + resource_metrics_set_scope_metrics v (List.rev v.scope_metrics); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.resource <- Some (Resource.decode_pb_resource (Pbrt.Decoder.nested d)); + resource_metrics_set_resource v (Resource.decode_pb_resource (Pbrt.Decoder.nested d)); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(resource_metrics), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "resource_metrics" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.scope_metrics <- (decode_pb_scope_metrics (Pbrt.Decoder.nested d)) :: v.scope_metrics; + resource_metrics_set_scope_metrics v ((decode_pb_scope_metrics (Pbrt.Decoder.nested d)) :: v.scope_metrics); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(resource_metrics), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "resource_metrics" 2 pk | Some (3, Pbrt.Bytes) -> begin - v.schema_url <- Pbrt.Decoder.string d; + resource_metrics_set_schema_url v (Pbrt.Decoder.string d); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(resource_metrics), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "resource_metrics" 3 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - resource = v.resource; - scope_metrics = v.scope_metrics; - schema_url = v.schema_url; - } : resource_metrics) + (v : resource_metrics) let rec decode_pb_metrics_data d = - let v = default_metrics_data_mutable () in + let v = default_metrics_data () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.resource_metrics <- List.rev v.resource_metrics; + (* put lists in the correct order *) + metrics_data_set_resource_metrics v (List.rev v.resource_metrics); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.resource_metrics <- (decode_pb_resource_metrics (Pbrt.Decoder.nested d)) :: v.resource_metrics; + metrics_data_set_resource_metrics v ((decode_pb_resource_metrics (Pbrt.Decoder.nested d)) :: v.resource_metrics); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(metrics_data), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "metrics_data" 1 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; + (v : metrics_data) + +let rec decode_pb_data_point_flags d : data_point_flags = + match Pbrt.Decoder.int_as_varint d with + | 0 -> Data_point_flags_do_not_use + | 1 -> Data_point_flags_no_recorded_value_mask + | _ -> Pbrt.Decoder.malformed_variant "data_point_flags" + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 Protobuf YoJson Encoding} *) + +let rec encode_json_exemplar_value (v:exemplar_value) = + begin match v with + | As_double v -> `Assoc [("asDouble", Pbrt_yojson.make_string (string_of_float v))] + | As_int v -> `Assoc [("asInt", Pbrt_yojson.make_string (Int64.to_string v))] + end + +and encode_json_exemplar (v:exemplar) = + let assoc = ref [] in + assoc := ( + let l = v.filtered_attributes |> List.map Common.encode_json_key_value in + ("filteredAttributes", `List l) :: !assoc + ); + if exemplar_has_time_unix_nano v then ( + assoc := ("timeUnixNano", Pbrt_yojson.make_string (Int64.to_string v.time_unix_nano)) :: !assoc; + ); + assoc := (match v.value with + | None -> !assoc + | Some (As_double v) -> ("asDouble", Pbrt_yojson.make_string (string_of_float v)) :: !assoc + | Some (As_int v) -> ("asInt", Pbrt_yojson.make_string (Int64.to_string v)) :: !assoc + ); (* match v.value *) + if exemplar_has_span_id v then ( + assoc := ("spanId", Pbrt_yojson.make_bytes v.span_id) :: !assoc; + ); + if exemplar_has_trace_id v then ( + assoc := ("traceId", Pbrt_yojson.make_bytes v.trace_id) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_number_data_point_value (v:number_data_point_value) = + begin match v with + | As_double v -> `Assoc [("asDouble", Pbrt_yojson.make_string (string_of_float v))] + | As_int v -> `Assoc [("asInt", Pbrt_yojson.make_string (Int64.to_string v))] + end + +and encode_json_number_data_point (v:number_data_point) = + let assoc = ref [] in + assoc := ( + let l = v.attributes |> List.map Common.encode_json_key_value in + ("attributes", `List l) :: !assoc + ); + if number_data_point_has_start_time_unix_nano v then ( + assoc := ("startTimeUnixNano", Pbrt_yojson.make_string (Int64.to_string v.start_time_unix_nano)) :: !assoc; + ); + if number_data_point_has_time_unix_nano v then ( + assoc := ("timeUnixNano", Pbrt_yojson.make_string (Int64.to_string v.time_unix_nano)) :: !assoc; + ); + assoc := (match v.value with + | None -> !assoc + | Some (As_double v) -> ("asDouble", Pbrt_yojson.make_string (string_of_float v)) :: !assoc + | Some (As_int v) -> ("asInt", Pbrt_yojson.make_string (Int64.to_string v)) :: !assoc + ); (* match v.value *) + assoc := ( + let l = v.exemplars |> List.map encode_json_exemplar in + ("exemplars", `List l) :: !assoc + ); + if number_data_point_has_flags v then ( + assoc := ("flags", Pbrt_yojson.make_int (Int32.to_int v.flags)) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_gauge (v:gauge) = + let assoc = ref [] in + assoc := ( + let l = v.data_points |> List.map encode_json_number_data_point in + ("dataPoints", `List l) :: !assoc + ); + `Assoc !assoc + +let rec encode_json_aggregation_temporality (v:aggregation_temporality) = + match v with + | Aggregation_temporality_unspecified -> `String "AGGREGATION_TEMPORALITY_UNSPECIFIED" + | Aggregation_temporality_delta -> `String "AGGREGATION_TEMPORALITY_DELTA" + | Aggregation_temporality_cumulative -> `String "AGGREGATION_TEMPORALITY_CUMULATIVE" + +let rec encode_json_sum (v:sum) = + let assoc = ref [] in + assoc := ( + let l = v.data_points |> List.map encode_json_number_data_point in + ("dataPoints", `List l) :: !assoc + ); + if sum_has_aggregation_temporality v then ( + assoc := ("aggregationTemporality", encode_json_aggregation_temporality v.aggregation_temporality) :: !assoc; + ); + if sum_has_is_monotonic v then ( + assoc := ("isMonotonic", Pbrt_yojson.make_bool v.is_monotonic) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_histogram_data_point (v:histogram_data_point) = + let assoc = ref [] in + assoc := ( + let l = v.attributes |> List.map Common.encode_json_key_value in + ("attributes", `List l) :: !assoc + ); + if histogram_data_point_has_start_time_unix_nano v then ( + assoc := ("startTimeUnixNano", Pbrt_yojson.make_string (Int64.to_string v.start_time_unix_nano)) :: !assoc; + ); + if histogram_data_point_has_time_unix_nano v then ( + assoc := ("timeUnixNano", Pbrt_yojson.make_string (Int64.to_string v.time_unix_nano)) :: !assoc; + ); + if histogram_data_point_has_count v then ( + assoc := ("count", Pbrt_yojson.make_string (Int64.to_string v.count)) :: !assoc; + ); + if histogram_data_point_has_sum v then ( + assoc := ("sum", Pbrt_yojson.make_string (string_of_float v.sum)) :: !assoc; + ); + assoc := ( + let l = v.bucket_counts |> List.map Int64.to_string |> List.map Pbrt_yojson.make_string in + ("bucketCounts", `List l) :: !assoc + ); + assoc := ( + let l = v.explicit_bounds |> List.map string_of_float |> List.map Pbrt_yojson.make_string in + ("explicitBounds", `List l) :: !assoc + ); + assoc := ( + let l = v.exemplars |> List.map encode_json_exemplar in + ("exemplars", `List l) :: !assoc + ); + if histogram_data_point_has_flags v then ( + assoc := ("flags", Pbrt_yojson.make_int (Int32.to_int v.flags)) :: !assoc; + ); + if histogram_data_point_has_min v then ( + assoc := ("min", Pbrt_yojson.make_string (string_of_float v.min)) :: !assoc; + ); + if histogram_data_point_has_max v then ( + assoc := ("max", Pbrt_yojson.make_string (string_of_float v.max)) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_histogram (v:histogram) = + let assoc = ref [] in + assoc := ( + let l = v.data_points |> List.map encode_json_histogram_data_point in + ("dataPoints", `List l) :: !assoc + ); + if histogram_has_aggregation_temporality v then ( + assoc := ("aggregationTemporality", encode_json_aggregation_temporality v.aggregation_temporality) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_exponential_histogram_data_point_buckets (v:exponential_histogram_data_point_buckets) = + let assoc = ref [] in + if exponential_histogram_data_point_buckets_has_offset v then ( + assoc := ("offset", Pbrt_yojson.make_int (Int32.to_int v.offset)) :: !assoc; + ); + assoc := ( + let l = v.bucket_counts |> List.map Int64.to_string |> List.map Pbrt_yojson.make_string in + ("bucketCounts", `List l) :: !assoc + ); + `Assoc !assoc + +let rec encode_json_exponential_histogram_data_point (v:exponential_histogram_data_point) = + let assoc = ref [] in + assoc := ( + let l = v.attributes |> List.map Common.encode_json_key_value in + ("attributes", `List l) :: !assoc + ); + if exponential_histogram_data_point_has_start_time_unix_nano v then ( + assoc := ("startTimeUnixNano", Pbrt_yojson.make_string (Int64.to_string v.start_time_unix_nano)) :: !assoc; + ); + if exponential_histogram_data_point_has_time_unix_nano v then ( + assoc := ("timeUnixNano", Pbrt_yojson.make_string (Int64.to_string v.time_unix_nano)) :: !assoc; + ); + if exponential_histogram_data_point_has_count v then ( + assoc := ("count", Pbrt_yojson.make_string (Int64.to_string v.count)) :: !assoc; + ); + if exponential_histogram_data_point_has_sum v then ( + assoc := ("sum", Pbrt_yojson.make_string (string_of_float v.sum)) :: !assoc; + ); + if exponential_histogram_data_point_has_scale v then ( + assoc := ("scale", Pbrt_yojson.make_int (Int32.to_int v.scale)) :: !assoc; + ); + if exponential_histogram_data_point_has_zero_count v then ( + assoc := ("zeroCount", Pbrt_yojson.make_string (Int64.to_string v.zero_count)) :: !assoc; + ); + assoc := (match v.positive with + | None -> !assoc + | Some v -> ("positive", encode_json_exponential_histogram_data_point_buckets v) :: !assoc); + assoc := (match v.negative with + | None -> !assoc + | Some v -> ("negative", encode_json_exponential_histogram_data_point_buckets v) :: !assoc); + if exponential_histogram_data_point_has_flags v then ( + assoc := ("flags", Pbrt_yojson.make_int (Int32.to_int v.flags)) :: !assoc; + ); + assoc := ( + let l = v.exemplars |> List.map encode_json_exemplar in + ("exemplars", `List l) :: !assoc + ); + if exponential_histogram_data_point_has_min v then ( + assoc := ("min", Pbrt_yojson.make_string (string_of_float v.min)) :: !assoc; + ); + if exponential_histogram_data_point_has_max v then ( + assoc := ("max", Pbrt_yojson.make_string (string_of_float v.max)) :: !assoc; + ); + if exponential_histogram_data_point_has_zero_threshold v then ( + assoc := ("zeroThreshold", Pbrt_yojson.make_string (string_of_float v.zero_threshold)) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_exponential_histogram (v:exponential_histogram) = + let assoc = ref [] in + assoc := ( + let l = v.data_points |> List.map encode_json_exponential_histogram_data_point in + ("dataPoints", `List l) :: !assoc + ); + if exponential_histogram_has_aggregation_temporality v then ( + assoc := ("aggregationTemporality", encode_json_aggregation_temporality v.aggregation_temporality) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_summary_data_point_value_at_quantile (v:summary_data_point_value_at_quantile) = + let assoc = ref [] in + if summary_data_point_value_at_quantile_has_quantile v then ( + assoc := ("quantile", Pbrt_yojson.make_string (string_of_float v.quantile)) :: !assoc; + ); + if summary_data_point_value_at_quantile_has_value v then ( + assoc := ("value", Pbrt_yojson.make_string (string_of_float v.value)) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_summary_data_point (v:summary_data_point) = + let assoc = ref [] in + assoc := ( + let l = v.attributes |> List.map Common.encode_json_key_value in + ("attributes", `List l) :: !assoc + ); + if summary_data_point_has_start_time_unix_nano v then ( + assoc := ("startTimeUnixNano", Pbrt_yojson.make_string (Int64.to_string v.start_time_unix_nano)) :: !assoc; + ); + if summary_data_point_has_time_unix_nano v then ( + assoc := ("timeUnixNano", Pbrt_yojson.make_string (Int64.to_string v.time_unix_nano)) :: !assoc; + ); + if summary_data_point_has_count v then ( + assoc := ("count", Pbrt_yojson.make_string (Int64.to_string v.count)) :: !assoc; + ); + if summary_data_point_has_sum v then ( + assoc := ("sum", Pbrt_yojson.make_string (string_of_float v.sum)) :: !assoc; + ); + assoc := ( + let l = v.quantile_values |> List.map encode_json_summary_data_point_value_at_quantile in + ("quantileValues", `List l) :: !assoc + ); + if summary_data_point_has_flags v then ( + assoc := ("flags", Pbrt_yojson.make_int (Int32.to_int v.flags)) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_summary (v:summary) = + let assoc = ref [] in + assoc := ( + let l = v.data_points |> List.map encode_json_summary_data_point in + ("dataPoints", `List l) :: !assoc + ); + `Assoc !assoc + +let rec encode_json_metric_data (v:metric_data) = + begin match v with + | Gauge v -> `Assoc [("gauge", encode_json_gauge v)] + | Sum v -> `Assoc [("sum", encode_json_sum v)] + | Histogram v -> `Assoc [("histogram", encode_json_histogram v)] + | Exponential_histogram v -> `Assoc [("exponentialHistogram", encode_json_exponential_histogram v)] + | Summary v -> `Assoc [("summary", encode_json_summary v)] + end + +and encode_json_metric (v:metric) = + let assoc = ref [] in + if metric_has_name v then ( + assoc := ("name", Pbrt_yojson.make_string v.name) :: !assoc; + ); + if metric_has_description v then ( + assoc := ("description", Pbrt_yojson.make_string v.description) :: !assoc; + ); + if metric_has_unit_ v then ( + assoc := ("unit", Pbrt_yojson.make_string v.unit_) :: !assoc; + ); + assoc := (match v.data with + | None -> !assoc + | Some (Gauge v) -> ("gauge", encode_json_gauge v) :: !assoc + | Some (Sum v) -> ("sum", encode_json_sum v) :: !assoc + | Some (Histogram v) -> ("histogram", encode_json_histogram v) :: !assoc + | Some (Exponential_histogram v) -> ("exponentialHistogram", encode_json_exponential_histogram v) :: !assoc + | Some (Summary v) -> ("summary", encode_json_summary v) :: !assoc + ); (* match v.data *) + assoc := ( + let l = v.metadata |> List.map Common.encode_json_key_value in + ("metadata", `List l) :: !assoc + ); + `Assoc !assoc + +let rec encode_json_scope_metrics (v:scope_metrics) = + let assoc = ref [] in + assoc := (match v.scope with + | None -> !assoc + | Some v -> ("scope", Common.encode_json_instrumentation_scope v) :: !assoc); + assoc := ( + let l = v.metrics |> List.map encode_json_metric in + ("metrics", `List l) :: !assoc + ); + if scope_metrics_has_schema_url v then ( + assoc := ("schemaUrl", Pbrt_yojson.make_string v.schema_url) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_resource_metrics (v:resource_metrics) = + let assoc = ref [] in + assoc := (match v.resource with + | None -> !assoc + | Some v -> ("resource", Resource.encode_json_resource v) :: !assoc); + assoc := ( + let l = v.scope_metrics |> List.map encode_json_scope_metrics in + ("scopeMetrics", `List l) :: !assoc + ); + if resource_metrics_has_schema_url v then ( + assoc := ("schemaUrl", Pbrt_yojson.make_string v.schema_url) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_metrics_data (v:metrics_data) = + let assoc = ref [] in + assoc := ( + let l = v.resource_metrics |> List.map encode_json_resource_metrics in + ("resourceMetrics", `List l) :: !assoc + ); + `Assoc !assoc + +let rec encode_json_data_point_flags (v:data_point_flags) = + match v with + | Data_point_flags_do_not_use -> `String "DATA_POINT_FLAGS_DO_NOT_USE" + | Data_point_flags_no_recorded_value_mask -> `String "DATA_POINT_FLAGS_NO_RECORDED_VALUE_MASK" + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 JSON Decoding} *) + +let rec decode_json_exemplar_value json = + let assoc = match json with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + let rec loop = function + | [] -> Pbrt_yojson.E.malformed_variant "exemplar_value" + | ("asDouble", json_value)::_ -> + (As_double (Pbrt_yojson.float json_value "exemplar_value" "As_double") : exemplar_value) + | ("asInt", json_value)::_ -> + (As_int (Pbrt_yojson.int64 json_value "exemplar_value" "As_int") : exemplar_value) + + | _ :: tl -> loop tl + in + loop assoc + +and decode_json_exemplar d = + let v = default_exemplar () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("filteredAttributes", `List l) -> begin + exemplar_set_filtered_attributes v @@ List.map (function + | json_value -> (Common.decode_json_key_value json_value) + ) l; + end + | ("timeUnixNano", json_value) -> + exemplar_set_time_unix_nano v (Pbrt_yojson.int64 json_value "exemplar" "time_unix_nano") + | ("asDouble", json_value) -> + exemplar_set_value v (As_double (Pbrt_yojson.float json_value "exemplar" "value")) + | ("asInt", json_value) -> + exemplar_set_value v (As_int (Pbrt_yojson.int64 json_value "exemplar" "value")) + | ("spanId", json_value) -> + exemplar_set_span_id v (Pbrt_yojson.bytes json_value "exemplar" "span_id") + | ("traceId", json_value) -> + exemplar_set_trace_id v (Pbrt_yojson.bytes json_value "exemplar" "trace_id") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + filtered_attributes = v.filtered_attributes; + time_unix_nano = v.time_unix_nano; + value = v.value; + span_id = v.span_id; + trace_id = v.trace_id; + } : exemplar) + +let rec decode_json_number_data_point_value json = + let assoc = match json with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + let rec loop = function + | [] -> Pbrt_yojson.E.malformed_variant "number_data_point_value" + | ("asDouble", json_value)::_ -> + (As_double (Pbrt_yojson.float json_value "number_data_point_value" "As_double") : number_data_point_value) + | ("asInt", json_value)::_ -> + (As_int (Pbrt_yojson.int64 json_value "number_data_point_value" "As_int") : number_data_point_value) + + | _ :: tl -> loop tl + in + loop assoc + +and decode_json_number_data_point d = + let v = default_number_data_point () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("attributes", `List l) -> begin + number_data_point_set_attributes v @@ List.map (function + | json_value -> (Common.decode_json_key_value json_value) + ) l; + end + | ("startTimeUnixNano", json_value) -> + number_data_point_set_start_time_unix_nano v (Pbrt_yojson.int64 json_value "number_data_point" "start_time_unix_nano") + | ("timeUnixNano", json_value) -> + number_data_point_set_time_unix_nano v (Pbrt_yojson.int64 json_value "number_data_point" "time_unix_nano") + | ("asDouble", json_value) -> + number_data_point_set_value v (As_double (Pbrt_yojson.float json_value "number_data_point" "value")) + | ("asInt", json_value) -> + number_data_point_set_value v (As_int (Pbrt_yojson.int64 json_value "number_data_point" "value")) + | ("exemplars", `List l) -> begin + number_data_point_set_exemplars v @@ List.map (function + | json_value -> (decode_json_exemplar json_value) + ) l; + end + | ("flags", json_value) -> + number_data_point_set_flags v (Pbrt_yojson.int32 json_value "number_data_point" "flags") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + attributes = v.attributes; + start_time_unix_nano = v.start_time_unix_nano; + time_unix_nano = v.time_unix_nano; + value = v.value; + exemplars = v.exemplars; + flags = v.flags; + } : number_data_point) + +let rec decode_json_gauge d = + let v = default_gauge () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("dataPoints", `List l) -> begin + gauge_set_data_points v @@ List.map (function + | json_value -> (decode_json_number_data_point json_value) + ) l; + end + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + data_points = v.data_points; + } : gauge) + +let rec decode_json_aggregation_temporality json = + match json with + | `String "AGGREGATION_TEMPORALITY_UNSPECIFIED" -> (Aggregation_temporality_unspecified : aggregation_temporality) + | `String "AGGREGATION_TEMPORALITY_DELTA" -> (Aggregation_temporality_delta : aggregation_temporality) + | `String "AGGREGATION_TEMPORALITY_CUMULATIVE" -> (Aggregation_temporality_cumulative : aggregation_temporality) + | _ -> Pbrt_yojson.E.malformed_variant "aggregation_temporality" + +let rec decode_json_sum d = + let v = default_sum () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("dataPoints", `List l) -> begin + sum_set_data_points v @@ List.map (function + | json_value -> (decode_json_number_data_point json_value) + ) l; + end + | ("aggregationTemporality", json_value) -> + sum_set_aggregation_temporality v ((decode_json_aggregation_temporality json_value)) + | ("isMonotonic", json_value) -> + sum_set_is_monotonic v (Pbrt_yojson.bool json_value "sum" "is_monotonic") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + data_points = v.data_points; + aggregation_temporality = v.aggregation_temporality; + is_monotonic = v.is_monotonic; + } : sum) + +let rec decode_json_histogram_data_point d = + let v = default_histogram_data_point () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("attributes", `List l) -> begin + histogram_data_point_set_attributes v @@ List.map (function + | json_value -> (Common.decode_json_key_value json_value) + ) l; + end + | ("startTimeUnixNano", json_value) -> + histogram_data_point_set_start_time_unix_nano v (Pbrt_yojson.int64 json_value "histogram_data_point" "start_time_unix_nano") + | ("timeUnixNano", json_value) -> + histogram_data_point_set_time_unix_nano v (Pbrt_yojson.int64 json_value "histogram_data_point" "time_unix_nano") + | ("count", json_value) -> + histogram_data_point_set_count v (Pbrt_yojson.int64 json_value "histogram_data_point" "count") + | ("sum", json_value) -> + histogram_data_point_set_sum v (Pbrt_yojson.float json_value "histogram_data_point" "sum") + | ("bucketCounts", `List l) -> begin + histogram_data_point_set_bucket_counts v @@ List.map (function + | json_value -> Pbrt_yojson.int64 json_value "histogram_data_point" "bucket_counts" + ) l; + end + | ("explicitBounds", `List l) -> begin + histogram_data_point_set_explicit_bounds v @@ List.map (function + | json_value -> Pbrt_yojson.float json_value "histogram_data_point" "explicit_bounds" + ) l; + end + | ("exemplars", `List l) -> begin + histogram_data_point_set_exemplars v @@ List.map (function + | json_value -> (decode_json_exemplar json_value) + ) l; + end + | ("flags", json_value) -> + histogram_data_point_set_flags v (Pbrt_yojson.int32 json_value "histogram_data_point" "flags") + | ("min", json_value) -> + histogram_data_point_set_min v (Pbrt_yojson.float json_value "histogram_data_point" "min") + | ("max", json_value) -> + histogram_data_point_set_max v (Pbrt_yojson.float json_value "histogram_data_point" "max") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + attributes = v.attributes; + start_time_unix_nano = v.start_time_unix_nano; + time_unix_nano = v.time_unix_nano; + count = v.count; + sum = v.sum; + bucket_counts = v.bucket_counts; + explicit_bounds = v.explicit_bounds; + exemplars = v.exemplars; + flags = v.flags; + min = v.min; + max = v.max; + } : histogram_data_point) + +let rec decode_json_histogram d = + let v = default_histogram () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("dataPoints", `List l) -> begin + histogram_set_data_points v @@ List.map (function + | json_value -> (decode_json_histogram_data_point json_value) + ) l; + end + | ("aggregationTemporality", json_value) -> + histogram_set_aggregation_temporality v ((decode_json_aggregation_temporality json_value)) + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + data_points = v.data_points; + aggregation_temporality = v.aggregation_temporality; + } : histogram) + +let rec decode_json_exponential_histogram_data_point_buckets d = + let v = default_exponential_histogram_data_point_buckets () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("offset", json_value) -> + exponential_histogram_data_point_buckets_set_offset v (Pbrt_yojson.int32 json_value "exponential_histogram_data_point_buckets" "offset") + | ("bucketCounts", `List l) -> begin + exponential_histogram_data_point_buckets_set_bucket_counts v @@ List.map (function + | json_value -> Pbrt_yojson.int64 json_value "exponential_histogram_data_point_buckets" "bucket_counts" + ) l; + end + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + offset = v.offset; + bucket_counts = v.bucket_counts; + } : exponential_histogram_data_point_buckets) + +let rec decode_json_exponential_histogram_data_point d = + let v = default_exponential_histogram_data_point () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("attributes", `List l) -> begin + exponential_histogram_data_point_set_attributes v @@ List.map (function + | json_value -> (Common.decode_json_key_value json_value) + ) l; + end + | ("startTimeUnixNano", json_value) -> + exponential_histogram_data_point_set_start_time_unix_nano v (Pbrt_yojson.int64 json_value "exponential_histogram_data_point" "start_time_unix_nano") + | ("timeUnixNano", json_value) -> + exponential_histogram_data_point_set_time_unix_nano v (Pbrt_yojson.int64 json_value "exponential_histogram_data_point" "time_unix_nano") + | ("count", json_value) -> + exponential_histogram_data_point_set_count v (Pbrt_yojson.int64 json_value "exponential_histogram_data_point" "count") + | ("sum", json_value) -> + exponential_histogram_data_point_set_sum v (Pbrt_yojson.float json_value "exponential_histogram_data_point" "sum") + | ("scale", json_value) -> + exponential_histogram_data_point_set_scale v (Pbrt_yojson.int32 json_value "exponential_histogram_data_point" "scale") + | ("zeroCount", json_value) -> + exponential_histogram_data_point_set_zero_count v (Pbrt_yojson.int64 json_value "exponential_histogram_data_point" "zero_count") + | ("positive", json_value) -> + exponential_histogram_data_point_set_positive v (decode_json_exponential_histogram_data_point_buckets json_value) + | ("negative", json_value) -> + exponential_histogram_data_point_set_negative v (decode_json_exponential_histogram_data_point_buckets json_value) + | ("flags", json_value) -> + exponential_histogram_data_point_set_flags v (Pbrt_yojson.int32 json_value "exponential_histogram_data_point" "flags") + | ("exemplars", `List l) -> begin + exponential_histogram_data_point_set_exemplars v @@ List.map (function + | json_value -> (decode_json_exemplar json_value) + ) l; + end + | ("min", json_value) -> + exponential_histogram_data_point_set_min v (Pbrt_yojson.float json_value "exponential_histogram_data_point" "min") + | ("max", json_value) -> + exponential_histogram_data_point_set_max v (Pbrt_yojson.float json_value "exponential_histogram_data_point" "max") + | ("zeroThreshold", json_value) -> + exponential_histogram_data_point_set_zero_threshold v (Pbrt_yojson.float json_value "exponential_histogram_data_point" "zero_threshold") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + attributes = v.attributes; + start_time_unix_nano = v.start_time_unix_nano; + time_unix_nano = v.time_unix_nano; + count = v.count; + sum = v.sum; + scale = v.scale; + zero_count = v.zero_count; + positive = v.positive; + negative = v.negative; + flags = v.flags; + exemplars = v.exemplars; + min = v.min; + max = v.max; + zero_threshold = v.zero_threshold; + } : exponential_histogram_data_point) + +let rec decode_json_exponential_histogram d = + let v = default_exponential_histogram () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("dataPoints", `List l) -> begin + exponential_histogram_set_data_points v @@ List.map (function + | json_value -> (decode_json_exponential_histogram_data_point json_value) + ) l; + end + | ("aggregationTemporality", json_value) -> + exponential_histogram_set_aggregation_temporality v ((decode_json_aggregation_temporality json_value)) + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + data_points = v.data_points; + aggregation_temporality = v.aggregation_temporality; + } : exponential_histogram) + +let rec decode_json_summary_data_point_value_at_quantile d = + let v = default_summary_data_point_value_at_quantile () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("quantile", json_value) -> + summary_data_point_value_at_quantile_set_quantile v (Pbrt_yojson.float json_value "summary_data_point_value_at_quantile" "quantile") + | ("value", json_value) -> + summary_data_point_value_at_quantile_set_value v (Pbrt_yojson.float json_value "summary_data_point_value_at_quantile" "value") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + quantile = v.quantile; + value = v.value; + } : summary_data_point_value_at_quantile) + +let rec decode_json_summary_data_point d = + let v = default_summary_data_point () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("attributes", `List l) -> begin + summary_data_point_set_attributes v @@ List.map (function + | json_value -> (Common.decode_json_key_value json_value) + ) l; + end + | ("startTimeUnixNano", json_value) -> + summary_data_point_set_start_time_unix_nano v (Pbrt_yojson.int64 json_value "summary_data_point" "start_time_unix_nano") + | ("timeUnixNano", json_value) -> + summary_data_point_set_time_unix_nano v (Pbrt_yojson.int64 json_value "summary_data_point" "time_unix_nano") + | ("count", json_value) -> + summary_data_point_set_count v (Pbrt_yojson.int64 json_value "summary_data_point" "count") + | ("sum", json_value) -> + summary_data_point_set_sum v (Pbrt_yojson.float json_value "summary_data_point" "sum") + | ("quantileValues", `List l) -> begin + summary_data_point_set_quantile_values v @@ List.map (function + | json_value -> (decode_json_summary_data_point_value_at_quantile json_value) + ) l; + end + | ("flags", json_value) -> + summary_data_point_set_flags v (Pbrt_yojson.int32 json_value "summary_data_point" "flags") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + attributes = v.attributes; + start_time_unix_nano = v.start_time_unix_nano; + time_unix_nano = v.time_unix_nano; + count = v.count; + sum = v.sum; + quantile_values = v.quantile_values; + flags = v.flags; + } : summary_data_point) + +let rec decode_json_summary d = + let v = default_summary () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("dataPoints", `List l) -> begin + summary_set_data_points v @@ List.map (function + | json_value -> (decode_json_summary_data_point json_value) + ) l; + end + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + data_points = v.data_points; + } : summary) + +let rec decode_json_metric_data json = + let assoc = match json with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + let rec loop = function + | [] -> Pbrt_yojson.E.malformed_variant "metric_data" + | ("gauge", json_value)::_ -> + (Gauge ((decode_json_gauge json_value)) : metric_data) + | ("sum", json_value)::_ -> + (Sum ((decode_json_sum json_value)) : metric_data) + | ("histogram", json_value)::_ -> + (Histogram ((decode_json_histogram json_value)) : metric_data) + | ("exponentialHistogram", json_value)::_ -> + (Exponential_histogram ((decode_json_exponential_histogram json_value)) : metric_data) + | ("summary", json_value)::_ -> + (Summary ((decode_json_summary json_value)) : metric_data) + + | _ :: tl -> loop tl + in + loop assoc + +and decode_json_metric d = + let v = default_metric () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("name", json_value) -> + metric_set_name v (Pbrt_yojson.string json_value "metric" "name") + | ("description", json_value) -> + metric_set_description v (Pbrt_yojson.string json_value "metric" "description") + | ("unit", json_value) -> + metric_set_unit_ v (Pbrt_yojson.string json_value "metric" "unit_") + | ("gauge", json_value) -> + metric_set_data v (Gauge ((decode_json_gauge json_value))) + | ("sum", json_value) -> + metric_set_data v (Sum ((decode_json_sum json_value))) + | ("histogram", json_value) -> + metric_set_data v (Histogram ((decode_json_histogram json_value))) + | ("exponentialHistogram", json_value) -> + metric_set_data v (Exponential_histogram ((decode_json_exponential_histogram json_value))) + | ("summary", json_value) -> + metric_set_data v (Summary ((decode_json_summary json_value))) + | ("metadata", `List l) -> begin + metric_set_metadata v @@ List.map (function + | json_value -> (Common.decode_json_key_value json_value) + ) l; + end + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + name = v.name; + description = v.description; + unit_ = v.unit_; + data = v.data; + metadata = v.metadata; + } : metric) + +let rec decode_json_scope_metrics d = + let v = default_scope_metrics () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("scope", json_value) -> + scope_metrics_set_scope v (Common.decode_json_instrumentation_scope json_value) + | ("metrics", `List l) -> begin + scope_metrics_set_metrics v @@ List.map (function + | json_value -> (decode_json_metric json_value) + ) l; + end + | ("schemaUrl", json_value) -> + scope_metrics_set_schema_url v (Pbrt_yojson.string json_value "scope_metrics" "schema_url") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + scope = v.scope; + metrics = v.metrics; + schema_url = v.schema_url; + } : scope_metrics) + +let rec decode_json_resource_metrics d = + let v = default_resource_metrics () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("resource", json_value) -> + resource_metrics_set_resource v (Resource.decode_json_resource json_value) + | ("scopeMetrics", `List l) -> begin + resource_metrics_set_scope_metrics v @@ List.map (function + | json_value -> (decode_json_scope_metrics json_value) + ) l; + end + | ("schemaUrl", json_value) -> + resource_metrics_set_schema_url v (Pbrt_yojson.string json_value "resource_metrics" "schema_url") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + resource = v.resource; + scope_metrics = v.scope_metrics; + schema_url = v.schema_url; + } : resource_metrics) + +let rec decode_json_metrics_data d = + let v = default_metrics_data () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("resourceMetrics", `List l) -> begin + metrics_data_set_resource_metrics v @@ List.map (function + | json_value -> (decode_json_resource_metrics json_value) + ) l; + end + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; ({ resource_metrics = v.resource_metrics; } : metrics_data) -let rec decode_pb_data_point_flags d = - match Pbrt.Decoder.int_as_varint d with - | 0 -> (Data_point_flags_do_not_use:data_point_flags) - | 1 -> (Data_point_flags_no_recorded_value_mask:data_point_flags) - | _ -> Pbrt.Decoder.malformed_variant "data_point_flags" +let rec decode_json_data_point_flags json = + match json with + | `String "DATA_POINT_FLAGS_DO_NOT_USE" -> (Data_point_flags_do_not_use : data_point_flags) + | `String "DATA_POINT_FLAGS_NO_RECORDED_VALUE_MASK" -> (Data_point_flags_no_recorded_value_mask : data_point_flags) + | _ -> Pbrt_yojson.E.malformed_variant "data_point_flags" diff --git a/src/proto/metrics.mli b/src/proto/metrics.mli index d96268835..bc7c10349 100644 --- a/src/proto/metrics.mli +++ b/src/proto/metrics.mli @@ -11,29 +11,31 @@ type exemplar_value = | As_double of float | As_int of int64 -and exemplar = { - filtered_attributes : Common.key_value list; - time_unix_nano : int64; - value : exemplar_value; - span_id : bytes; - trace_id : bytes; +and exemplar = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 3 fields *) + mutable filtered_attributes : Common.key_value list; + mutable time_unix_nano : int64; + mutable value : exemplar_value option; + mutable span_id : bytes; + mutable trace_id : bytes; } type number_data_point_value = | As_double of float | As_int of int64 -and number_data_point = { - attributes : Common.key_value list; - start_time_unix_nano : int64; - time_unix_nano : int64; - value : number_data_point_value; - exemplars : exemplar list; - flags : int32; +and number_data_point = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 3 fields *) + mutable attributes : Common.key_value list; + mutable start_time_unix_nano : int64; + mutable time_unix_nano : int64; + mutable value : number_data_point_value option; + mutable exemplars : exemplar list; + mutable flags : int32; } -type gauge = { - data_points : number_data_point list; +type gauge = private { + mutable data_points : number_data_point list; } type aggregation_temporality = @@ -41,75 +43,83 @@ type aggregation_temporality = | Aggregation_temporality_delta | Aggregation_temporality_cumulative -type sum = { - data_points : number_data_point list; - aggregation_temporality : aggregation_temporality; - is_monotonic : bool; +type sum = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 2 fields *) + mutable data_points : number_data_point list; + mutable aggregation_temporality : aggregation_temporality; + mutable is_monotonic : bool; } -type histogram_data_point = { - attributes : Common.key_value list; - start_time_unix_nano : int64; - time_unix_nano : int64; - count : int64; - sum : float option; - bucket_counts : int64 list; - explicit_bounds : float list; - exemplars : exemplar list; - flags : int32; - min : float option; - max : float option; +type histogram_data_point = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 7 fields *) + mutable attributes : Common.key_value list; + mutable start_time_unix_nano : int64; + mutable time_unix_nano : int64; + mutable count : int64; + mutable sum : float; + mutable bucket_counts : int64 list; + mutable explicit_bounds : float list; + mutable exemplars : exemplar list; + mutable flags : int32; + mutable min : float; + mutable max : float; } -type histogram = { - data_points : histogram_data_point list; - aggregation_temporality : aggregation_temporality; +type histogram = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) + mutable data_points : histogram_data_point list; + mutable aggregation_temporality : aggregation_temporality; } -type exponential_histogram_data_point_buckets = { - offset : int32; - bucket_counts : int64 list; +type exponential_histogram_data_point_buckets = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) + mutable offset : int32; + mutable bucket_counts : int64 list; } -type exponential_histogram_data_point = { - attributes : Common.key_value list; - start_time_unix_nano : int64; - time_unix_nano : int64; - count : int64; - sum : float option; - scale : int32; - zero_count : int64; - positive : exponential_histogram_data_point_buckets option; - negative : exponential_histogram_data_point_buckets option; - flags : int32; - exemplars : exemplar list; - min : float option; - max : float option; - zero_threshold : float; +type exponential_histogram_data_point = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 10 fields *) + mutable attributes : Common.key_value list; + mutable start_time_unix_nano : int64; + mutable time_unix_nano : int64; + mutable count : int64; + mutable sum : float; + mutable scale : int32; + mutable zero_count : int64; + mutable positive : exponential_histogram_data_point_buckets option; + mutable negative : exponential_histogram_data_point_buckets option; + mutable flags : int32; + mutable exemplars : exemplar list; + mutable min : float; + mutable max : float; + mutable zero_threshold : float; } -type exponential_histogram = { - data_points : exponential_histogram_data_point list; - aggregation_temporality : aggregation_temporality; +type exponential_histogram = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) + mutable data_points : exponential_histogram_data_point list; + mutable aggregation_temporality : aggregation_temporality; } -type summary_data_point_value_at_quantile = { - quantile : float; - value : float; +type summary_data_point_value_at_quantile = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 2 fields *) + mutable quantile : float; + mutable value : float; } -type summary_data_point = { - attributes : Common.key_value list; - start_time_unix_nano : int64; - time_unix_nano : int64; - count : int64; - sum : float; - quantile_values : summary_data_point_value_at_quantile list; - flags : int32; +type summary_data_point = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 5 fields *) + mutable attributes : Common.key_value list; + mutable start_time_unix_nano : int64; + mutable time_unix_nano : int64; + mutable count : int64; + mutable sum : float; + mutable quantile_values : summary_data_point_value_at_quantile list; + mutable flags : int32; } -type summary = { - data_points : summary_data_point list; +type summary = private { + mutable data_points : summary_data_point list; } type metric_data = @@ -119,27 +129,31 @@ type metric_data = | Exponential_histogram of exponential_histogram | Summary of summary -and metric = { - name : string; - description : string; - unit_ : string; - data : metric_data; +and metric = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 3 fields *) + mutable name : string; + mutable description : string; + mutable unit_ : string; + mutable data : metric_data option; + mutable metadata : Common.key_value list; } -type scope_metrics = { - scope : Common.instrumentation_scope option; - metrics : metric list; - schema_url : string; +type scope_metrics = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) + mutable scope : Common.instrumentation_scope option; + mutable metrics : metric list; + mutable schema_url : string; } -type resource_metrics = { - resource : Resource.resource option; - scope_metrics : scope_metrics list; - schema_url : string; +type resource_metrics = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) + mutable resource : Resource.resource option; + mutable scope_metrics : scope_metrics list; + mutable schema_url : string; } -type metrics_data = { - resource_metrics : resource_metrics list; +type metrics_data = private { + mutable resource_metrics : resource_metrics list; } type data_point_flags = @@ -150,9 +164,72 @@ type data_point_flags = (** {2 Basic values} *) val default_exemplar_value : unit -> exemplar_value -(** [default_exemplar_value ()] is the default value for type [exemplar_value] *) +(** [default_exemplar_value ()] is a new empty value for type [exemplar_value] *) -val default_exemplar : +val default_exemplar : unit -> exemplar +(** [default_exemplar ()] is a new empty value for type [exemplar] *) + +val default_number_data_point_value : unit -> number_data_point_value +(** [default_number_data_point_value ()] is a new empty value for type [number_data_point_value] *) + +val default_number_data_point : unit -> number_data_point +(** [default_number_data_point ()] is a new empty value for type [number_data_point] *) + +val default_gauge : unit -> gauge +(** [default_gauge ()] is a new empty value for type [gauge] *) + +val default_aggregation_temporality : unit -> aggregation_temporality +(** [default_aggregation_temporality ()] is a new empty value for type [aggregation_temporality] *) + +val default_sum : unit -> sum +(** [default_sum ()] is a new empty value for type [sum] *) + +val default_histogram_data_point : unit -> histogram_data_point +(** [default_histogram_data_point ()] is a new empty value for type [histogram_data_point] *) + +val default_histogram : unit -> histogram +(** [default_histogram ()] is a new empty value for type [histogram] *) + +val default_exponential_histogram_data_point_buckets : unit -> exponential_histogram_data_point_buckets +(** [default_exponential_histogram_data_point_buckets ()] is a new empty value for type [exponential_histogram_data_point_buckets] *) + +val default_exponential_histogram_data_point : unit -> exponential_histogram_data_point +(** [default_exponential_histogram_data_point ()] is a new empty value for type [exponential_histogram_data_point] *) + +val default_exponential_histogram : unit -> exponential_histogram +(** [default_exponential_histogram ()] is a new empty value for type [exponential_histogram] *) + +val default_summary_data_point_value_at_quantile : unit -> summary_data_point_value_at_quantile +(** [default_summary_data_point_value_at_quantile ()] is a new empty value for type [summary_data_point_value_at_quantile] *) + +val default_summary_data_point : unit -> summary_data_point +(** [default_summary_data_point ()] is a new empty value for type [summary_data_point] *) + +val default_summary : unit -> summary +(** [default_summary ()] is a new empty value for type [summary] *) + +val default_metric_data : unit -> metric_data +(** [default_metric_data ()] is a new empty value for type [metric_data] *) + +val default_metric : unit -> metric +(** [default_metric ()] is a new empty value for type [metric] *) + +val default_scope_metrics : unit -> scope_metrics +(** [default_scope_metrics ()] is a new empty value for type [scope_metrics] *) + +val default_resource_metrics : unit -> resource_metrics +(** [default_resource_metrics ()] is a new empty value for type [resource_metrics] *) + +val default_metrics_data : unit -> metrics_data +(** [default_metrics_data ()] is a new empty value for type [metrics_data] *) + +val default_data_point_flags : unit -> data_point_flags +(** [default_data_point_flags ()] is a new empty value for type [data_point_flags] *) + + +(** {2 Make functions} *) + +val make_exemplar : ?filtered_attributes:Common.key_value list -> ?time_unix_nano:int64 -> ?value:exemplar_value -> @@ -160,12 +237,35 @@ val default_exemplar : ?trace_id:bytes -> unit -> exemplar -(** [default_exemplar ()] is the default value for type [exemplar] *) +(** [make_exemplar … ()] is a builder for type [exemplar] *) -val default_number_data_point_value : unit -> number_data_point_value -(** [default_number_data_point_value ()] is the default value for type [number_data_point_value] *) +val copy_exemplar : exemplar -> exemplar + +val exemplar_set_filtered_attributes : exemplar -> Common.key_value list -> unit + (** set field filtered_attributes in exemplar *) + +val exemplar_has_time_unix_nano : exemplar -> bool + (** presence of field "time_unix_nano" in [exemplar] *) + +val exemplar_set_time_unix_nano : exemplar -> int64 -> unit + (** set field time_unix_nano in exemplar *) + +val exemplar_set_value : exemplar -> exemplar_value -> unit + (** set field value in exemplar *) + +val exemplar_has_span_id : exemplar -> bool + (** presence of field "span_id" in [exemplar] *) + +val exemplar_set_span_id : exemplar -> bytes -> unit + (** set field span_id in exemplar *) -val default_number_data_point : +val exemplar_has_trace_id : exemplar -> bool + (** presence of field "trace_id" in [exemplar] *) + +val exemplar_set_trace_id : exemplar -> bytes -> unit + (** set field trace_id in exemplar *) + +val make_number_data_point : ?attributes:Common.key_value list -> ?start_time_unix_nano:int64 -> ?time_unix_nano:int64 -> @@ -174,297 +274,464 @@ val default_number_data_point : ?flags:int32 -> unit -> number_data_point -(** [default_number_data_point ()] is the default value for type [number_data_point] *) +(** [make_number_data_point … ()] is a builder for type [number_data_point] *) + +val copy_number_data_point : number_data_point -> number_data_point + +val number_data_point_set_attributes : number_data_point -> Common.key_value list -> unit + (** set field attributes in number_data_point *) + +val number_data_point_has_start_time_unix_nano : number_data_point -> bool + (** presence of field "start_time_unix_nano" in [number_data_point] *) + +val number_data_point_set_start_time_unix_nano : number_data_point -> int64 -> unit + (** set field start_time_unix_nano in number_data_point *) + +val number_data_point_has_time_unix_nano : number_data_point -> bool + (** presence of field "time_unix_nano" in [number_data_point] *) -val default_gauge : +val number_data_point_set_time_unix_nano : number_data_point -> int64 -> unit + (** set field time_unix_nano in number_data_point *) + +val number_data_point_set_value : number_data_point -> number_data_point_value -> unit + (** set field value in number_data_point *) + +val number_data_point_set_exemplars : number_data_point -> exemplar list -> unit + (** set field exemplars in number_data_point *) + +val number_data_point_has_flags : number_data_point -> bool + (** presence of field "flags" in [number_data_point] *) + +val number_data_point_set_flags : number_data_point -> int32 -> unit + (** set field flags in number_data_point *) + +val make_gauge : ?data_points:number_data_point list -> unit -> gauge -(** [default_gauge ()] is the default value for type [gauge] *) +(** [make_gauge … ()] is a builder for type [gauge] *) -val default_aggregation_temporality : unit -> aggregation_temporality -(** [default_aggregation_temporality ()] is the default value for type [aggregation_temporality] *) +val copy_gauge : gauge -> gauge + +val gauge_set_data_points : gauge -> number_data_point list -> unit + (** set field data_points in gauge *) -val default_sum : +val make_sum : ?data_points:number_data_point list -> ?aggregation_temporality:aggregation_temporality -> ?is_monotonic:bool -> unit -> sum -(** [default_sum ()] is the default value for type [sum] *) +(** [make_sum … ()] is a builder for type [sum] *) + +val copy_sum : sum -> sum + +val sum_set_data_points : sum -> number_data_point list -> unit + (** set field data_points in sum *) + +val sum_has_aggregation_temporality : sum -> bool + (** presence of field "aggregation_temporality" in [sum] *) -val default_histogram_data_point : +val sum_set_aggregation_temporality : sum -> aggregation_temporality -> unit + (** set field aggregation_temporality in sum *) + +val sum_has_is_monotonic : sum -> bool + (** presence of field "is_monotonic" in [sum] *) + +val sum_set_is_monotonic : sum -> bool -> unit + (** set field is_monotonic in sum *) + +val make_histogram_data_point : ?attributes:Common.key_value list -> ?start_time_unix_nano:int64 -> ?time_unix_nano:int64 -> ?count:int64 -> - ?sum:float option -> + ?sum:float -> ?bucket_counts:int64 list -> ?explicit_bounds:float list -> ?exemplars:exemplar list -> ?flags:int32 -> - ?min:float option -> - ?max:float option -> + ?min:float -> + ?max:float -> unit -> histogram_data_point -(** [default_histogram_data_point ()] is the default value for type [histogram_data_point] *) +(** [make_histogram_data_point … ()] is a builder for type [histogram_data_point] *) + +val copy_histogram_data_point : histogram_data_point -> histogram_data_point + +val histogram_data_point_set_attributes : histogram_data_point -> Common.key_value list -> unit + (** set field attributes in histogram_data_point *) + +val histogram_data_point_has_start_time_unix_nano : histogram_data_point -> bool + (** presence of field "start_time_unix_nano" in [histogram_data_point] *) + +val histogram_data_point_set_start_time_unix_nano : histogram_data_point -> int64 -> unit + (** set field start_time_unix_nano in histogram_data_point *) + +val histogram_data_point_has_time_unix_nano : histogram_data_point -> bool + (** presence of field "time_unix_nano" in [histogram_data_point] *) + +val histogram_data_point_set_time_unix_nano : histogram_data_point -> int64 -> unit + (** set field time_unix_nano in histogram_data_point *) -val default_histogram : +val histogram_data_point_has_count : histogram_data_point -> bool + (** presence of field "count" in [histogram_data_point] *) + +val histogram_data_point_set_count : histogram_data_point -> int64 -> unit + (** set field count in histogram_data_point *) + +val histogram_data_point_has_sum : histogram_data_point -> bool + (** presence of field "sum" in [histogram_data_point] *) + +val histogram_data_point_set_sum : histogram_data_point -> float -> unit + (** set field sum in histogram_data_point *) + +val histogram_data_point_set_bucket_counts : histogram_data_point -> int64 list -> unit + (** set field bucket_counts in histogram_data_point *) + +val histogram_data_point_set_explicit_bounds : histogram_data_point -> float list -> unit + (** set field explicit_bounds in histogram_data_point *) + +val histogram_data_point_set_exemplars : histogram_data_point -> exemplar list -> unit + (** set field exemplars in histogram_data_point *) + +val histogram_data_point_has_flags : histogram_data_point -> bool + (** presence of field "flags" in [histogram_data_point] *) + +val histogram_data_point_set_flags : histogram_data_point -> int32 -> unit + (** set field flags in histogram_data_point *) + +val histogram_data_point_has_min : histogram_data_point -> bool + (** presence of field "min" in [histogram_data_point] *) + +val histogram_data_point_set_min : histogram_data_point -> float -> unit + (** set field min in histogram_data_point *) + +val histogram_data_point_has_max : histogram_data_point -> bool + (** presence of field "max" in [histogram_data_point] *) + +val histogram_data_point_set_max : histogram_data_point -> float -> unit + (** set field max in histogram_data_point *) + +val make_histogram : ?data_points:histogram_data_point list -> ?aggregation_temporality:aggregation_temporality -> unit -> histogram -(** [default_histogram ()] is the default value for type [histogram] *) +(** [make_histogram … ()] is a builder for type [histogram] *) + +val copy_histogram : histogram -> histogram + +val histogram_set_data_points : histogram -> histogram_data_point list -> unit + (** set field data_points in histogram *) + +val histogram_has_aggregation_temporality : histogram -> bool + (** presence of field "aggregation_temporality" in [histogram] *) -val default_exponential_histogram_data_point_buckets : +val histogram_set_aggregation_temporality : histogram -> aggregation_temporality -> unit + (** set field aggregation_temporality in histogram *) + +val make_exponential_histogram_data_point_buckets : ?offset:int32 -> ?bucket_counts:int64 list -> unit -> exponential_histogram_data_point_buckets -(** [default_exponential_histogram_data_point_buckets ()] is the default value for type [exponential_histogram_data_point_buckets] *) +(** [make_exponential_histogram_data_point_buckets … ()] is a builder for type [exponential_histogram_data_point_buckets] *) + +val copy_exponential_histogram_data_point_buckets : exponential_histogram_data_point_buckets -> exponential_histogram_data_point_buckets + +val exponential_histogram_data_point_buckets_has_offset : exponential_histogram_data_point_buckets -> bool + (** presence of field "offset" in [exponential_histogram_data_point_buckets] *) -val default_exponential_histogram_data_point : +val exponential_histogram_data_point_buckets_set_offset : exponential_histogram_data_point_buckets -> int32 -> unit + (** set field offset in exponential_histogram_data_point_buckets *) + +val exponential_histogram_data_point_buckets_set_bucket_counts : exponential_histogram_data_point_buckets -> int64 list -> unit + (** set field bucket_counts in exponential_histogram_data_point_buckets *) + +val make_exponential_histogram_data_point : ?attributes:Common.key_value list -> ?start_time_unix_nano:int64 -> ?time_unix_nano:int64 -> ?count:int64 -> - ?sum:float option -> + ?sum:float -> ?scale:int32 -> ?zero_count:int64 -> - ?positive:exponential_histogram_data_point_buckets option -> - ?negative:exponential_histogram_data_point_buckets option -> + ?positive:exponential_histogram_data_point_buckets -> + ?negative:exponential_histogram_data_point_buckets -> ?flags:int32 -> ?exemplars:exemplar list -> - ?min:float option -> - ?max:float option -> + ?min:float -> + ?max:float -> ?zero_threshold:float -> unit -> exponential_histogram_data_point -(** [default_exponential_histogram_data_point ()] is the default value for type [exponential_histogram_data_point] *) +(** [make_exponential_histogram_data_point … ()] is a builder for type [exponential_histogram_data_point] *) -val default_exponential_histogram : - ?data_points:exponential_histogram_data_point list -> - ?aggregation_temporality:aggregation_temporality -> - unit -> - exponential_histogram -(** [default_exponential_histogram ()] is the default value for type [exponential_histogram] *) +val copy_exponential_histogram_data_point : exponential_histogram_data_point -> exponential_histogram_data_point -val default_summary_data_point_value_at_quantile : - ?quantile:float -> - ?value:float -> - unit -> - summary_data_point_value_at_quantile -(** [default_summary_data_point_value_at_quantile ()] is the default value for type [summary_data_point_value_at_quantile] *) +val exponential_histogram_data_point_set_attributes : exponential_histogram_data_point -> Common.key_value list -> unit + (** set field attributes in exponential_histogram_data_point *) -val default_summary_data_point : - ?attributes:Common.key_value list -> - ?start_time_unix_nano:int64 -> - ?time_unix_nano:int64 -> - ?count:int64 -> - ?sum:float -> - ?quantile_values:summary_data_point_value_at_quantile list -> - ?flags:int32 -> - unit -> - summary_data_point -(** [default_summary_data_point ()] is the default value for type [summary_data_point] *) +val exponential_histogram_data_point_has_start_time_unix_nano : exponential_histogram_data_point -> bool + (** presence of field "start_time_unix_nano" in [exponential_histogram_data_point] *) -val default_summary : - ?data_points:summary_data_point list -> - unit -> - summary -(** [default_summary ()] is the default value for type [summary] *) +val exponential_histogram_data_point_set_start_time_unix_nano : exponential_histogram_data_point -> int64 -> unit + (** set field start_time_unix_nano in exponential_histogram_data_point *) -val default_metric_data : unit -> metric_data -(** [default_metric_data ()] is the default value for type [metric_data] *) +val exponential_histogram_data_point_has_time_unix_nano : exponential_histogram_data_point -> bool + (** presence of field "time_unix_nano" in [exponential_histogram_data_point] *) -val default_metric : - ?name:string -> - ?description:string -> - ?unit_:string -> - ?data:metric_data -> - unit -> - metric -(** [default_metric ()] is the default value for type [metric] *) +val exponential_histogram_data_point_set_time_unix_nano : exponential_histogram_data_point -> int64 -> unit + (** set field time_unix_nano in exponential_histogram_data_point *) -val default_scope_metrics : - ?scope:Common.instrumentation_scope option -> - ?metrics:metric list -> - ?schema_url:string -> - unit -> - scope_metrics -(** [default_scope_metrics ()] is the default value for type [scope_metrics] *) +val exponential_histogram_data_point_has_count : exponential_histogram_data_point -> bool + (** presence of field "count" in [exponential_histogram_data_point] *) -val default_resource_metrics : - ?resource:Resource.resource option -> - ?scope_metrics:scope_metrics list -> - ?schema_url:string -> - unit -> - resource_metrics -(** [default_resource_metrics ()] is the default value for type [resource_metrics] *) +val exponential_histogram_data_point_set_count : exponential_histogram_data_point -> int64 -> unit + (** set field count in exponential_histogram_data_point *) -val default_metrics_data : - ?resource_metrics:resource_metrics list -> - unit -> - metrics_data -(** [default_metrics_data ()] is the default value for type [metrics_data] *) +val exponential_histogram_data_point_has_sum : exponential_histogram_data_point -> bool + (** presence of field "sum" in [exponential_histogram_data_point] *) -val default_data_point_flags : unit -> data_point_flags -(** [default_data_point_flags ()] is the default value for type [data_point_flags] *) +val exponential_histogram_data_point_set_sum : exponential_histogram_data_point -> float -> unit + (** set field sum in exponential_histogram_data_point *) +val exponential_histogram_data_point_has_scale : exponential_histogram_data_point -> bool + (** presence of field "scale" in [exponential_histogram_data_point] *) -(** {2 Make functions} *) +val exponential_histogram_data_point_set_scale : exponential_histogram_data_point -> int32 -> unit + (** set field scale in exponential_histogram_data_point *) +val exponential_histogram_data_point_has_zero_count : exponential_histogram_data_point -> bool + (** presence of field "zero_count" in [exponential_histogram_data_point] *) -val make_exemplar : - filtered_attributes:Common.key_value list -> - time_unix_nano:int64 -> - value:exemplar_value -> - span_id:bytes -> - trace_id:bytes -> - unit -> - exemplar -(** [make_exemplar … ()] is a builder for type [exemplar] *) +val exponential_histogram_data_point_set_zero_count : exponential_histogram_data_point -> int64 -> unit + (** set field zero_count in exponential_histogram_data_point *) +val exponential_histogram_data_point_set_positive : exponential_histogram_data_point -> exponential_histogram_data_point_buckets -> unit + (** set field positive in exponential_histogram_data_point *) -val make_number_data_point : - attributes:Common.key_value list -> - start_time_unix_nano:int64 -> - time_unix_nano:int64 -> - value:number_data_point_value -> - exemplars:exemplar list -> - flags:int32 -> - unit -> - number_data_point -(** [make_number_data_point … ()] is a builder for type [number_data_point] *) +val exponential_histogram_data_point_set_negative : exponential_histogram_data_point -> exponential_histogram_data_point_buckets -> unit + (** set field negative in exponential_histogram_data_point *) -val make_gauge : - data_points:number_data_point list -> - unit -> - gauge -(** [make_gauge … ()] is a builder for type [gauge] *) +val exponential_histogram_data_point_has_flags : exponential_histogram_data_point -> bool + (** presence of field "flags" in [exponential_histogram_data_point] *) +val exponential_histogram_data_point_set_flags : exponential_histogram_data_point -> int32 -> unit + (** set field flags in exponential_histogram_data_point *) -val make_sum : - data_points:number_data_point list -> - aggregation_temporality:aggregation_temporality -> - is_monotonic:bool -> - unit -> - sum -(** [make_sum … ()] is a builder for type [sum] *) +val exponential_histogram_data_point_set_exemplars : exponential_histogram_data_point -> exemplar list -> unit + (** set field exemplars in exponential_histogram_data_point *) -val make_histogram_data_point : - attributes:Common.key_value list -> - start_time_unix_nano:int64 -> - time_unix_nano:int64 -> - count:int64 -> - ?sum:float option -> - bucket_counts:int64 list -> - explicit_bounds:float list -> - exemplars:exemplar list -> - flags:int32 -> - ?min:float option -> - ?max:float option -> - unit -> - histogram_data_point -(** [make_histogram_data_point … ()] is a builder for type [histogram_data_point] *) +val exponential_histogram_data_point_has_min : exponential_histogram_data_point -> bool + (** presence of field "min" in [exponential_histogram_data_point] *) -val make_histogram : - data_points:histogram_data_point list -> - aggregation_temporality:aggregation_temporality -> - unit -> - histogram -(** [make_histogram … ()] is a builder for type [histogram] *) +val exponential_histogram_data_point_set_min : exponential_histogram_data_point -> float -> unit + (** set field min in exponential_histogram_data_point *) -val make_exponential_histogram_data_point_buckets : - offset:int32 -> - bucket_counts:int64 list -> - unit -> - exponential_histogram_data_point_buckets -(** [make_exponential_histogram_data_point_buckets … ()] is a builder for type [exponential_histogram_data_point_buckets] *) +val exponential_histogram_data_point_has_max : exponential_histogram_data_point -> bool + (** presence of field "max" in [exponential_histogram_data_point] *) -val make_exponential_histogram_data_point : - attributes:Common.key_value list -> - start_time_unix_nano:int64 -> - time_unix_nano:int64 -> - count:int64 -> - ?sum:float option -> - scale:int32 -> - zero_count:int64 -> - ?positive:exponential_histogram_data_point_buckets option -> - ?negative:exponential_histogram_data_point_buckets option -> - flags:int32 -> - exemplars:exemplar list -> - ?min:float option -> - ?max:float option -> - zero_threshold:float -> - unit -> - exponential_histogram_data_point -(** [make_exponential_histogram_data_point … ()] is a builder for type [exponential_histogram_data_point] *) +val exponential_histogram_data_point_set_max : exponential_histogram_data_point -> float -> unit + (** set field max in exponential_histogram_data_point *) + +val exponential_histogram_data_point_has_zero_threshold : exponential_histogram_data_point -> bool + (** presence of field "zero_threshold" in [exponential_histogram_data_point] *) + +val exponential_histogram_data_point_set_zero_threshold : exponential_histogram_data_point -> float -> unit + (** set field zero_threshold in exponential_histogram_data_point *) val make_exponential_histogram : - data_points:exponential_histogram_data_point list -> - aggregation_temporality:aggregation_temporality -> + ?data_points:exponential_histogram_data_point list -> + ?aggregation_temporality:aggregation_temporality -> unit -> exponential_histogram (** [make_exponential_histogram … ()] is a builder for type [exponential_histogram] *) +val copy_exponential_histogram : exponential_histogram -> exponential_histogram + +val exponential_histogram_set_data_points : exponential_histogram -> exponential_histogram_data_point list -> unit + (** set field data_points in exponential_histogram *) + +val exponential_histogram_has_aggregation_temporality : exponential_histogram -> bool + (** presence of field "aggregation_temporality" in [exponential_histogram] *) + +val exponential_histogram_set_aggregation_temporality : exponential_histogram -> aggregation_temporality -> unit + (** set field aggregation_temporality in exponential_histogram *) + val make_summary_data_point_value_at_quantile : - quantile:float -> - value:float -> + ?quantile:float -> + ?value:float -> unit -> summary_data_point_value_at_quantile (** [make_summary_data_point_value_at_quantile … ()] is a builder for type [summary_data_point_value_at_quantile] *) +val copy_summary_data_point_value_at_quantile : summary_data_point_value_at_quantile -> summary_data_point_value_at_quantile + +val summary_data_point_value_at_quantile_has_quantile : summary_data_point_value_at_quantile -> bool + (** presence of field "quantile" in [summary_data_point_value_at_quantile] *) + +val summary_data_point_value_at_quantile_set_quantile : summary_data_point_value_at_quantile -> float -> unit + (** set field quantile in summary_data_point_value_at_quantile *) + +val summary_data_point_value_at_quantile_has_value : summary_data_point_value_at_quantile -> bool + (** presence of field "value" in [summary_data_point_value_at_quantile] *) + +val summary_data_point_value_at_quantile_set_value : summary_data_point_value_at_quantile -> float -> unit + (** set field value in summary_data_point_value_at_quantile *) + val make_summary_data_point : - attributes:Common.key_value list -> - start_time_unix_nano:int64 -> - time_unix_nano:int64 -> - count:int64 -> - sum:float -> - quantile_values:summary_data_point_value_at_quantile list -> - flags:int32 -> + ?attributes:Common.key_value list -> + ?start_time_unix_nano:int64 -> + ?time_unix_nano:int64 -> + ?count:int64 -> + ?sum:float -> + ?quantile_values:summary_data_point_value_at_quantile list -> + ?flags:int32 -> unit -> summary_data_point (** [make_summary_data_point … ()] is a builder for type [summary_data_point] *) +val copy_summary_data_point : summary_data_point -> summary_data_point + +val summary_data_point_set_attributes : summary_data_point -> Common.key_value list -> unit + (** set field attributes in summary_data_point *) + +val summary_data_point_has_start_time_unix_nano : summary_data_point -> bool + (** presence of field "start_time_unix_nano" in [summary_data_point] *) + +val summary_data_point_set_start_time_unix_nano : summary_data_point -> int64 -> unit + (** set field start_time_unix_nano in summary_data_point *) + +val summary_data_point_has_time_unix_nano : summary_data_point -> bool + (** presence of field "time_unix_nano" in [summary_data_point] *) + +val summary_data_point_set_time_unix_nano : summary_data_point -> int64 -> unit + (** set field time_unix_nano in summary_data_point *) + +val summary_data_point_has_count : summary_data_point -> bool + (** presence of field "count" in [summary_data_point] *) + +val summary_data_point_set_count : summary_data_point -> int64 -> unit + (** set field count in summary_data_point *) + +val summary_data_point_has_sum : summary_data_point -> bool + (** presence of field "sum" in [summary_data_point] *) + +val summary_data_point_set_sum : summary_data_point -> float -> unit + (** set field sum in summary_data_point *) + +val summary_data_point_set_quantile_values : summary_data_point -> summary_data_point_value_at_quantile list -> unit + (** set field quantile_values in summary_data_point *) + +val summary_data_point_has_flags : summary_data_point -> bool + (** presence of field "flags" in [summary_data_point] *) + +val summary_data_point_set_flags : summary_data_point -> int32 -> unit + (** set field flags in summary_data_point *) + val make_summary : - data_points:summary_data_point list -> + ?data_points:summary_data_point list -> unit -> summary (** [make_summary … ()] is a builder for type [summary] *) +val copy_summary : summary -> summary + +val summary_set_data_points : summary -> summary_data_point list -> unit + (** set field data_points in summary *) val make_metric : - name:string -> - description:string -> - unit_:string -> - data:metric_data -> + ?name:string -> + ?description:string -> + ?unit_:string -> + ?data:metric_data -> + ?metadata:Common.key_value list -> unit -> metric (** [make_metric … ()] is a builder for type [metric] *) +val copy_metric : metric -> metric + +val metric_has_name : metric -> bool + (** presence of field "name" in [metric] *) + +val metric_set_name : metric -> string -> unit + (** set field name in metric *) + +val metric_has_description : metric -> bool + (** presence of field "description" in [metric] *) + +val metric_set_description : metric -> string -> unit + (** set field description in metric *) + +val metric_has_unit_ : metric -> bool + (** presence of field "unit_" in [metric] *) + +val metric_set_unit_ : metric -> string -> unit + (** set field unit_ in metric *) + +val metric_set_data : metric -> metric_data -> unit + (** set field data in metric *) + +val metric_set_metadata : metric -> Common.key_value list -> unit + (** set field metadata in metric *) + val make_scope_metrics : - ?scope:Common.instrumentation_scope option -> - metrics:metric list -> - schema_url:string -> + ?scope:Common.instrumentation_scope -> + ?metrics:metric list -> + ?schema_url:string -> unit -> scope_metrics (** [make_scope_metrics … ()] is a builder for type [scope_metrics] *) +val copy_scope_metrics : scope_metrics -> scope_metrics + +val scope_metrics_set_scope : scope_metrics -> Common.instrumentation_scope -> unit + (** set field scope in scope_metrics *) + +val scope_metrics_set_metrics : scope_metrics -> metric list -> unit + (** set field metrics in scope_metrics *) + +val scope_metrics_has_schema_url : scope_metrics -> bool + (** presence of field "schema_url" in [scope_metrics] *) + +val scope_metrics_set_schema_url : scope_metrics -> string -> unit + (** set field schema_url in scope_metrics *) + val make_resource_metrics : - ?resource:Resource.resource option -> - scope_metrics:scope_metrics list -> - schema_url:string -> + ?resource:Resource.resource -> + ?scope_metrics:scope_metrics list -> + ?schema_url:string -> unit -> resource_metrics (** [make_resource_metrics … ()] is a builder for type [resource_metrics] *) +val copy_resource_metrics : resource_metrics -> resource_metrics + +val resource_metrics_set_resource : resource_metrics -> Resource.resource -> unit + (** set field resource in resource_metrics *) + +val resource_metrics_set_scope_metrics : resource_metrics -> scope_metrics list -> unit + (** set field scope_metrics in resource_metrics *) + +val resource_metrics_has_schema_url : resource_metrics -> bool + (** presence of field "schema_url" in [resource_metrics] *) + +val resource_metrics_set_schema_url : resource_metrics -> string -> unit + (** set field schema_url in resource_metrics *) + val make_metrics_data : - resource_metrics:resource_metrics list -> + ?resource_metrics:resource_metrics list -> unit -> metrics_data (** [make_metrics_data … ()] is a builder for type [metrics_data] *) +val copy_metrics_data : metrics_data -> metrics_data + +val metrics_data_set_resource_metrics : metrics_data -> resource_metrics list -> unit + (** set field resource_metrics in metrics_data *) (** {2 Formatters} *) @@ -663,3 +930,135 @@ val decode_pb_metrics_data : Pbrt.Decoder.t -> metrics_data val decode_pb_data_point_flags : Pbrt.Decoder.t -> data_point_flags (** [decode_pb_data_point_flags decoder] decodes a [data_point_flags] binary value from [decoder] *) + + +(** {2 Protobuf YoJson Encoding} *) + +val encode_json_exemplar_value : exemplar_value -> Yojson.Basic.t +(** [encode_json_exemplar_value v encoder] encodes [v] to to json *) + +val encode_json_exemplar : exemplar -> Yojson.Basic.t +(** [encode_json_exemplar v encoder] encodes [v] to to json *) + +val encode_json_number_data_point_value : number_data_point_value -> Yojson.Basic.t +(** [encode_json_number_data_point_value v encoder] encodes [v] to to json *) + +val encode_json_number_data_point : number_data_point -> Yojson.Basic.t +(** [encode_json_number_data_point v encoder] encodes [v] to to json *) + +val encode_json_gauge : gauge -> Yojson.Basic.t +(** [encode_json_gauge v encoder] encodes [v] to to json *) + +val encode_json_aggregation_temporality : aggregation_temporality -> Yojson.Basic.t +(** [encode_json_aggregation_temporality v encoder] encodes [v] to to json *) + +val encode_json_sum : sum -> Yojson.Basic.t +(** [encode_json_sum v encoder] encodes [v] to to json *) + +val encode_json_histogram_data_point : histogram_data_point -> Yojson.Basic.t +(** [encode_json_histogram_data_point v encoder] encodes [v] to to json *) + +val encode_json_histogram : histogram -> Yojson.Basic.t +(** [encode_json_histogram v encoder] encodes [v] to to json *) + +val encode_json_exponential_histogram_data_point_buckets : exponential_histogram_data_point_buckets -> Yojson.Basic.t +(** [encode_json_exponential_histogram_data_point_buckets v encoder] encodes [v] to to json *) + +val encode_json_exponential_histogram_data_point : exponential_histogram_data_point -> Yojson.Basic.t +(** [encode_json_exponential_histogram_data_point v encoder] encodes [v] to to json *) + +val encode_json_exponential_histogram : exponential_histogram -> Yojson.Basic.t +(** [encode_json_exponential_histogram v encoder] encodes [v] to to json *) + +val encode_json_summary_data_point_value_at_quantile : summary_data_point_value_at_quantile -> Yojson.Basic.t +(** [encode_json_summary_data_point_value_at_quantile v encoder] encodes [v] to to json *) + +val encode_json_summary_data_point : summary_data_point -> Yojson.Basic.t +(** [encode_json_summary_data_point v encoder] encodes [v] to to json *) + +val encode_json_summary : summary -> Yojson.Basic.t +(** [encode_json_summary v encoder] encodes [v] to to json *) + +val encode_json_metric_data : metric_data -> Yojson.Basic.t +(** [encode_json_metric_data v encoder] encodes [v] to to json *) + +val encode_json_metric : metric -> Yojson.Basic.t +(** [encode_json_metric v encoder] encodes [v] to to json *) + +val encode_json_scope_metrics : scope_metrics -> Yojson.Basic.t +(** [encode_json_scope_metrics v encoder] encodes [v] to to json *) + +val encode_json_resource_metrics : resource_metrics -> Yojson.Basic.t +(** [encode_json_resource_metrics v encoder] encodes [v] to to json *) + +val encode_json_metrics_data : metrics_data -> Yojson.Basic.t +(** [encode_json_metrics_data v encoder] encodes [v] to to json *) + +val encode_json_data_point_flags : data_point_flags -> Yojson.Basic.t +(** [encode_json_data_point_flags v encoder] encodes [v] to to json *) + + +(** {2 JSON Decoding} *) + +val decode_json_exemplar_value : Yojson.Basic.t -> exemplar_value +(** [decode_json_exemplar_value decoder] decodes a [exemplar_value] value from [decoder] *) + +val decode_json_exemplar : Yojson.Basic.t -> exemplar +(** [decode_json_exemplar decoder] decodes a [exemplar] value from [decoder] *) + +val decode_json_number_data_point_value : Yojson.Basic.t -> number_data_point_value +(** [decode_json_number_data_point_value decoder] decodes a [number_data_point_value] value from [decoder] *) + +val decode_json_number_data_point : Yojson.Basic.t -> number_data_point +(** [decode_json_number_data_point decoder] decodes a [number_data_point] value from [decoder] *) + +val decode_json_gauge : Yojson.Basic.t -> gauge +(** [decode_json_gauge decoder] decodes a [gauge] value from [decoder] *) + +val decode_json_aggregation_temporality : Yojson.Basic.t -> aggregation_temporality +(** [decode_json_aggregation_temporality decoder] decodes a [aggregation_temporality] value from [decoder] *) + +val decode_json_sum : Yojson.Basic.t -> sum +(** [decode_json_sum decoder] decodes a [sum] value from [decoder] *) + +val decode_json_histogram_data_point : Yojson.Basic.t -> histogram_data_point +(** [decode_json_histogram_data_point decoder] decodes a [histogram_data_point] value from [decoder] *) + +val decode_json_histogram : Yojson.Basic.t -> histogram +(** [decode_json_histogram decoder] decodes a [histogram] value from [decoder] *) + +val decode_json_exponential_histogram_data_point_buckets : Yojson.Basic.t -> exponential_histogram_data_point_buckets +(** [decode_json_exponential_histogram_data_point_buckets decoder] decodes a [exponential_histogram_data_point_buckets] value from [decoder] *) + +val decode_json_exponential_histogram_data_point : Yojson.Basic.t -> exponential_histogram_data_point +(** [decode_json_exponential_histogram_data_point decoder] decodes a [exponential_histogram_data_point] value from [decoder] *) + +val decode_json_exponential_histogram : Yojson.Basic.t -> exponential_histogram +(** [decode_json_exponential_histogram decoder] decodes a [exponential_histogram] value from [decoder] *) + +val decode_json_summary_data_point_value_at_quantile : Yojson.Basic.t -> summary_data_point_value_at_quantile +(** [decode_json_summary_data_point_value_at_quantile decoder] decodes a [summary_data_point_value_at_quantile] value from [decoder] *) + +val decode_json_summary_data_point : Yojson.Basic.t -> summary_data_point +(** [decode_json_summary_data_point decoder] decodes a [summary_data_point] value from [decoder] *) + +val decode_json_summary : Yojson.Basic.t -> summary +(** [decode_json_summary decoder] decodes a [summary] value from [decoder] *) + +val decode_json_metric_data : Yojson.Basic.t -> metric_data +(** [decode_json_metric_data decoder] decodes a [metric_data] value from [decoder] *) + +val decode_json_metric : Yojson.Basic.t -> metric +(** [decode_json_metric decoder] decodes a [metric] value from [decoder] *) + +val decode_json_scope_metrics : Yojson.Basic.t -> scope_metrics +(** [decode_json_scope_metrics decoder] decodes a [scope_metrics] value from [decoder] *) + +val decode_json_resource_metrics : Yojson.Basic.t -> resource_metrics +(** [decode_json_resource_metrics decoder] decodes a [resource_metrics] value from [decoder] *) + +val decode_json_metrics_data : Yojson.Basic.t -> metrics_data +(** [decode_json_metrics_data decoder] decodes a [metrics_data] value from [decoder] *) + +val decode_json_data_point_flags : Yojson.Basic.t -> data_point_flags +(** [decode_json_data_point_flags decoder] decodes a [data_point_flags] value from [decoder] *) diff --git a/src/proto/metrics_service.ml b/src/proto/metrics_service.ml index 6d1fa0949..0e519e6dd 100644 --- a/src/proto/metrics_service.ml +++ b/src/proto/metrics_service.ml @@ -1,88 +1,94 @@ -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39-44"] type export_metrics_service_request = { - resource_metrics : Metrics.resource_metrics list; + mutable resource_metrics : Metrics.resource_metrics list; } type export_metrics_partial_success = { - rejected_data_points : int64; - error_message : string; + mutable _presence: Pbrt.Bitfield.t; (** presence for 2 fields *) + mutable rejected_data_points : int64; + mutable error_message : string; } type export_metrics_service_response = { - partial_success : export_metrics_partial_success option; + mutable partial_success : export_metrics_partial_success option; } -let rec default_export_metrics_service_request - ?resource_metrics:((resource_metrics:Metrics.resource_metrics list) = []) - () : export_metrics_service_request = { - resource_metrics; +let default_export_metrics_service_request (): export_metrics_service_request = +{ + resource_metrics=[]; } -let rec default_export_metrics_partial_success - ?rejected_data_points:((rejected_data_points:int64) = 0L) - ?error_message:((error_message:string) = "") - () : export_metrics_partial_success = { - rejected_data_points; - error_message; +let default_export_metrics_partial_success (): export_metrics_partial_success = +{ + _presence=Pbrt.Bitfield.empty; + rejected_data_points=0L; + error_message=""; } -let rec default_export_metrics_service_response - ?partial_success:((partial_success:export_metrics_partial_success option) = None) - () : export_metrics_service_response = { - partial_success; +let default_export_metrics_service_response (): export_metrics_service_response = +{ + partial_success=None; } -type export_metrics_service_request_mutable = { - mutable resource_metrics : Metrics.resource_metrics list; -} -let default_export_metrics_service_request_mutable () : export_metrics_service_request_mutable = { - resource_metrics = []; -} +(** {2 Make functions} *) -type export_metrics_partial_success_mutable = { - mutable rejected_data_points : int64; - mutable error_message : string; -} -let default_export_metrics_partial_success_mutable () : export_metrics_partial_success_mutable = { - rejected_data_points = 0L; - error_message = ""; -} +let[@inline] export_metrics_service_request_set_resource_metrics (self:export_metrics_service_request) (x:Metrics.resource_metrics list) : unit = + self.resource_metrics <- x -type export_metrics_service_response_mutable = { - mutable partial_success : export_metrics_partial_success option; -} +let copy_export_metrics_service_request (self:export_metrics_service_request) : export_metrics_service_request = + { self with resource_metrics = self.resource_metrics } -let default_export_metrics_service_response_mutable () : export_metrics_service_response_mutable = { - partial_success = None; -} +let make_export_metrics_service_request + ?(resource_metrics=[]) + () : export_metrics_service_request = + let _res = default_export_metrics_service_request () in + export_metrics_service_request_set_resource_metrics _res resource_metrics; + _res +let[@inline] export_metrics_partial_success_has_rejected_data_points (self:export_metrics_partial_success) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] export_metrics_partial_success_has_error_message (self:export_metrics_partial_success) : bool = (Pbrt.Bitfield.get self._presence 1) -(** {2 Make functions} *) +let[@inline] export_metrics_partial_success_set_rejected_data_points (self:export_metrics_partial_success) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.rejected_data_points <- x +let[@inline] export_metrics_partial_success_set_error_message (self:export_metrics_partial_success) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.error_message <- x -let rec make_export_metrics_service_request - ~(resource_metrics:Metrics.resource_metrics list) - () : export_metrics_service_request = { - resource_metrics; -} +let copy_export_metrics_partial_success (self:export_metrics_partial_success) : export_metrics_partial_success = + { self with rejected_data_points = self.rejected_data_points } -let rec make_export_metrics_partial_success - ~(rejected_data_points:int64) - ~(error_message:string) - () : export_metrics_partial_success = { - rejected_data_points; - error_message; -} +let make_export_metrics_partial_success + ?(rejected_data_points:int64 option) + ?(error_message:string option) + () : export_metrics_partial_success = + let _res = default_export_metrics_partial_success () in + (match rejected_data_points with + | None -> () + | Some v -> export_metrics_partial_success_set_rejected_data_points _res v); + (match error_message with + | None -> () + | Some v -> export_metrics_partial_success_set_error_message _res v); + _res -let rec make_export_metrics_service_response - ?partial_success:((partial_success:export_metrics_partial_success option) = None) - () : export_metrics_service_response = { - partial_success; -} -[@@@ocaml.warning "-27-30-39"] +let[@inline] export_metrics_service_response_set_partial_success (self:export_metrics_service_response) (x:export_metrics_partial_success) : unit = + self.partial_success <- Some x + +let copy_export_metrics_service_response (self:export_metrics_service_response) : export_metrics_service_response = + { self with partial_success = self.partial_success } + +let make_export_metrics_service_response + ?(partial_success:export_metrics_partial_success option) + () : export_metrics_service_response = + let _res = default_export_metrics_service_response () in + (match partial_success with + | None -> () + | Some v -> export_metrics_service_response_set_partial_success _res v); + _res + +[@@@ocaml.warning "-23-27-30-39"] (** {2 Formatters} *) @@ -94,8 +100,8 @@ let rec pp_export_metrics_service_request fmt (v:export_metrics_service_request) let rec pp_export_metrics_partial_success fmt (v:export_metrics_partial_success) = let pp_i fmt () = - Pbrt.Pp.pp_record_field ~first:true "rejected_data_points" Pbrt.Pp.pp_int64 fmt v.rejected_data_points; - Pbrt.Pp.pp_record_field ~first:false "error_message" Pbrt.Pp.pp_string fmt v.error_message; + Pbrt.Pp.pp_record_field ~absent:(not (export_metrics_partial_success_has_rejected_data_points v)) ~first:true "rejected_data_points" Pbrt.Pp.pp_int64 fmt v.rejected_data_points; + Pbrt.Pp.pp_record_field ~absent:(not (export_metrics_partial_success_has_error_message v)) ~first:false "error_message" Pbrt.Pp.pp_string fmt v.error_message; in Pbrt.Pp.pp_brk pp_i fmt () @@ -105,22 +111,26 @@ let rec pp_export_metrics_service_response fmt (v:export_metrics_service_respons in Pbrt.Pp.pp_brk pp_i fmt () -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Encoding} *) let rec encode_pb_export_metrics_service_request (v:export_metrics_service_request) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested Metrics.encode_pb_resource_metrics x encoder; Pbrt.Encoder.key 1 Pbrt.Bytes encoder; ) v.resource_metrics encoder; () let rec encode_pb_export_metrics_partial_success (v:export_metrics_partial_success) encoder = - Pbrt.Encoder.int64_as_varint v.rejected_data_points encoder; - Pbrt.Encoder.key 1 Pbrt.Varint encoder; - Pbrt.Encoder.string v.error_message encoder; - Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + if export_metrics_partial_success_has_rejected_data_points v then ( + Pbrt.Encoder.int64_as_varint v.rejected_data_points encoder; + Pbrt.Encoder.key 1 Pbrt.Varint encoder; + ); + if export_metrics_partial_success_has_error_message v then ( + Pbrt.Encoder.string v.error_message encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + ); () let rec encode_pb_export_metrics_service_response (v:export_metrics_service_response) encoder = @@ -132,67 +142,149 @@ let rec encode_pb_export_metrics_service_response (v:export_metrics_service_resp end; () -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Decoding} *) let rec decode_pb_export_metrics_service_request d = - let v = default_export_metrics_service_request_mutable () in + let v = default_export_metrics_service_request () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.resource_metrics <- List.rev v.resource_metrics; + (* put lists in the correct order *) + export_metrics_service_request_set_resource_metrics v (List.rev v.resource_metrics); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.resource_metrics <- (Metrics.decode_pb_resource_metrics (Pbrt.Decoder.nested d)) :: v.resource_metrics; + export_metrics_service_request_set_resource_metrics v ((Metrics.decode_pb_resource_metrics (Pbrt.Decoder.nested d)) :: v.resource_metrics); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(export_metrics_service_request), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "export_metrics_service_request" 1 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - resource_metrics = v.resource_metrics; - } : export_metrics_service_request) + (v : export_metrics_service_request) let rec decode_pb_export_metrics_partial_success d = - let v = default_export_metrics_partial_success_mutable () in + let v = default_export_metrics_partial_success () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( ); continue__ := false | Some (1, Pbrt.Varint) -> begin - v.rejected_data_points <- Pbrt.Decoder.int64_as_varint d; + export_metrics_partial_success_set_rejected_data_points v (Pbrt.Decoder.int64_as_varint d); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(export_metrics_partial_success), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "export_metrics_partial_success" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.error_message <- Pbrt.Decoder.string d; + export_metrics_partial_success_set_error_message v (Pbrt.Decoder.string d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(export_metrics_partial_success), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "export_metrics_partial_success" 2 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - rejected_data_points = v.rejected_data_points; - error_message = v.error_message; - } : export_metrics_partial_success) + (v : export_metrics_partial_success) let rec decode_pb_export_metrics_service_response d = - let v = default_export_metrics_service_response_mutable () in + let v = default_export_metrics_service_response () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.partial_success <- Some (decode_pb_export_metrics_partial_success (Pbrt.Decoder.nested d)); + export_metrics_service_response_set_partial_success v (decode_pb_export_metrics_partial_success (Pbrt.Decoder.nested d)); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(export_metrics_service_response), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "export_metrics_service_response" 1 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; + (v : export_metrics_service_response) + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 Protobuf YoJson Encoding} *) + +let rec encode_json_export_metrics_service_request (v:export_metrics_service_request) = + let assoc = ref [] in + assoc := ( + let l = v.resource_metrics |> List.map Metrics.encode_json_resource_metrics in + ("resourceMetrics", `List l) :: !assoc + ); + `Assoc !assoc + +let rec encode_json_export_metrics_partial_success (v:export_metrics_partial_success) = + let assoc = ref [] in + if export_metrics_partial_success_has_rejected_data_points v then ( + assoc := ("rejectedDataPoints", Pbrt_yojson.make_string (Int64.to_string v.rejected_data_points)) :: !assoc; + ); + if export_metrics_partial_success_has_error_message v then ( + assoc := ("errorMessage", Pbrt_yojson.make_string v.error_message) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_export_metrics_service_response (v:export_metrics_service_response) = + let assoc = ref [] in + assoc := (match v.partial_success with + | None -> !assoc + | Some v -> ("partialSuccess", encode_json_export_metrics_partial_success v) :: !assoc); + `Assoc !assoc + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 JSON Decoding} *) + +let rec decode_json_export_metrics_service_request d = + let v = default_export_metrics_service_request () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("resourceMetrics", `List l) -> begin + export_metrics_service_request_set_resource_metrics v @@ List.map (function + | json_value -> (Metrics.decode_json_resource_metrics json_value) + ) l; + end + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + resource_metrics = v.resource_metrics; + } : export_metrics_service_request) + +let rec decode_json_export_metrics_partial_success d = + let v = default_export_metrics_partial_success () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("rejectedDataPoints", json_value) -> + export_metrics_partial_success_set_rejected_data_points v (Pbrt_yojson.int64 json_value "export_metrics_partial_success" "rejected_data_points") + | ("errorMessage", json_value) -> + export_metrics_partial_success_set_error_message v (Pbrt_yojson.string json_value "export_metrics_partial_success" "error_message") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + rejected_data_points = v.rejected_data_points; + error_message = v.error_message; + } : export_metrics_partial_success) + +let rec decode_json_export_metrics_service_response d = + let v = default_export_metrics_service_response () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("partialSuccess", json_value) -> + export_metrics_service_response_set_partial_success v (decode_json_export_metrics_partial_success json_value) + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; ({ partial_success = v.partial_success; } : export_metrics_service_response) diff --git a/src/proto/metrics_service.mli b/src/proto/metrics_service.mli index f3357d874..33caa6ca4 100644 --- a/src/proto/metrics_service.mli +++ b/src/proto/metrics_service.mli @@ -7,63 +7,78 @@ (** {2 Types} *) -type export_metrics_service_request = { - resource_metrics : Metrics.resource_metrics list; +type export_metrics_service_request = private { + mutable resource_metrics : Metrics.resource_metrics list; } -type export_metrics_partial_success = { - rejected_data_points : int64; - error_message : string; +type export_metrics_partial_success = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 2 fields *) + mutable rejected_data_points : int64; + mutable error_message : string; } -type export_metrics_service_response = { - partial_success : export_metrics_partial_success option; +type export_metrics_service_response = private { + mutable partial_success : export_metrics_partial_success option; } (** {2 Basic values} *) -val default_export_metrics_service_request : - ?resource_metrics:Metrics.resource_metrics list -> - unit -> - export_metrics_service_request -(** [default_export_metrics_service_request ()] is the default value for type [export_metrics_service_request] *) +val default_export_metrics_service_request : unit -> export_metrics_service_request +(** [default_export_metrics_service_request ()] is a new empty value for type [export_metrics_service_request] *) -val default_export_metrics_partial_success : - ?rejected_data_points:int64 -> - ?error_message:string -> - unit -> - export_metrics_partial_success -(** [default_export_metrics_partial_success ()] is the default value for type [export_metrics_partial_success] *) +val default_export_metrics_partial_success : unit -> export_metrics_partial_success +(** [default_export_metrics_partial_success ()] is a new empty value for type [export_metrics_partial_success] *) -val default_export_metrics_service_response : - ?partial_success:export_metrics_partial_success option -> - unit -> - export_metrics_service_response -(** [default_export_metrics_service_response ()] is the default value for type [export_metrics_service_response] *) +val default_export_metrics_service_response : unit -> export_metrics_service_response +(** [default_export_metrics_service_response ()] is a new empty value for type [export_metrics_service_response] *) (** {2 Make functions} *) val make_export_metrics_service_request : - resource_metrics:Metrics.resource_metrics list -> + ?resource_metrics:Metrics.resource_metrics list -> unit -> export_metrics_service_request (** [make_export_metrics_service_request … ()] is a builder for type [export_metrics_service_request] *) +val copy_export_metrics_service_request : export_metrics_service_request -> export_metrics_service_request + +val export_metrics_service_request_set_resource_metrics : export_metrics_service_request -> Metrics.resource_metrics list -> unit + (** set field resource_metrics in export_metrics_service_request *) + val make_export_metrics_partial_success : - rejected_data_points:int64 -> - error_message:string -> + ?rejected_data_points:int64 -> + ?error_message:string -> unit -> export_metrics_partial_success (** [make_export_metrics_partial_success … ()] is a builder for type [export_metrics_partial_success] *) +val copy_export_metrics_partial_success : export_metrics_partial_success -> export_metrics_partial_success + +val export_metrics_partial_success_has_rejected_data_points : export_metrics_partial_success -> bool + (** presence of field "rejected_data_points" in [export_metrics_partial_success] *) + +val export_metrics_partial_success_set_rejected_data_points : export_metrics_partial_success -> int64 -> unit + (** set field rejected_data_points in export_metrics_partial_success *) + +val export_metrics_partial_success_has_error_message : export_metrics_partial_success -> bool + (** presence of field "error_message" in [export_metrics_partial_success] *) + +val export_metrics_partial_success_set_error_message : export_metrics_partial_success -> string -> unit + (** set field error_message in export_metrics_partial_success *) + val make_export_metrics_service_response : - ?partial_success:export_metrics_partial_success option -> + ?partial_success:export_metrics_partial_success -> unit -> export_metrics_service_response (** [make_export_metrics_service_response … ()] is a builder for type [export_metrics_service_response] *) +val copy_export_metrics_service_response : export_metrics_service_response -> export_metrics_service_response + +val export_metrics_service_response_set_partial_success : export_metrics_service_response -> export_metrics_partial_success -> unit + (** set field partial_success in export_metrics_service_response *) + (** {2 Formatters} *) @@ -99,3 +114,27 @@ val decode_pb_export_metrics_partial_success : Pbrt.Decoder.t -> export_metrics_ val decode_pb_export_metrics_service_response : Pbrt.Decoder.t -> export_metrics_service_response (** [decode_pb_export_metrics_service_response decoder] decodes a [export_metrics_service_response] binary value from [decoder] *) + + +(** {2 Protobuf YoJson Encoding} *) + +val encode_json_export_metrics_service_request : export_metrics_service_request -> Yojson.Basic.t +(** [encode_json_export_metrics_service_request v encoder] encodes [v] to to json *) + +val encode_json_export_metrics_partial_success : export_metrics_partial_success -> Yojson.Basic.t +(** [encode_json_export_metrics_partial_success v encoder] encodes [v] to to json *) + +val encode_json_export_metrics_service_response : export_metrics_service_response -> Yojson.Basic.t +(** [encode_json_export_metrics_service_response v encoder] encodes [v] to to json *) + + +(** {2 JSON Decoding} *) + +val decode_json_export_metrics_service_request : Yojson.Basic.t -> export_metrics_service_request +(** [decode_json_export_metrics_service_request decoder] decodes a [export_metrics_service_request] value from [decoder] *) + +val decode_json_export_metrics_partial_success : Yojson.Basic.t -> export_metrics_partial_success +(** [decode_json_export_metrics_partial_success decoder] decodes a [export_metrics_partial_success] value from [decoder] *) + +val decode_json_export_metrics_service_response : Yojson.Basic.t -> export_metrics_service_response +(** [decode_json_export_metrics_service_response decoder] decodes a [export_metrics_service_response] value from [decoder] *) diff --git a/src/proto/resource.ml b/src/proto/resource.ml index cd4b88080..20f09ee91 100644 --- a/src/proto/resource.ml +++ b/src/proto/resource.ml @@ -1,88 +1,160 @@ -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39-44"] type resource = { - attributes : Common.key_value list; - dropped_attributes_count : int32; -} - -let rec default_resource - ?attributes:((attributes:Common.key_value list) = []) - ?dropped_attributes_count:((dropped_attributes_count:int32) = 0l) - () : resource = { - attributes; - dropped_attributes_count; -} - -type resource_mutable = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) mutable attributes : Common.key_value list; mutable dropped_attributes_count : int32; + mutable entity_refs : Common.entity_ref list; } -let default_resource_mutable () : resource_mutable = { - attributes = []; - dropped_attributes_count = 0l; +let default_resource (): resource = +{ + _presence=Pbrt.Bitfield.empty; + attributes=[]; + dropped_attributes_count=0l; + entity_refs=[]; } (** {2 Make functions} *) -let rec make_resource - ~(attributes:Common.key_value list) - ~(dropped_attributes_count:int32) - () : resource = { - attributes; - dropped_attributes_count; -} - -[@@@ocaml.warning "-27-30-39"] +let[@inline] resource_has_dropped_attributes_count (self:resource) : bool = (Pbrt.Bitfield.get self._presence 0) + +let[@inline] resource_set_attributes (self:resource) (x:Common.key_value list) : unit = + self.attributes <- x +let[@inline] resource_set_dropped_attributes_count (self:resource) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.dropped_attributes_count <- x +let[@inline] resource_set_entity_refs (self:resource) (x:Common.entity_ref list) : unit = + self.entity_refs <- x + +let copy_resource (self:resource) : resource = + { self with attributes = self.attributes } + +let make_resource + ?(attributes=[]) + ?(dropped_attributes_count:int32 option) + ?(entity_refs=[]) + () : resource = + let _res = default_resource () in + resource_set_attributes _res attributes; + (match dropped_attributes_count with + | None -> () + | Some v -> resource_set_dropped_attributes_count _res v); + resource_set_entity_refs _res entity_refs; + _res + +[@@@ocaml.warning "-23-27-30-39"] (** {2 Formatters} *) let rec pp_resource fmt (v:resource) = let pp_i fmt () = Pbrt.Pp.pp_record_field ~first:true "attributes" (Pbrt.Pp.pp_list Common.pp_key_value) fmt v.attributes; - Pbrt.Pp.pp_record_field ~first:false "dropped_attributes_count" Pbrt.Pp.pp_int32 fmt v.dropped_attributes_count; + Pbrt.Pp.pp_record_field ~absent:(not (resource_has_dropped_attributes_count v)) ~first:false "dropped_attributes_count" Pbrt.Pp.pp_int32 fmt v.dropped_attributes_count; + Pbrt.Pp.pp_record_field ~first:false "entity_refs" (Pbrt.Pp.pp_list Common.pp_entity_ref) fmt v.entity_refs; in Pbrt.Pp.pp_brk pp_i fmt () -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Encoding} *) let rec encode_pb_resource (v:resource) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested Common.encode_pb_key_value x encoder; Pbrt.Encoder.key 1 Pbrt.Bytes encoder; ) v.attributes encoder; - Pbrt.Encoder.int32_as_varint v.dropped_attributes_count encoder; - Pbrt.Encoder.key 2 Pbrt.Varint encoder; + if resource_has_dropped_attributes_count v then ( + Pbrt.Encoder.int32_as_varint v.dropped_attributes_count encoder; + Pbrt.Encoder.key 2 Pbrt.Varint encoder; + ); + Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.Encoder.nested Common.encode_pb_entity_ref x encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + ) v.entity_refs encoder; () -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Decoding} *) let rec decode_pb_resource d = - let v = default_resource_mutable () in + let v = default_resource () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.attributes <- List.rev v.attributes; + (* put lists in the correct order *) + resource_set_entity_refs v (List.rev v.entity_refs); + resource_set_attributes v (List.rev v.attributes); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.attributes <- (Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes; + resource_set_attributes v ((Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(resource), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "resource" 1 pk | Some (2, Pbrt.Varint) -> begin - v.dropped_attributes_count <- Pbrt.Decoder.int32_as_varint d; + resource_set_dropped_attributes_count v (Pbrt.Decoder.int32_as_varint d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(resource), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "resource" 2 pk + | Some (3, Pbrt.Bytes) -> begin + resource_set_entity_refs v ((Common.decode_pb_entity_ref (Pbrt.Decoder.nested d)) :: v.entity_refs); + end + | Some (3, pk) -> + Pbrt.Decoder.unexpected_payload_message "resource" 3 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; + (v : resource) + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 Protobuf YoJson Encoding} *) + +let rec encode_json_resource (v:resource) = + let assoc = ref [] in + assoc := ( + let l = v.attributes |> List.map Common.encode_json_key_value in + ("attributes", `List l) :: !assoc + ); + if resource_has_dropped_attributes_count v then ( + assoc := ("droppedAttributesCount", Pbrt_yojson.make_int (Int32.to_int v.dropped_attributes_count)) :: !assoc; + ); + assoc := ( + let l = v.entity_refs |> List.map Common.encode_json_entity_ref in + ("entityRefs", `List l) :: !assoc + ); + `Assoc !assoc + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 JSON Decoding} *) + +let rec decode_json_resource d = + let v = default_resource () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("attributes", `List l) -> begin + resource_set_attributes v @@ List.map (function + | json_value -> (Common.decode_json_key_value json_value) + ) l; + end + | ("droppedAttributesCount", json_value) -> + resource_set_dropped_attributes_count v (Pbrt_yojson.int32 json_value "resource" "dropped_attributes_count") + | ("entityRefs", `List l) -> begin + resource_set_entity_refs v @@ List.map (function + | json_value -> (Common.decode_json_entity_ref json_value) + ) l; + end + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; ({ + _presence = v._presence; attributes = v.attributes; dropped_attributes_count = v.dropped_attributes_count; + entity_refs = v.entity_refs; } : resource) diff --git a/src/proto/resource.mli b/src/proto/resource.mli index 88f7cb9c2..51f2151f6 100644 --- a/src/proto/resource.mli +++ b/src/proto/resource.mli @@ -7,31 +7,44 @@ (** {2 Types} *) -type resource = { - attributes : Common.key_value list; - dropped_attributes_count : int32; +type resource = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) + mutable attributes : Common.key_value list; + mutable dropped_attributes_count : int32; + mutable entity_refs : Common.entity_ref list; } (** {2 Basic values} *) -val default_resource : - ?attributes:Common.key_value list -> - ?dropped_attributes_count:int32 -> - unit -> - resource -(** [default_resource ()] is the default value for type [resource] *) +val default_resource : unit -> resource +(** [default_resource ()] is a new empty value for type [resource] *) (** {2 Make functions} *) val make_resource : - attributes:Common.key_value list -> - dropped_attributes_count:int32 -> + ?attributes:Common.key_value list -> + ?dropped_attributes_count:int32 -> + ?entity_refs:Common.entity_ref list -> unit -> resource (** [make_resource … ()] is a builder for type [resource] *) +val copy_resource : resource -> resource + +val resource_set_attributes : resource -> Common.key_value list -> unit + (** set field attributes in resource *) + +val resource_has_dropped_attributes_count : resource -> bool + (** presence of field "dropped_attributes_count" in [resource] *) + +val resource_set_dropped_attributes_count : resource -> int32 -> unit + (** set field dropped_attributes_count in resource *) + +val resource_set_entity_refs : resource -> Common.entity_ref list -> unit + (** set field entity_refs in resource *) + (** {2 Formatters} *) @@ -49,3 +62,15 @@ val encode_pb_resource : resource -> Pbrt.Encoder.t -> unit val decode_pb_resource : Pbrt.Decoder.t -> resource (** [decode_pb_resource decoder] decodes a [resource] binary value from [decoder] *) + + +(** {2 Protobuf YoJson Encoding} *) + +val encode_json_resource : resource -> Yojson.Basic.t +(** [encode_json_resource v encoder] encodes [v] to to json *) + + +(** {2 JSON Decoding} *) + +val decode_json_resource : Yojson.Basic.t -> resource +(** [decode_json_resource decoder] decodes a [resource] value from [decoder] *) diff --git a/src/proto/status.ml b/src/proto/status.ml index fd9987de1..5911e522b 100644 --- a/src/proto/status.ml +++ b/src/proto/status.ml @@ -1,103 +1,157 @@ -[@@@ocaml.warning "-27-30-39-44"] +[@@@ocaml.warning "-23-27-30-39-44"] type status = { - code : int32; - message : bytes; - details : bytes list; -} - -let rec default_status - ?code:((code:int32) = 0l) - ?message:((message:bytes) = Bytes.create 0) - ?details:((details:bytes list) = []) - () : status = { - code; - message; - details; -} - -type status_mutable = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 2 fields *) mutable code : int32; mutable message : bytes; mutable details : bytes list; } -let default_status_mutable () : status_mutable = { - code = 0l; - message = Bytes.create 0; - details = []; +let default_status (): status = +{ + _presence=Pbrt.Bitfield.empty; + code=0l; + message=Bytes.create 0; + details=[]; } (** {2 Make functions} *) -let rec make_status - ~(code:int32) - ~(message:bytes) - ~(details:bytes list) - () : status = { - code; - message; - details; -} - -[@@@ocaml.warning "-27-30-39"] +let[@inline] status_has_code (self:status) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] status_has_message (self:status) : bool = (Pbrt.Bitfield.get self._presence 1) + +let[@inline] status_set_code (self:status) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.code <- x +let[@inline] status_set_message (self:status) (x:bytes) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.message <- x +let[@inline] status_set_details (self:status) (x:bytes list) : unit = + self.details <- x + +let copy_status (self:status) : status = + { self with code = self.code } + +let make_status + ?(code:int32 option) + ?(message:bytes option) + ?(details=[]) + () : status = + let _res = default_status () in + (match code with + | None -> () + | Some v -> status_set_code _res v); + (match message with + | None -> () + | Some v -> status_set_message _res v); + status_set_details _res details; + _res + +[@@@ocaml.warning "-23-27-30-39"] (** {2 Formatters} *) let rec pp_status fmt (v:status) = let pp_i fmt () = - Pbrt.Pp.pp_record_field ~first:true "code" Pbrt.Pp.pp_int32 fmt v.code; - Pbrt.Pp.pp_record_field ~first:false "message" Pbrt.Pp.pp_bytes fmt v.message; + Pbrt.Pp.pp_record_field ~absent:(not (status_has_code v)) ~first:true "code" Pbrt.Pp.pp_int32 fmt v.code; + Pbrt.Pp.pp_record_field ~absent:(not (status_has_message v)) ~first:false "message" Pbrt.Pp.pp_bytes fmt v.message; Pbrt.Pp.pp_record_field ~first:false "details" (Pbrt.Pp.pp_list Pbrt.Pp.pp_bytes) fmt v.details; in Pbrt.Pp.pp_brk pp_i fmt () -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Encoding} *) let rec encode_pb_status (v:status) encoder = - Pbrt.Encoder.int32_as_varint v.code encoder; - Pbrt.Encoder.key 1 Pbrt.Varint encoder; - Pbrt.Encoder.bytes v.message encoder; - Pbrt.Encoder.key 2 Pbrt.Bytes encoder; - Pbrt.List_util.rev_iter_with (fun x encoder -> + if status_has_code v then ( + Pbrt.Encoder.int32_as_varint v.code encoder; + Pbrt.Encoder.key 1 Pbrt.Varint encoder; + ); + if status_has_message v then ( + Pbrt.Encoder.bytes v.message encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + ); + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.bytes x encoder; Pbrt.Encoder.key 3 Pbrt.Bytes encoder; ) v.details encoder; () -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Decoding} *) let rec decode_pb_status d = - let v = default_status_mutable () in + let v = default_status () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.details <- List.rev v.details; + (* put lists in the correct order *) + status_set_details v (List.rev v.details); ); continue__ := false | Some (1, Pbrt.Varint) -> begin - v.code <- Pbrt.Decoder.int32_as_varint d; + status_set_code v (Pbrt.Decoder.int32_as_varint d); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(status), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "status" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.message <- Pbrt.Decoder.bytes d; + status_set_message v (Pbrt.Decoder.bytes d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(status), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "status" 2 pk | Some (3, Pbrt.Bytes) -> begin - v.details <- (Pbrt.Decoder.bytes d) :: v.details; + status_set_details v ((Pbrt.Decoder.bytes d) :: v.details); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(status), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "status" 3 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; + (v : status) + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 Protobuf YoJson Encoding} *) + +let rec encode_json_status (v:status) = + let assoc = ref [] in + if status_has_code v then ( + assoc := ("code", Pbrt_yojson.make_int (Int32.to_int v.code)) :: !assoc; + ); + if status_has_message v then ( + assoc := ("message", Pbrt_yojson.make_bytes v.message) :: !assoc; + ); + assoc := ( + let l = v.details |> List.map Pbrt_yojson.make_bytes in + ("details", `List l) :: !assoc + ); + `Assoc !assoc + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 JSON Decoding} *) + +let rec decode_json_status d = + let v = default_status () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("code", json_value) -> + status_set_code v (Pbrt_yojson.int32 json_value "status" "code") + | ("message", json_value) -> + status_set_message v (Pbrt_yojson.bytes json_value "status" "message") + | ("details", `List l) -> begin + status_set_details v @@ List.map (function + | json_value -> Pbrt_yojson.bytes json_value "status" "details" + ) l; + end + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; ({ + _presence = v._presence; code = v.code; message = v.message; details = v.details; diff --git a/src/proto/status.mli b/src/proto/status.mli index 622f1256e..20fd64519 100644 --- a/src/proto/status.mli +++ b/src/proto/status.mli @@ -7,34 +7,47 @@ (** {2 Types} *) -type status = { - code : int32; - message : bytes; - details : bytes list; +type status = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 2 fields *) + mutable code : int32; + mutable message : bytes; + mutable details : bytes list; } (** {2 Basic values} *) -val default_status : - ?code:int32 -> - ?message:bytes -> - ?details:bytes list -> - unit -> - status -(** [default_status ()] is the default value for type [status] *) +val default_status : unit -> status +(** [default_status ()] is a new empty value for type [status] *) (** {2 Make functions} *) val make_status : - code:int32 -> - message:bytes -> - details:bytes list -> + ?code:int32 -> + ?message:bytes -> + ?details:bytes list -> unit -> status (** [make_status … ()] is a builder for type [status] *) +val copy_status : status -> status + +val status_has_code : status -> bool + (** presence of field "code" in [status] *) + +val status_set_code : status -> int32 -> unit + (** set field code in status *) + +val status_has_message : status -> bool + (** presence of field "message" in [status] *) + +val status_set_message : status -> bytes -> unit + (** set field message in status *) + +val status_set_details : status -> bytes list -> unit + (** set field details in status *) + (** {2 Formatters} *) @@ -52,3 +65,15 @@ val encode_pb_status : status -> Pbrt.Encoder.t -> unit val decode_pb_status : Pbrt.Decoder.t -> status (** [decode_pb_status decoder] decodes a [status] binary value from [decoder] *) + + +(** {2 Protobuf YoJson Encoding} *) + +val encode_json_status : status -> Yojson.Basic.t +(** [encode_json_status v encoder] encodes [v] to to json *) + + +(** {2 JSON Decoding} *) + +val decode_json_status : Yojson.Basic.t -> status +(** [decode_json_status decoder] decodes a [status] value from [decoder] *) diff --git a/src/proto/trace.ml b/src/proto/trace.ml index 9e35831ec..37dfbd9d6 100644 --- a/src/proto/trace.ml +++ b/src/proto/trace.ml @@ -1,4 +1,4 @@ -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39-44"] type span_span_kind = | Span_kind_unspecified @@ -9,207 +9,41 @@ type span_span_kind = | Span_kind_consumer type span_event = { - time_unix_nano : int64; - name : string; - attributes : Common.key_value list; - dropped_attributes_count : int32; -} - -type span_link = { - trace_id : bytes; - span_id : bytes; - trace_state : string; - attributes : Common.key_value list; - dropped_attributes_count : int32; -} - -type status_status_code = - | Status_code_unset - | Status_code_ok - | Status_code_error - -type status = { - message : string; - code : status_status_code; -} - -type span = { - trace_id : bytes; - span_id : bytes; - trace_state : string; - parent_span_id : bytes; - name : string; - kind : span_span_kind; - start_time_unix_nano : int64; - end_time_unix_nano : int64; - attributes : Common.key_value list; - dropped_attributes_count : int32; - events : span_event list; - dropped_events_count : int32; - links : span_link list; - dropped_links_count : int32; - status : status option; -} - -type scope_spans = { - scope : Common.instrumentation_scope option; - spans : span list; - schema_url : string; -} - -type resource_spans = { - resource : Resource.resource option; - scope_spans : scope_spans list; - schema_url : string; -} - -type traces_data = { - resource_spans : resource_spans list; -} - -let rec default_span_span_kind () = (Span_kind_unspecified:span_span_kind) - -let rec default_span_event - ?time_unix_nano:((time_unix_nano:int64) = 0L) - ?name:((name:string) = "") - ?attributes:((attributes:Common.key_value list) = []) - ?dropped_attributes_count:((dropped_attributes_count:int32) = 0l) - () : span_event = { - time_unix_nano; - name; - attributes; - dropped_attributes_count; -} - -let rec default_span_link - ?trace_id:((trace_id:bytes) = Bytes.create 0) - ?span_id:((span_id:bytes) = Bytes.create 0) - ?trace_state:((trace_state:string) = "") - ?attributes:((attributes:Common.key_value list) = []) - ?dropped_attributes_count:((dropped_attributes_count:int32) = 0l) - () : span_link = { - trace_id; - span_id; - trace_state; - attributes; - dropped_attributes_count; -} - -let rec default_status_status_code () = (Status_code_unset:status_status_code) - -let rec default_status - ?message:((message:string) = "") - ?code:((code:status_status_code) = default_status_status_code ()) - () : status = { - message; - code; -} - -let rec default_span - ?trace_id:((trace_id:bytes) = Bytes.create 0) - ?span_id:((span_id:bytes) = Bytes.create 0) - ?trace_state:((trace_state:string) = "") - ?parent_span_id:((parent_span_id:bytes) = Bytes.create 0) - ?name:((name:string) = "") - ?kind:((kind:span_span_kind) = default_span_span_kind ()) - ?start_time_unix_nano:((start_time_unix_nano:int64) = 0L) - ?end_time_unix_nano:((end_time_unix_nano:int64) = 0L) - ?attributes:((attributes:Common.key_value list) = []) - ?dropped_attributes_count:((dropped_attributes_count:int32) = 0l) - ?events:((events:span_event list) = []) - ?dropped_events_count:((dropped_events_count:int32) = 0l) - ?links:((links:span_link list) = []) - ?dropped_links_count:((dropped_links_count:int32) = 0l) - ?status:((status:status option) = None) - () : span = { - trace_id; - span_id; - trace_state; - parent_span_id; - name; - kind; - start_time_unix_nano; - end_time_unix_nano; - attributes; - dropped_attributes_count; - events; - dropped_events_count; - links; - dropped_links_count; - status; -} - -let rec default_scope_spans - ?scope:((scope:Common.instrumentation_scope option) = None) - ?spans:((spans:span list) = []) - ?schema_url:((schema_url:string) = "") - () : scope_spans = { - scope; - spans; - schema_url; -} - -let rec default_resource_spans - ?resource:((resource:Resource.resource option) = None) - ?scope_spans:((scope_spans:scope_spans list) = []) - ?schema_url:((schema_url:string) = "") - () : resource_spans = { - resource; - scope_spans; - schema_url; -} - -let rec default_traces_data - ?resource_spans:((resource_spans:resource_spans list) = []) - () : traces_data = { - resource_spans; -} - -type span_event_mutable = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 3 fields *) mutable time_unix_nano : int64; mutable name : string; mutable attributes : Common.key_value list; mutable dropped_attributes_count : int32; } -let default_span_event_mutable () : span_event_mutable = { - time_unix_nano = 0L; - name = ""; - attributes = []; - dropped_attributes_count = 0l; -} - -type span_link_mutable = { +type span_link = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 5 fields *) mutable trace_id : bytes; mutable span_id : bytes; mutable trace_state : string; mutable attributes : Common.key_value list; mutable dropped_attributes_count : int32; + mutable flags : int32; } -let default_span_link_mutable () : span_link_mutable = { - trace_id = Bytes.create 0; - span_id = Bytes.create 0; - trace_state = ""; - attributes = []; - dropped_attributes_count = 0l; -} +type status_status_code = + | Status_code_unset + | Status_code_ok + | Status_code_error -type status_mutable = { +type status = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 2 fields *) mutable message : string; mutable code : status_status_code; } -let default_status_mutable () : status_mutable = { - message = ""; - code = default_status_status_code (); -} - -type span_mutable = { +type span = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 12 fields *) mutable trace_id : bytes; mutable span_id : bytes; mutable trace_state : string; mutable parent_span_id : bytes; + mutable flags : int32; mutable name : string; mutable kind : span_span_kind; mutable start_time_unix_nano : int64; @@ -223,156 +57,397 @@ type span_mutable = { mutable status : status option; } -let default_span_mutable () : span_mutable = { - trace_id = Bytes.create 0; - span_id = Bytes.create 0; - trace_state = ""; - parent_span_id = Bytes.create 0; - name = ""; - kind = default_span_span_kind (); - start_time_unix_nano = 0L; - end_time_unix_nano = 0L; - attributes = []; - dropped_attributes_count = 0l; - events = []; - dropped_events_count = 0l; - links = []; - dropped_links_count = 0l; - status = None; -} - -type scope_spans_mutable = { +type scope_spans = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) mutable scope : Common.instrumentation_scope option; mutable spans : span list; mutable schema_url : string; } -let default_scope_spans_mutable () : scope_spans_mutable = { - scope = None; - spans = []; - schema_url = ""; -} - -type resource_spans_mutable = { +type resource_spans = { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) mutable resource : Resource.resource option; mutable scope_spans : scope_spans list; mutable schema_url : string; } -let default_resource_spans_mutable () : resource_spans_mutable = { - resource = None; - scope_spans = []; - schema_url = ""; -} - -type traces_data_mutable = { +type traces_data = { mutable resource_spans : resource_spans list; } -let default_traces_data_mutable () : traces_data_mutable = { - resource_spans = []; +type span_flags = + | Span_flags_do_not_use + | Span_flags_trace_flags_mask + | Span_flags_context_has_is_remote_mask + | Span_flags_context_is_remote_mask + +let default_span_span_kind () = (Span_kind_unspecified:span_span_kind) + +let default_span_event (): span_event = +{ + _presence=Pbrt.Bitfield.empty; + time_unix_nano=0L; + name=""; + attributes=[]; + dropped_attributes_count=0l; } +let default_span_link (): span_link = +{ + _presence=Pbrt.Bitfield.empty; + trace_id=Bytes.create 0; + span_id=Bytes.create 0; + trace_state=""; + attributes=[]; + dropped_attributes_count=0l; + flags=0l; +} -(** {2 Make functions} *) - +let default_status_status_code () = (Status_code_unset:status_status_code) -let rec make_span_event - ~(time_unix_nano:int64) - ~(name:string) - ~(attributes:Common.key_value list) - ~(dropped_attributes_count:int32) - () : span_event = { - time_unix_nano; - name; - attributes; - dropped_attributes_count; +let default_status (): status = +{ + _presence=Pbrt.Bitfield.empty; + message=""; + code=default_status_status_code (); } -let rec make_span_link - ~(trace_id:bytes) - ~(span_id:bytes) - ~(trace_state:string) - ~(attributes:Common.key_value list) - ~(dropped_attributes_count:int32) - () : span_link = { - trace_id; - span_id; - trace_state; - attributes; - dropped_attributes_count; +let default_span (): span = +{ + _presence=Pbrt.Bitfield.empty; + trace_id=Bytes.create 0; + span_id=Bytes.create 0; + trace_state=""; + parent_span_id=Bytes.create 0; + flags=0l; + name=""; + kind=default_span_span_kind (); + start_time_unix_nano=0L; + end_time_unix_nano=0L; + attributes=[]; + dropped_attributes_count=0l; + events=[]; + dropped_events_count=0l; + links=[]; + dropped_links_count=0l; + status=None; } - -let rec make_status - ~(message:string) - ~(code:status_status_code) - () : status = { - message; - code; +let default_scope_spans (): scope_spans = +{ + _presence=Pbrt.Bitfield.empty; + scope=None; + spans=[]; + schema_url=""; } -let rec make_span - ~(trace_id:bytes) - ~(span_id:bytes) - ~(trace_state:string) - ~(parent_span_id:bytes) - ~(name:string) - ~(kind:span_span_kind) - ~(start_time_unix_nano:int64) - ~(end_time_unix_nano:int64) - ~(attributes:Common.key_value list) - ~(dropped_attributes_count:int32) - ~(events:span_event list) - ~(dropped_events_count:int32) - ~(links:span_link list) - ~(dropped_links_count:int32) - ?status:((status:status option) = None) - () : span = { - trace_id; - span_id; - trace_state; - parent_span_id; - name; - kind; - start_time_unix_nano; - end_time_unix_nano; - attributes; - dropped_attributes_count; - events; - dropped_events_count; - links; - dropped_links_count; - status; +let default_resource_spans (): resource_spans = +{ + _presence=Pbrt.Bitfield.empty; + resource=None; + scope_spans=[]; + schema_url=""; } -let rec make_scope_spans - ?scope:((scope:Common.instrumentation_scope option) = None) - ~(spans:span list) - ~(schema_url:string) - () : scope_spans = { - scope; - spans; - schema_url; +let default_traces_data (): traces_data = +{ + resource_spans=[]; } -let rec make_resource_spans - ?resource:((resource:Resource.resource option) = None) - ~(scope_spans:scope_spans list) - ~(schema_url:string) - () : resource_spans = { - resource; - scope_spans; - schema_url; -} +let default_span_flags () = (Span_flags_do_not_use:span_flags) -let rec make_traces_data - ~(resource_spans:resource_spans list) - () : traces_data = { - resource_spans; -} -[@@@ocaml.warning "-27-30-39"] +(** {2 Make functions} *) + +let[@inline] span_event_has_time_unix_nano (self:span_event) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] span_event_has_name (self:span_event) : bool = (Pbrt.Bitfield.get self._presence 1) +let[@inline] span_event_has_dropped_attributes_count (self:span_event) : bool = (Pbrt.Bitfield.get self._presence 2) + +let[@inline] span_event_set_time_unix_nano (self:span_event) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.time_unix_nano <- x +let[@inline] span_event_set_name (self:span_event) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.name <- x +let[@inline] span_event_set_attributes (self:span_event) (x:Common.key_value list) : unit = + self.attributes <- x +let[@inline] span_event_set_dropped_attributes_count (self:span_event) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 2); self.dropped_attributes_count <- x + +let copy_span_event (self:span_event) : span_event = + { self with time_unix_nano = self.time_unix_nano } + +let make_span_event + ?(time_unix_nano:int64 option) + ?(name:string option) + ?(attributes=[]) + ?(dropped_attributes_count:int32 option) + () : span_event = + let _res = default_span_event () in + (match time_unix_nano with + | None -> () + | Some v -> span_event_set_time_unix_nano _res v); + (match name with + | None -> () + | Some v -> span_event_set_name _res v); + span_event_set_attributes _res attributes; + (match dropped_attributes_count with + | None -> () + | Some v -> span_event_set_dropped_attributes_count _res v); + _res + +let[@inline] span_link_has_trace_id (self:span_link) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] span_link_has_span_id (self:span_link) : bool = (Pbrt.Bitfield.get self._presence 1) +let[@inline] span_link_has_trace_state (self:span_link) : bool = (Pbrt.Bitfield.get self._presence 2) +let[@inline] span_link_has_dropped_attributes_count (self:span_link) : bool = (Pbrt.Bitfield.get self._presence 3) +let[@inline] span_link_has_flags (self:span_link) : bool = (Pbrt.Bitfield.get self._presence 4) + +let[@inline] span_link_set_trace_id (self:span_link) (x:bytes) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.trace_id <- x +let[@inline] span_link_set_span_id (self:span_link) (x:bytes) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.span_id <- x +let[@inline] span_link_set_trace_state (self:span_link) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 2); self.trace_state <- x +let[@inline] span_link_set_attributes (self:span_link) (x:Common.key_value list) : unit = + self.attributes <- x +let[@inline] span_link_set_dropped_attributes_count (self:span_link) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 3); self.dropped_attributes_count <- x +let[@inline] span_link_set_flags (self:span_link) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 4); self.flags <- x + +let copy_span_link (self:span_link) : span_link = + { self with trace_id = self.trace_id } + +let make_span_link + ?(trace_id:bytes option) + ?(span_id:bytes option) + ?(trace_state:string option) + ?(attributes=[]) + ?(dropped_attributes_count:int32 option) + ?(flags:int32 option) + () : span_link = + let _res = default_span_link () in + (match trace_id with + | None -> () + | Some v -> span_link_set_trace_id _res v); + (match span_id with + | None -> () + | Some v -> span_link_set_span_id _res v); + (match trace_state with + | None -> () + | Some v -> span_link_set_trace_state _res v); + span_link_set_attributes _res attributes; + (match dropped_attributes_count with + | None -> () + | Some v -> span_link_set_dropped_attributes_count _res v); + (match flags with + | None -> () + | Some v -> span_link_set_flags _res v); + _res + +let[@inline] status_has_message (self:status) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] status_has_code (self:status) : bool = (Pbrt.Bitfield.get self._presence 1) + +let[@inline] status_set_message (self:status) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.message <- x +let[@inline] status_set_code (self:status) (x:status_status_code) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.code <- x + +let copy_status (self:status) : status = + { self with message = self.message } + +let make_status + ?(message:string option) + ?(code:status_status_code option) + () : status = + let _res = default_status () in + (match message with + | None -> () + | Some v -> status_set_message _res v); + (match code with + | None -> () + | Some v -> status_set_code _res v); + _res + +let[@inline] span_has_trace_id (self:span) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] span_has_span_id (self:span) : bool = (Pbrt.Bitfield.get self._presence 1) +let[@inline] span_has_trace_state (self:span) : bool = (Pbrt.Bitfield.get self._presence 2) +let[@inline] span_has_parent_span_id (self:span) : bool = (Pbrt.Bitfield.get self._presence 3) +let[@inline] span_has_flags (self:span) : bool = (Pbrt.Bitfield.get self._presence 4) +let[@inline] span_has_name (self:span) : bool = (Pbrt.Bitfield.get self._presence 5) +let[@inline] span_has_kind (self:span) : bool = (Pbrt.Bitfield.get self._presence 6) +let[@inline] span_has_start_time_unix_nano (self:span) : bool = (Pbrt.Bitfield.get self._presence 7) +let[@inline] span_has_end_time_unix_nano (self:span) : bool = (Pbrt.Bitfield.get self._presence 8) +let[@inline] span_has_dropped_attributes_count (self:span) : bool = (Pbrt.Bitfield.get self._presence 9) +let[@inline] span_has_dropped_events_count (self:span) : bool = (Pbrt.Bitfield.get self._presence 10) +let[@inline] span_has_dropped_links_count (self:span) : bool = (Pbrt.Bitfield.get self._presence 11) + +let[@inline] span_set_trace_id (self:span) (x:bytes) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.trace_id <- x +let[@inline] span_set_span_id (self:span) (x:bytes) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.span_id <- x +let[@inline] span_set_trace_state (self:span) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 2); self.trace_state <- x +let[@inline] span_set_parent_span_id (self:span) (x:bytes) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 3); self.parent_span_id <- x +let[@inline] span_set_flags (self:span) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 4); self.flags <- x +let[@inline] span_set_name (self:span) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 5); self.name <- x +let[@inline] span_set_kind (self:span) (x:span_span_kind) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 6); self.kind <- x +let[@inline] span_set_start_time_unix_nano (self:span) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 7); self.start_time_unix_nano <- x +let[@inline] span_set_end_time_unix_nano (self:span) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 8); self.end_time_unix_nano <- x +let[@inline] span_set_attributes (self:span) (x:Common.key_value list) : unit = + self.attributes <- x +let[@inline] span_set_dropped_attributes_count (self:span) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 9); self.dropped_attributes_count <- x +let[@inline] span_set_events (self:span) (x:span_event list) : unit = + self.events <- x +let[@inline] span_set_dropped_events_count (self:span) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 10); self.dropped_events_count <- x +let[@inline] span_set_links (self:span) (x:span_link list) : unit = + self.links <- x +let[@inline] span_set_dropped_links_count (self:span) (x:int32) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 11); self.dropped_links_count <- x +let[@inline] span_set_status (self:span) (x:status) : unit = + self.status <- Some x + +let copy_span (self:span) : span = + { self with trace_id = self.trace_id } + +let make_span + ?(trace_id:bytes option) + ?(span_id:bytes option) + ?(trace_state:string option) + ?(parent_span_id:bytes option) + ?(flags:int32 option) + ?(name:string option) + ?(kind:span_span_kind option) + ?(start_time_unix_nano:int64 option) + ?(end_time_unix_nano:int64 option) + ?(attributes=[]) + ?(dropped_attributes_count:int32 option) + ?(events=[]) + ?(dropped_events_count:int32 option) + ?(links=[]) + ?(dropped_links_count:int32 option) + ?(status:status option) + () : span = + let _res = default_span () in + (match trace_id with + | None -> () + | Some v -> span_set_trace_id _res v); + (match span_id with + | None -> () + | Some v -> span_set_span_id _res v); + (match trace_state with + | None -> () + | Some v -> span_set_trace_state _res v); + (match parent_span_id with + | None -> () + | Some v -> span_set_parent_span_id _res v); + (match flags with + | None -> () + | Some v -> span_set_flags _res v); + (match name with + | None -> () + | Some v -> span_set_name _res v); + (match kind with + | None -> () + | Some v -> span_set_kind _res v); + (match start_time_unix_nano with + | None -> () + | Some v -> span_set_start_time_unix_nano _res v); + (match end_time_unix_nano with + | None -> () + | Some v -> span_set_end_time_unix_nano _res v); + span_set_attributes _res attributes; + (match dropped_attributes_count with + | None -> () + | Some v -> span_set_dropped_attributes_count _res v); + span_set_events _res events; + (match dropped_events_count with + | None -> () + | Some v -> span_set_dropped_events_count _res v); + span_set_links _res links; + (match dropped_links_count with + | None -> () + | Some v -> span_set_dropped_links_count _res v); + (match status with + | None -> () + | Some v -> span_set_status _res v); + _res + +let[@inline] scope_spans_has_schema_url (self:scope_spans) : bool = (Pbrt.Bitfield.get self._presence 0) + +let[@inline] scope_spans_set_scope (self:scope_spans) (x:Common.instrumentation_scope) : unit = + self.scope <- Some x +let[@inline] scope_spans_set_spans (self:scope_spans) (x:span list) : unit = + self.spans <- x +let[@inline] scope_spans_set_schema_url (self:scope_spans) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.schema_url <- x + +let copy_scope_spans (self:scope_spans) : scope_spans = + { self with scope = self.scope } + +let make_scope_spans + ?(scope:Common.instrumentation_scope option) + ?(spans=[]) + ?(schema_url:string option) + () : scope_spans = + let _res = default_scope_spans () in + (match scope with + | None -> () + | Some v -> scope_spans_set_scope _res v); + scope_spans_set_spans _res spans; + (match schema_url with + | None -> () + | Some v -> scope_spans_set_schema_url _res v); + _res + +let[@inline] resource_spans_has_schema_url (self:resource_spans) : bool = (Pbrt.Bitfield.get self._presence 0) + +let[@inline] resource_spans_set_resource (self:resource_spans) (x:Resource.resource) : unit = + self.resource <- Some x +let[@inline] resource_spans_set_scope_spans (self:resource_spans) (x:scope_spans list) : unit = + self.scope_spans <- x +let[@inline] resource_spans_set_schema_url (self:resource_spans) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.schema_url <- x + +let copy_resource_spans (self:resource_spans) : resource_spans = + { self with resource = self.resource } + +let make_resource_spans + ?(resource:Resource.resource option) + ?(scope_spans=[]) + ?(schema_url:string option) + () : resource_spans = + let _res = default_resource_spans () in + (match resource with + | None -> () + | Some v -> resource_spans_set_resource _res v); + resource_spans_set_scope_spans _res scope_spans; + (match schema_url with + | None -> () + | Some v -> resource_spans_set_schema_url _res v); + _res + + +let[@inline] traces_data_set_resource_spans (self:traces_data) (x:resource_spans list) : unit = + self.resource_spans <- x + +let copy_traces_data (self:traces_data) : traces_data = + { self with resource_spans = self.resource_spans } + +let make_traces_data + ?(resource_spans=[]) + () : traces_data = + let _res = default_traces_data () in + traces_data_set_resource_spans _res resource_spans; + _res + +[@@@ocaml.warning "-23-27-30-39"] (** {2 Formatters} *) @@ -387,20 +462,21 @@ let rec pp_span_span_kind fmt (v:span_span_kind) = let rec pp_span_event fmt (v:span_event) = let pp_i fmt () = - Pbrt.Pp.pp_record_field ~first:true "time_unix_nano" Pbrt.Pp.pp_int64 fmt v.time_unix_nano; - Pbrt.Pp.pp_record_field ~first:false "name" Pbrt.Pp.pp_string fmt v.name; + Pbrt.Pp.pp_record_field ~absent:(not (span_event_has_time_unix_nano v)) ~first:true "time_unix_nano" Pbrt.Pp.pp_int64 fmt v.time_unix_nano; + Pbrt.Pp.pp_record_field ~absent:(not (span_event_has_name v)) ~first:false "name" Pbrt.Pp.pp_string fmt v.name; Pbrt.Pp.pp_record_field ~first:false "attributes" (Pbrt.Pp.pp_list Common.pp_key_value) fmt v.attributes; - Pbrt.Pp.pp_record_field ~first:false "dropped_attributes_count" Pbrt.Pp.pp_int32 fmt v.dropped_attributes_count; + Pbrt.Pp.pp_record_field ~absent:(not (span_event_has_dropped_attributes_count v)) ~first:false "dropped_attributes_count" Pbrt.Pp.pp_int32 fmt v.dropped_attributes_count; in Pbrt.Pp.pp_brk pp_i fmt () let rec pp_span_link fmt (v:span_link) = let pp_i fmt () = - Pbrt.Pp.pp_record_field ~first:true "trace_id" Pbrt.Pp.pp_bytes fmt v.trace_id; - Pbrt.Pp.pp_record_field ~first:false "span_id" Pbrt.Pp.pp_bytes fmt v.span_id; - Pbrt.Pp.pp_record_field ~first:false "trace_state" Pbrt.Pp.pp_string fmt v.trace_state; + Pbrt.Pp.pp_record_field ~absent:(not (span_link_has_trace_id v)) ~first:true "trace_id" Pbrt.Pp.pp_bytes fmt v.trace_id; + Pbrt.Pp.pp_record_field ~absent:(not (span_link_has_span_id v)) ~first:false "span_id" Pbrt.Pp.pp_bytes fmt v.span_id; + Pbrt.Pp.pp_record_field ~absent:(not (span_link_has_trace_state v)) ~first:false "trace_state" Pbrt.Pp.pp_string fmt v.trace_state; Pbrt.Pp.pp_record_field ~first:false "attributes" (Pbrt.Pp.pp_list Common.pp_key_value) fmt v.attributes; - Pbrt.Pp.pp_record_field ~first:false "dropped_attributes_count" Pbrt.Pp.pp_int32 fmt v.dropped_attributes_count; + Pbrt.Pp.pp_record_field ~absent:(not (span_link_has_dropped_attributes_count v)) ~first:false "dropped_attributes_count" Pbrt.Pp.pp_int32 fmt v.dropped_attributes_count; + Pbrt.Pp.pp_record_field ~absent:(not (span_link_has_flags v)) ~first:false "flags" Pbrt.Pp.pp_int32 fmt v.flags; in Pbrt.Pp.pp_brk pp_i fmt () @@ -412,27 +488,28 @@ let rec pp_status_status_code fmt (v:status_status_code) = let rec pp_status fmt (v:status) = let pp_i fmt () = - Pbrt.Pp.pp_record_field ~first:true "message" Pbrt.Pp.pp_string fmt v.message; - Pbrt.Pp.pp_record_field ~first:false "code" pp_status_status_code fmt v.code; + Pbrt.Pp.pp_record_field ~absent:(not (status_has_message v)) ~first:true "message" Pbrt.Pp.pp_string fmt v.message; + Pbrt.Pp.pp_record_field ~absent:(not (status_has_code v)) ~first:false "code" pp_status_status_code fmt v.code; in Pbrt.Pp.pp_brk pp_i fmt () let rec pp_span fmt (v:span) = let pp_i fmt () = - Pbrt.Pp.pp_record_field ~first:true "trace_id" Pbrt.Pp.pp_bytes fmt v.trace_id; - Pbrt.Pp.pp_record_field ~first:false "span_id" Pbrt.Pp.pp_bytes fmt v.span_id; - Pbrt.Pp.pp_record_field ~first:false "trace_state" Pbrt.Pp.pp_string fmt v.trace_state; - Pbrt.Pp.pp_record_field ~first:false "parent_span_id" Pbrt.Pp.pp_bytes fmt v.parent_span_id; - Pbrt.Pp.pp_record_field ~first:false "name" Pbrt.Pp.pp_string fmt v.name; - Pbrt.Pp.pp_record_field ~first:false "kind" pp_span_span_kind fmt v.kind; - Pbrt.Pp.pp_record_field ~first:false "start_time_unix_nano" Pbrt.Pp.pp_int64 fmt v.start_time_unix_nano; - Pbrt.Pp.pp_record_field ~first:false "end_time_unix_nano" Pbrt.Pp.pp_int64 fmt v.end_time_unix_nano; + Pbrt.Pp.pp_record_field ~absent:(not (span_has_trace_id v)) ~first:true "trace_id" Pbrt.Pp.pp_bytes fmt v.trace_id; + Pbrt.Pp.pp_record_field ~absent:(not (span_has_span_id v)) ~first:false "span_id" Pbrt.Pp.pp_bytes fmt v.span_id; + Pbrt.Pp.pp_record_field ~absent:(not (span_has_trace_state v)) ~first:false "trace_state" Pbrt.Pp.pp_string fmt v.trace_state; + Pbrt.Pp.pp_record_field ~absent:(not (span_has_parent_span_id v)) ~first:false "parent_span_id" Pbrt.Pp.pp_bytes fmt v.parent_span_id; + Pbrt.Pp.pp_record_field ~absent:(not (span_has_flags v)) ~first:false "flags" Pbrt.Pp.pp_int32 fmt v.flags; + Pbrt.Pp.pp_record_field ~absent:(not (span_has_name v)) ~first:false "name" Pbrt.Pp.pp_string fmt v.name; + Pbrt.Pp.pp_record_field ~absent:(not (span_has_kind v)) ~first:false "kind" pp_span_span_kind fmt v.kind; + Pbrt.Pp.pp_record_field ~absent:(not (span_has_start_time_unix_nano v)) ~first:false "start_time_unix_nano" Pbrt.Pp.pp_int64 fmt v.start_time_unix_nano; + Pbrt.Pp.pp_record_field ~absent:(not (span_has_end_time_unix_nano v)) ~first:false "end_time_unix_nano" Pbrt.Pp.pp_int64 fmt v.end_time_unix_nano; Pbrt.Pp.pp_record_field ~first:false "attributes" (Pbrt.Pp.pp_list Common.pp_key_value) fmt v.attributes; - Pbrt.Pp.pp_record_field ~first:false "dropped_attributes_count" Pbrt.Pp.pp_int32 fmt v.dropped_attributes_count; + Pbrt.Pp.pp_record_field ~absent:(not (span_has_dropped_attributes_count v)) ~first:false "dropped_attributes_count" Pbrt.Pp.pp_int32 fmt v.dropped_attributes_count; Pbrt.Pp.pp_record_field ~first:false "events" (Pbrt.Pp.pp_list pp_span_event) fmt v.events; - Pbrt.Pp.pp_record_field ~first:false "dropped_events_count" Pbrt.Pp.pp_int32 fmt v.dropped_events_count; + Pbrt.Pp.pp_record_field ~absent:(not (span_has_dropped_events_count v)) ~first:false "dropped_events_count" Pbrt.Pp.pp_int32 fmt v.dropped_events_count; Pbrt.Pp.pp_record_field ~first:false "links" (Pbrt.Pp.pp_list pp_span_link) fmt v.links; - Pbrt.Pp.pp_record_field ~first:false "dropped_links_count" Pbrt.Pp.pp_int32 fmt v.dropped_links_count; + Pbrt.Pp.pp_record_field ~absent:(not (span_has_dropped_links_count v)) ~first:false "dropped_links_count" Pbrt.Pp.pp_int32 fmt v.dropped_links_count; Pbrt.Pp.pp_record_field ~first:false "status" (Pbrt.Pp.pp_option pp_status) fmt v.status; in Pbrt.Pp.pp_brk pp_i fmt () @@ -441,7 +518,7 @@ let rec pp_scope_spans fmt (v:scope_spans) = let pp_i fmt () = Pbrt.Pp.pp_record_field ~first:true "scope" (Pbrt.Pp.pp_option Common.pp_instrumentation_scope) fmt v.scope; Pbrt.Pp.pp_record_field ~first:false "spans" (Pbrt.Pp.pp_list pp_span) fmt v.spans; - Pbrt.Pp.pp_record_field ~first:false "schema_url" Pbrt.Pp.pp_string fmt v.schema_url; + Pbrt.Pp.pp_record_field ~absent:(not (scope_spans_has_schema_url v)) ~first:false "schema_url" Pbrt.Pp.pp_string fmt v.schema_url; in Pbrt.Pp.pp_brk pp_i fmt () @@ -449,7 +526,7 @@ let rec pp_resource_spans fmt (v:resource_spans) = let pp_i fmt () = Pbrt.Pp.pp_record_field ~first:true "resource" (Pbrt.Pp.pp_option Resource.pp_resource) fmt v.resource; Pbrt.Pp.pp_record_field ~first:false "scope_spans" (Pbrt.Pp.pp_list pp_scope_spans) fmt v.scope_spans; - Pbrt.Pp.pp_record_field ~first:false "schema_url" Pbrt.Pp.pp_string fmt v.schema_url; + Pbrt.Pp.pp_record_field ~absent:(not (resource_spans_has_schema_url v)) ~first:false "schema_url" Pbrt.Pp.pp_string fmt v.schema_url; in Pbrt.Pp.pp_brk pp_i fmt () @@ -459,7 +536,14 @@ let rec pp_traces_data fmt (v:traces_data) = in Pbrt.Pp.pp_brk pp_i fmt () -[@@@ocaml.warning "-27-30-39"] +let rec pp_span_flags fmt (v:span_flags) = + match v with + | Span_flags_do_not_use -> Format.fprintf fmt "Span_flags_do_not_use" + | Span_flags_trace_flags_mask -> Format.fprintf fmt "Span_flags_trace_flags_mask" + | Span_flags_context_has_is_remote_mask -> Format.fprintf fmt "Span_flags_context_has_is_remote_mask" + | Span_flags_context_is_remote_mask -> Format.fprintf fmt "Span_flags_context_is_remote_mask" + +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Encoding} *) @@ -473,31 +557,49 @@ let rec encode_pb_span_span_kind (v:span_span_kind) encoder = | Span_kind_consumer -> Pbrt.Encoder.int_as_varint 5 encoder let rec encode_pb_span_event (v:span_event) encoder = - Pbrt.Encoder.int64_as_bits64 v.time_unix_nano encoder; - Pbrt.Encoder.key 1 Pbrt.Bits64 encoder; - Pbrt.Encoder.string v.name encoder; - Pbrt.Encoder.key 2 Pbrt.Bytes encoder; - Pbrt.List_util.rev_iter_with (fun x encoder -> + if span_event_has_time_unix_nano v then ( + Pbrt.Encoder.int64_as_bits64 v.time_unix_nano encoder; + Pbrt.Encoder.key 1 Pbrt.Bits64 encoder; + ); + if span_event_has_name v then ( + Pbrt.Encoder.string v.name encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + ); + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested Common.encode_pb_key_value x encoder; Pbrt.Encoder.key 3 Pbrt.Bytes encoder; ) v.attributes encoder; - Pbrt.Encoder.int32_as_varint v.dropped_attributes_count encoder; - Pbrt.Encoder.key 4 Pbrt.Varint encoder; + if span_event_has_dropped_attributes_count v then ( + Pbrt.Encoder.int32_as_varint v.dropped_attributes_count encoder; + Pbrt.Encoder.key 4 Pbrt.Varint encoder; + ); () let rec encode_pb_span_link (v:span_link) encoder = - Pbrt.Encoder.bytes v.trace_id encoder; - Pbrt.Encoder.key 1 Pbrt.Bytes encoder; - Pbrt.Encoder.bytes v.span_id encoder; - Pbrt.Encoder.key 2 Pbrt.Bytes encoder; - Pbrt.Encoder.string v.trace_state encoder; - Pbrt.Encoder.key 3 Pbrt.Bytes encoder; - Pbrt.List_util.rev_iter_with (fun x encoder -> + if span_link_has_trace_id v then ( + Pbrt.Encoder.bytes v.trace_id encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ); + if span_link_has_span_id v then ( + Pbrt.Encoder.bytes v.span_id encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + ); + if span_link_has_trace_state v then ( + Pbrt.Encoder.string v.trace_state encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + ); + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested Common.encode_pb_key_value x encoder; Pbrt.Encoder.key 4 Pbrt.Bytes encoder; ) v.attributes encoder; - Pbrt.Encoder.int32_as_varint v.dropped_attributes_count encoder; - Pbrt.Encoder.key 5 Pbrt.Varint encoder; + if span_link_has_dropped_attributes_count v then ( + Pbrt.Encoder.int32_as_varint v.dropped_attributes_count encoder; + Pbrt.Encoder.key 5 Pbrt.Varint encoder; + ); + if span_link_has_flags v then ( + Pbrt.Encoder.int32_as_bits32 v.flags encoder; + Pbrt.Encoder.key 6 Pbrt.Bits32 encoder; + ); () let rec encode_pb_status_status_code (v:status_status_code) encoder = @@ -507,47 +609,77 @@ let rec encode_pb_status_status_code (v:status_status_code) encoder = | Status_code_error -> Pbrt.Encoder.int_as_varint 2 encoder let rec encode_pb_status (v:status) encoder = - Pbrt.Encoder.string v.message encoder; - Pbrt.Encoder.key 2 Pbrt.Bytes encoder; - encode_pb_status_status_code v.code encoder; - Pbrt.Encoder.key 3 Pbrt.Varint encoder; + if status_has_message v then ( + Pbrt.Encoder.string v.message encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + ); + if status_has_code v then ( + encode_pb_status_status_code v.code encoder; + Pbrt.Encoder.key 3 Pbrt.Varint encoder; + ); () let rec encode_pb_span (v:span) encoder = - Pbrt.Encoder.bytes v.trace_id encoder; - Pbrt.Encoder.key 1 Pbrt.Bytes encoder; - Pbrt.Encoder.bytes v.span_id encoder; - Pbrt.Encoder.key 2 Pbrt.Bytes encoder; - Pbrt.Encoder.string v.trace_state encoder; - Pbrt.Encoder.key 3 Pbrt.Bytes encoder; - Pbrt.Encoder.bytes v.parent_span_id encoder; - Pbrt.Encoder.key 4 Pbrt.Bytes encoder; - Pbrt.Encoder.string v.name encoder; - Pbrt.Encoder.key 5 Pbrt.Bytes encoder; - encode_pb_span_span_kind v.kind encoder; - Pbrt.Encoder.key 6 Pbrt.Varint encoder; - Pbrt.Encoder.int64_as_bits64 v.start_time_unix_nano encoder; - Pbrt.Encoder.key 7 Pbrt.Bits64 encoder; - Pbrt.Encoder.int64_as_bits64 v.end_time_unix_nano encoder; - Pbrt.Encoder.key 8 Pbrt.Bits64 encoder; - Pbrt.List_util.rev_iter_with (fun x encoder -> + if span_has_trace_id v then ( + Pbrt.Encoder.bytes v.trace_id encoder; + Pbrt.Encoder.key 1 Pbrt.Bytes encoder; + ); + if span_has_span_id v then ( + Pbrt.Encoder.bytes v.span_id encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + ); + if span_has_trace_state v then ( + Pbrt.Encoder.string v.trace_state encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + ); + if span_has_parent_span_id v then ( + Pbrt.Encoder.bytes v.parent_span_id encoder; + Pbrt.Encoder.key 4 Pbrt.Bytes encoder; + ); + if span_has_flags v then ( + Pbrt.Encoder.int32_as_bits32 v.flags encoder; + Pbrt.Encoder.key 16 Pbrt.Bits32 encoder; + ); + if span_has_name v then ( + Pbrt.Encoder.string v.name encoder; + Pbrt.Encoder.key 5 Pbrt.Bytes encoder; + ); + if span_has_kind v then ( + encode_pb_span_span_kind v.kind encoder; + Pbrt.Encoder.key 6 Pbrt.Varint encoder; + ); + if span_has_start_time_unix_nano v then ( + Pbrt.Encoder.int64_as_bits64 v.start_time_unix_nano encoder; + Pbrt.Encoder.key 7 Pbrt.Bits64 encoder; + ); + if span_has_end_time_unix_nano v then ( + Pbrt.Encoder.int64_as_bits64 v.end_time_unix_nano encoder; + Pbrt.Encoder.key 8 Pbrt.Bits64 encoder; + ); + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested Common.encode_pb_key_value x encoder; Pbrt.Encoder.key 9 Pbrt.Bytes encoder; ) v.attributes encoder; - Pbrt.Encoder.int32_as_varint v.dropped_attributes_count encoder; - Pbrt.Encoder.key 10 Pbrt.Varint encoder; - Pbrt.List_util.rev_iter_with (fun x encoder -> + if span_has_dropped_attributes_count v then ( + Pbrt.Encoder.int32_as_varint v.dropped_attributes_count encoder; + Pbrt.Encoder.key 10 Pbrt.Varint encoder; + ); + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_span_event x encoder; Pbrt.Encoder.key 11 Pbrt.Bytes encoder; ) v.events encoder; - Pbrt.Encoder.int32_as_varint v.dropped_events_count encoder; - Pbrt.Encoder.key 12 Pbrt.Varint encoder; - Pbrt.List_util.rev_iter_with (fun x encoder -> + if span_has_dropped_events_count v then ( + Pbrt.Encoder.int32_as_varint v.dropped_events_count encoder; + Pbrt.Encoder.key 12 Pbrt.Varint encoder; + ); + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_span_link x encoder; Pbrt.Encoder.key 13 Pbrt.Bytes encoder; ) v.links encoder; - Pbrt.Encoder.int32_as_varint v.dropped_links_count encoder; - Pbrt.Encoder.key 14 Pbrt.Varint encoder; + if span_has_dropped_links_count v then ( + Pbrt.Encoder.int32_as_varint v.dropped_links_count encoder; + Pbrt.Encoder.key 14 Pbrt.Varint encoder; + ); begin match v.status with | Some x -> Pbrt.Encoder.nested encode_pb_status x encoder; @@ -563,12 +695,14 @@ let rec encode_pb_scope_spans (v:scope_spans) encoder = Pbrt.Encoder.key 1 Pbrt.Bytes encoder; | None -> (); end; - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_span x encoder; Pbrt.Encoder.key 2 Pbrt.Bytes encoder; ) v.spans encoder; - Pbrt.Encoder.string v.schema_url encoder; - Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + if scope_spans_has_schema_url v then ( + Pbrt.Encoder.string v.schema_url encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + ); () let rec encode_pb_resource_spans (v:resource_spans) encoder = @@ -578,328 +712,743 @@ let rec encode_pb_resource_spans (v:resource_spans) encoder = Pbrt.Encoder.key 1 Pbrt.Bytes encoder; | None -> (); end; - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_scope_spans x encoder; Pbrt.Encoder.key 2 Pbrt.Bytes encoder; ) v.scope_spans encoder; - Pbrt.Encoder.string v.schema_url encoder; - Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + if resource_spans_has_schema_url v then ( + Pbrt.Encoder.string v.schema_url encoder; + Pbrt.Encoder.key 3 Pbrt.Bytes encoder; + ); () let rec encode_pb_traces_data (v:traces_data) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested encode_pb_resource_spans x encoder; Pbrt.Encoder.key 1 Pbrt.Bytes encoder; ) v.resource_spans encoder; () -[@@@ocaml.warning "-27-30-39"] +let rec encode_pb_span_flags (v:span_flags) encoder = + match v with + | Span_flags_do_not_use -> Pbrt.Encoder.int_as_varint (0) encoder + | Span_flags_trace_flags_mask -> Pbrt.Encoder.int_as_varint 255 encoder + | Span_flags_context_has_is_remote_mask -> Pbrt.Encoder.int_as_varint 256 encoder + | Span_flags_context_is_remote_mask -> Pbrt.Encoder.int_as_varint 512 encoder + +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Decoding} *) -let rec decode_pb_span_span_kind d = +let rec decode_pb_span_span_kind d : span_span_kind = match Pbrt.Decoder.int_as_varint d with - | 0 -> (Span_kind_unspecified:span_span_kind) - | 1 -> (Span_kind_internal:span_span_kind) - | 2 -> (Span_kind_server:span_span_kind) - | 3 -> (Span_kind_client:span_span_kind) - | 4 -> (Span_kind_producer:span_span_kind) - | 5 -> (Span_kind_consumer:span_span_kind) + | 0 -> Span_kind_unspecified + | 1 -> Span_kind_internal + | 2 -> Span_kind_server + | 3 -> Span_kind_client + | 4 -> Span_kind_producer + | 5 -> Span_kind_consumer | _ -> Pbrt.Decoder.malformed_variant "span_span_kind" let rec decode_pb_span_event d = - let v = default_span_event_mutable () in + let v = default_span_event () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.attributes <- List.rev v.attributes; + (* put lists in the correct order *) + span_event_set_attributes v (List.rev v.attributes); ); continue__ := false | Some (1, Pbrt.Bits64) -> begin - v.time_unix_nano <- Pbrt.Decoder.int64_as_bits64 d; + span_event_set_time_unix_nano v (Pbrt.Decoder.int64_as_bits64 d); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span_event), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "span_event" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.name <- Pbrt.Decoder.string d; + span_event_set_name v (Pbrt.Decoder.string d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span_event), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "span_event" 2 pk | Some (3, Pbrt.Bytes) -> begin - v.attributes <- (Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes; + span_event_set_attributes v ((Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span_event), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "span_event" 3 pk | Some (4, Pbrt.Varint) -> begin - v.dropped_attributes_count <- Pbrt.Decoder.int32_as_varint d; + span_event_set_dropped_attributes_count v (Pbrt.Decoder.int32_as_varint d); end | Some (4, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span_event), field(4)" pk + Pbrt.Decoder.unexpected_payload_message "span_event" 4 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - time_unix_nano = v.time_unix_nano; - name = v.name; - attributes = v.attributes; - dropped_attributes_count = v.dropped_attributes_count; - } : span_event) + (v : span_event) let rec decode_pb_span_link d = - let v = default_span_link_mutable () in + let v = default_span_link () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.attributes <- List.rev v.attributes; + (* put lists in the correct order *) + span_link_set_attributes v (List.rev v.attributes); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.trace_id <- Pbrt.Decoder.bytes d; + span_link_set_trace_id v (Pbrt.Decoder.bytes d); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span_link), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "span_link" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.span_id <- Pbrt.Decoder.bytes d; + span_link_set_span_id v (Pbrt.Decoder.bytes d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span_link), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "span_link" 2 pk | Some (3, Pbrt.Bytes) -> begin - v.trace_state <- Pbrt.Decoder.string d; + span_link_set_trace_state v (Pbrt.Decoder.string d); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span_link), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "span_link" 3 pk | Some (4, Pbrt.Bytes) -> begin - v.attributes <- (Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes; + span_link_set_attributes v ((Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes); end | Some (4, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span_link), field(4)" pk + Pbrt.Decoder.unexpected_payload_message "span_link" 4 pk | Some (5, Pbrt.Varint) -> begin - v.dropped_attributes_count <- Pbrt.Decoder.int32_as_varint d; + span_link_set_dropped_attributes_count v (Pbrt.Decoder.int32_as_varint d); end | Some (5, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span_link), field(5)" pk + Pbrt.Decoder.unexpected_payload_message "span_link" 5 pk + | Some (6, Pbrt.Bits32) -> begin + span_link_set_flags v (Pbrt.Decoder.int32_as_bits32 d); + end + | Some (6, pk) -> + Pbrt.Decoder.unexpected_payload_message "span_link" 6 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - trace_id = v.trace_id; - span_id = v.span_id; - trace_state = v.trace_state; - attributes = v.attributes; - dropped_attributes_count = v.dropped_attributes_count; - } : span_link) + (v : span_link) -let rec decode_pb_status_status_code d = +let rec decode_pb_status_status_code d : status_status_code = match Pbrt.Decoder.int_as_varint d with - | 0 -> (Status_code_unset:status_status_code) - | 1 -> (Status_code_ok:status_status_code) - | 2 -> (Status_code_error:status_status_code) + | 0 -> Status_code_unset + | 1 -> Status_code_ok + | 2 -> Status_code_error | _ -> Pbrt.Decoder.malformed_variant "status_status_code" let rec decode_pb_status d = - let v = default_status_mutable () in + let v = default_status () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( ); continue__ := false | Some (2, Pbrt.Bytes) -> begin - v.message <- Pbrt.Decoder.string d; + status_set_message v (Pbrt.Decoder.string d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(status), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "status" 2 pk | Some (3, Pbrt.Varint) -> begin - v.code <- decode_pb_status_status_code d; + status_set_code v (decode_pb_status_status_code d); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(status), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "status" 3 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - message = v.message; - code = v.code; - } : status) + (v : status) let rec decode_pb_span d = - let v = default_span_mutable () in + let v = default_span () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.links <- List.rev v.links; - v.events <- List.rev v.events; - v.attributes <- List.rev v.attributes; + (* put lists in the correct order *) + span_set_links v (List.rev v.links); + span_set_events v (List.rev v.events); + span_set_attributes v (List.rev v.attributes); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.trace_id <- Pbrt.Decoder.bytes d; + span_set_trace_id v (Pbrt.Decoder.bytes d); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "span" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.span_id <- Pbrt.Decoder.bytes d; + span_set_span_id v (Pbrt.Decoder.bytes d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "span" 2 pk | Some (3, Pbrt.Bytes) -> begin - v.trace_state <- Pbrt.Decoder.string d; + span_set_trace_state v (Pbrt.Decoder.string d); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "span" 3 pk | Some (4, Pbrt.Bytes) -> begin - v.parent_span_id <- Pbrt.Decoder.bytes d; + span_set_parent_span_id v (Pbrt.Decoder.bytes d); end | Some (4, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span), field(4)" pk + Pbrt.Decoder.unexpected_payload_message "span" 4 pk + | Some (16, Pbrt.Bits32) -> begin + span_set_flags v (Pbrt.Decoder.int32_as_bits32 d); + end + | Some (16, pk) -> + Pbrt.Decoder.unexpected_payload_message "span" 16 pk | Some (5, Pbrt.Bytes) -> begin - v.name <- Pbrt.Decoder.string d; + span_set_name v (Pbrt.Decoder.string d); end | Some (5, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span), field(5)" pk + Pbrt.Decoder.unexpected_payload_message "span" 5 pk | Some (6, Pbrt.Varint) -> begin - v.kind <- decode_pb_span_span_kind d; + span_set_kind v (decode_pb_span_span_kind d); end | Some (6, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span), field(6)" pk + Pbrt.Decoder.unexpected_payload_message "span" 6 pk | Some (7, Pbrt.Bits64) -> begin - v.start_time_unix_nano <- Pbrt.Decoder.int64_as_bits64 d; + span_set_start_time_unix_nano v (Pbrt.Decoder.int64_as_bits64 d); end | Some (7, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span), field(7)" pk + Pbrt.Decoder.unexpected_payload_message "span" 7 pk | Some (8, Pbrt.Bits64) -> begin - v.end_time_unix_nano <- Pbrt.Decoder.int64_as_bits64 d; + span_set_end_time_unix_nano v (Pbrt.Decoder.int64_as_bits64 d); end | Some (8, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span), field(8)" pk + Pbrt.Decoder.unexpected_payload_message "span" 8 pk | Some (9, Pbrt.Bytes) -> begin - v.attributes <- (Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes; + span_set_attributes v ((Common.decode_pb_key_value (Pbrt.Decoder.nested d)) :: v.attributes); end | Some (9, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span), field(9)" pk + Pbrt.Decoder.unexpected_payload_message "span" 9 pk | Some (10, Pbrt.Varint) -> begin - v.dropped_attributes_count <- Pbrt.Decoder.int32_as_varint d; + span_set_dropped_attributes_count v (Pbrt.Decoder.int32_as_varint d); end | Some (10, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span), field(10)" pk + Pbrt.Decoder.unexpected_payload_message "span" 10 pk | Some (11, Pbrt.Bytes) -> begin - v.events <- (decode_pb_span_event (Pbrt.Decoder.nested d)) :: v.events; + span_set_events v ((decode_pb_span_event (Pbrt.Decoder.nested d)) :: v.events); end | Some (11, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span), field(11)" pk + Pbrt.Decoder.unexpected_payload_message "span" 11 pk | Some (12, Pbrt.Varint) -> begin - v.dropped_events_count <- Pbrt.Decoder.int32_as_varint d; + span_set_dropped_events_count v (Pbrt.Decoder.int32_as_varint d); end | Some (12, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span), field(12)" pk + Pbrt.Decoder.unexpected_payload_message "span" 12 pk | Some (13, Pbrt.Bytes) -> begin - v.links <- (decode_pb_span_link (Pbrt.Decoder.nested d)) :: v.links; + span_set_links v ((decode_pb_span_link (Pbrt.Decoder.nested d)) :: v.links); end | Some (13, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span), field(13)" pk + Pbrt.Decoder.unexpected_payload_message "span" 13 pk | Some (14, Pbrt.Varint) -> begin - v.dropped_links_count <- Pbrt.Decoder.int32_as_varint d; + span_set_dropped_links_count v (Pbrt.Decoder.int32_as_varint d); end | Some (14, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span), field(14)" pk + Pbrt.Decoder.unexpected_payload_message "span" 14 pk | Some (15, Pbrt.Bytes) -> begin - v.status <- Some (decode_pb_status (Pbrt.Decoder.nested d)); + span_set_status v (decode_pb_status (Pbrt.Decoder.nested d)); end | Some (15, pk) -> - Pbrt.Decoder.unexpected_payload "Message(span), field(15)" pk + Pbrt.Decoder.unexpected_payload_message "span" 15 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - trace_id = v.trace_id; - span_id = v.span_id; - trace_state = v.trace_state; - parent_span_id = v.parent_span_id; - name = v.name; - kind = v.kind; - start_time_unix_nano = v.start_time_unix_nano; - end_time_unix_nano = v.end_time_unix_nano; - attributes = v.attributes; - dropped_attributes_count = v.dropped_attributes_count; - events = v.events; - dropped_events_count = v.dropped_events_count; - links = v.links; - dropped_links_count = v.dropped_links_count; - status = v.status; - } : span) + (v : span) let rec decode_pb_scope_spans d = - let v = default_scope_spans_mutable () in + let v = default_scope_spans () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.spans <- List.rev v.spans; + (* put lists in the correct order *) + scope_spans_set_spans v (List.rev v.spans); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.scope <- Some (Common.decode_pb_instrumentation_scope (Pbrt.Decoder.nested d)); + scope_spans_set_scope v (Common.decode_pb_instrumentation_scope (Pbrt.Decoder.nested d)); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(scope_spans), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "scope_spans" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.spans <- (decode_pb_span (Pbrt.Decoder.nested d)) :: v.spans; + scope_spans_set_spans v ((decode_pb_span (Pbrt.Decoder.nested d)) :: v.spans); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(scope_spans), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "scope_spans" 2 pk | Some (3, Pbrt.Bytes) -> begin - v.schema_url <- Pbrt.Decoder.string d; + scope_spans_set_schema_url v (Pbrt.Decoder.string d); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(scope_spans), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "scope_spans" 3 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - scope = v.scope; - spans = v.spans; - schema_url = v.schema_url; - } : scope_spans) + (v : scope_spans) let rec decode_pb_resource_spans d = - let v = default_resource_spans_mutable () in + let v = default_resource_spans () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.scope_spans <- List.rev v.scope_spans; + (* put lists in the correct order *) + resource_spans_set_scope_spans v (List.rev v.scope_spans); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.resource <- Some (Resource.decode_pb_resource (Pbrt.Decoder.nested d)); + resource_spans_set_resource v (Resource.decode_pb_resource (Pbrt.Decoder.nested d)); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(resource_spans), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "resource_spans" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.scope_spans <- (decode_pb_scope_spans (Pbrt.Decoder.nested d)) :: v.scope_spans; + resource_spans_set_scope_spans v ((decode_pb_scope_spans (Pbrt.Decoder.nested d)) :: v.scope_spans); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(resource_spans), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "resource_spans" 2 pk | Some (3, Pbrt.Bytes) -> begin - v.schema_url <- Pbrt.Decoder.string d; + resource_spans_set_schema_url v (Pbrt.Decoder.string d); end | Some (3, pk) -> - Pbrt.Decoder.unexpected_payload "Message(resource_spans), field(3)" pk + Pbrt.Decoder.unexpected_payload_message "resource_spans" 3 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - resource = v.resource; - scope_spans = v.scope_spans; - schema_url = v.schema_url; - } : resource_spans) + (v : resource_spans) let rec decode_pb_traces_data d = - let v = default_traces_data_mutable () in + let v = default_traces_data () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.resource_spans <- List.rev v.resource_spans; + (* put lists in the correct order *) + traces_data_set_resource_spans v (List.rev v.resource_spans); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.resource_spans <- (decode_pb_resource_spans (Pbrt.Decoder.nested d)) :: v.resource_spans; + traces_data_set_resource_spans v ((decode_pb_resource_spans (Pbrt.Decoder.nested d)) :: v.resource_spans); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(traces_data), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "traces_data" 1 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; + (v : traces_data) + +let rec decode_pb_span_flags d : span_flags = + match Pbrt.Decoder.int_as_varint d with + | 0 -> Span_flags_do_not_use + | 255 -> Span_flags_trace_flags_mask + | 256 -> Span_flags_context_has_is_remote_mask + | 512 -> Span_flags_context_is_remote_mask + | _ -> Pbrt.Decoder.malformed_variant "span_flags" + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 Protobuf YoJson Encoding} *) + +let rec encode_json_span_span_kind (v:span_span_kind) = + match v with + | Span_kind_unspecified -> `String "SPAN_KIND_UNSPECIFIED" + | Span_kind_internal -> `String "SPAN_KIND_INTERNAL" + | Span_kind_server -> `String "SPAN_KIND_SERVER" + | Span_kind_client -> `String "SPAN_KIND_CLIENT" + | Span_kind_producer -> `String "SPAN_KIND_PRODUCER" + | Span_kind_consumer -> `String "SPAN_KIND_CONSUMER" + +let rec encode_json_span_event (v:span_event) = + let assoc = ref [] in + if span_event_has_time_unix_nano v then ( + assoc := ("timeUnixNano", Pbrt_yojson.make_string (Int64.to_string v.time_unix_nano)) :: !assoc; + ); + if span_event_has_name v then ( + assoc := ("name", Pbrt_yojson.make_string v.name) :: !assoc; + ); + assoc := ( + let l = v.attributes |> List.map Common.encode_json_key_value in + ("attributes", `List l) :: !assoc + ); + if span_event_has_dropped_attributes_count v then ( + assoc := ("droppedAttributesCount", Pbrt_yojson.make_int (Int32.to_int v.dropped_attributes_count)) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_span_link (v:span_link) = + let assoc = ref [] in + if span_link_has_trace_id v then ( + assoc := ("traceId", Pbrt_yojson.make_bytes v.trace_id) :: !assoc; + ); + if span_link_has_span_id v then ( + assoc := ("spanId", Pbrt_yojson.make_bytes v.span_id) :: !assoc; + ); + if span_link_has_trace_state v then ( + assoc := ("traceState", Pbrt_yojson.make_string v.trace_state) :: !assoc; + ); + assoc := ( + let l = v.attributes |> List.map Common.encode_json_key_value in + ("attributes", `List l) :: !assoc + ); + if span_link_has_dropped_attributes_count v then ( + assoc := ("droppedAttributesCount", Pbrt_yojson.make_int (Int32.to_int v.dropped_attributes_count)) :: !assoc; + ); + if span_link_has_flags v then ( + assoc := ("flags", Pbrt_yojson.make_int (Int32.to_int v.flags)) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_status_status_code (v:status_status_code) = + match v with + | Status_code_unset -> `String "STATUS_CODE_UNSET" + | Status_code_ok -> `String "STATUS_CODE_OK" + | Status_code_error -> `String "STATUS_CODE_ERROR" + +let rec encode_json_status (v:status) = + let assoc = ref [] in + if status_has_message v then ( + assoc := ("message", Pbrt_yojson.make_string v.message) :: !assoc; + ); + if status_has_code v then ( + assoc := ("code", encode_json_status_status_code v.code) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_span (v:span) = + let assoc = ref [] in + if span_has_trace_id v then ( + assoc := ("traceId", Pbrt_yojson.make_bytes v.trace_id) :: !assoc; + ); + if span_has_span_id v then ( + assoc := ("spanId", Pbrt_yojson.make_bytes v.span_id) :: !assoc; + ); + if span_has_trace_state v then ( + assoc := ("traceState", Pbrt_yojson.make_string v.trace_state) :: !assoc; + ); + if span_has_parent_span_id v then ( + assoc := ("parentSpanId", Pbrt_yojson.make_bytes v.parent_span_id) :: !assoc; + ); + if span_has_flags v then ( + assoc := ("flags", Pbrt_yojson.make_int (Int32.to_int v.flags)) :: !assoc; + ); + if span_has_name v then ( + assoc := ("name", Pbrt_yojson.make_string v.name) :: !assoc; + ); + if span_has_kind v then ( + assoc := ("kind", encode_json_span_span_kind v.kind) :: !assoc; + ); + if span_has_start_time_unix_nano v then ( + assoc := ("startTimeUnixNano", Pbrt_yojson.make_string (Int64.to_string v.start_time_unix_nano)) :: !assoc; + ); + if span_has_end_time_unix_nano v then ( + assoc := ("endTimeUnixNano", Pbrt_yojson.make_string (Int64.to_string v.end_time_unix_nano)) :: !assoc; + ); + assoc := ( + let l = v.attributes |> List.map Common.encode_json_key_value in + ("attributes", `List l) :: !assoc + ); + if span_has_dropped_attributes_count v then ( + assoc := ("droppedAttributesCount", Pbrt_yojson.make_int (Int32.to_int v.dropped_attributes_count)) :: !assoc; + ); + assoc := ( + let l = v.events |> List.map encode_json_span_event in + ("events", `List l) :: !assoc + ); + if span_has_dropped_events_count v then ( + assoc := ("droppedEventsCount", Pbrt_yojson.make_int (Int32.to_int v.dropped_events_count)) :: !assoc; + ); + assoc := ( + let l = v.links |> List.map encode_json_span_link in + ("links", `List l) :: !assoc + ); + if span_has_dropped_links_count v then ( + assoc := ("droppedLinksCount", Pbrt_yojson.make_int (Int32.to_int v.dropped_links_count)) :: !assoc; + ); + assoc := (match v.status with + | None -> !assoc + | Some v -> ("status", encode_json_status v) :: !assoc); + `Assoc !assoc + +let rec encode_json_scope_spans (v:scope_spans) = + let assoc = ref [] in + assoc := (match v.scope with + | None -> !assoc + | Some v -> ("scope", Common.encode_json_instrumentation_scope v) :: !assoc); + assoc := ( + let l = v.spans |> List.map encode_json_span in + ("spans", `List l) :: !assoc + ); + if scope_spans_has_schema_url v then ( + assoc := ("schemaUrl", Pbrt_yojson.make_string v.schema_url) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_resource_spans (v:resource_spans) = + let assoc = ref [] in + assoc := (match v.resource with + | None -> !assoc + | Some v -> ("resource", Resource.encode_json_resource v) :: !assoc); + assoc := ( + let l = v.scope_spans |> List.map encode_json_scope_spans in + ("scopeSpans", `List l) :: !assoc + ); + if resource_spans_has_schema_url v then ( + assoc := ("schemaUrl", Pbrt_yojson.make_string v.schema_url) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_traces_data (v:traces_data) = + let assoc = ref [] in + assoc := ( + let l = v.resource_spans |> List.map encode_json_resource_spans in + ("resourceSpans", `List l) :: !assoc + ); + `Assoc !assoc + +let rec encode_json_span_flags (v:span_flags) = + match v with + | Span_flags_do_not_use -> `String "SPAN_FLAGS_DO_NOT_USE" + | Span_flags_trace_flags_mask -> `String "SPAN_FLAGS_TRACE_FLAGS_MASK" + | Span_flags_context_has_is_remote_mask -> `String "SPAN_FLAGS_CONTEXT_HAS_IS_REMOTE_MASK" + | Span_flags_context_is_remote_mask -> `String "SPAN_FLAGS_CONTEXT_IS_REMOTE_MASK" + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 JSON Decoding} *) + +let rec decode_json_span_span_kind json = + match json with + | `String "SPAN_KIND_UNSPECIFIED" -> (Span_kind_unspecified : span_span_kind) + | `String "SPAN_KIND_INTERNAL" -> (Span_kind_internal : span_span_kind) + | `String "SPAN_KIND_SERVER" -> (Span_kind_server : span_span_kind) + | `String "SPAN_KIND_CLIENT" -> (Span_kind_client : span_span_kind) + | `String "SPAN_KIND_PRODUCER" -> (Span_kind_producer : span_span_kind) + | `String "SPAN_KIND_CONSUMER" -> (Span_kind_consumer : span_span_kind) + | _ -> Pbrt_yojson.E.malformed_variant "span_span_kind" + +let rec decode_json_span_event d = + let v = default_span_event () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("timeUnixNano", json_value) -> + span_event_set_time_unix_nano v (Pbrt_yojson.int64 json_value "span_event" "time_unix_nano") + | ("name", json_value) -> + span_event_set_name v (Pbrt_yojson.string json_value "span_event" "name") + | ("attributes", `List l) -> begin + span_event_set_attributes v @@ List.map (function + | json_value -> (Common.decode_json_key_value json_value) + ) l; + end + | ("droppedAttributesCount", json_value) -> + span_event_set_dropped_attributes_count v (Pbrt_yojson.int32 json_value "span_event" "dropped_attributes_count") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + time_unix_nano = v.time_unix_nano; + name = v.name; + attributes = v.attributes; + dropped_attributes_count = v.dropped_attributes_count; + } : span_event) + +let rec decode_json_span_link d = + let v = default_span_link () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("traceId", json_value) -> + span_link_set_trace_id v (Pbrt_yojson.bytes json_value "span_link" "trace_id") + | ("spanId", json_value) -> + span_link_set_span_id v (Pbrt_yojson.bytes json_value "span_link" "span_id") + | ("traceState", json_value) -> + span_link_set_trace_state v (Pbrt_yojson.string json_value "span_link" "trace_state") + | ("attributes", `List l) -> begin + span_link_set_attributes v @@ List.map (function + | json_value -> (Common.decode_json_key_value json_value) + ) l; + end + | ("droppedAttributesCount", json_value) -> + span_link_set_dropped_attributes_count v (Pbrt_yojson.int32 json_value "span_link" "dropped_attributes_count") + | ("flags", json_value) -> + span_link_set_flags v (Pbrt_yojson.int32 json_value "span_link" "flags") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + trace_id = v.trace_id; + span_id = v.span_id; + trace_state = v.trace_state; + attributes = v.attributes; + dropped_attributes_count = v.dropped_attributes_count; + flags = v.flags; + } : span_link) + +let rec decode_json_status_status_code json = + match json with + | `String "STATUS_CODE_UNSET" -> (Status_code_unset : status_status_code) + | `String "STATUS_CODE_OK" -> (Status_code_ok : status_status_code) + | `String "STATUS_CODE_ERROR" -> (Status_code_error : status_status_code) + | _ -> Pbrt_yojson.E.malformed_variant "status_status_code" + +let rec decode_json_status d = + let v = default_status () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("message", json_value) -> + status_set_message v (Pbrt_yojson.string json_value "status" "message") + | ("code", json_value) -> + status_set_code v ((decode_json_status_status_code json_value)) + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + message = v.message; + code = v.code; + } : status) + +let rec decode_json_span d = + let v = default_span () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("traceId", json_value) -> + span_set_trace_id v (Pbrt_yojson.bytes json_value "span" "trace_id") + | ("spanId", json_value) -> + span_set_span_id v (Pbrt_yojson.bytes json_value "span" "span_id") + | ("traceState", json_value) -> + span_set_trace_state v (Pbrt_yojson.string json_value "span" "trace_state") + | ("parentSpanId", json_value) -> + span_set_parent_span_id v (Pbrt_yojson.bytes json_value "span" "parent_span_id") + | ("flags", json_value) -> + span_set_flags v (Pbrt_yojson.int32 json_value "span" "flags") + | ("name", json_value) -> + span_set_name v (Pbrt_yojson.string json_value "span" "name") + | ("kind", json_value) -> + span_set_kind v ((decode_json_span_span_kind json_value)) + | ("startTimeUnixNano", json_value) -> + span_set_start_time_unix_nano v (Pbrt_yojson.int64 json_value "span" "start_time_unix_nano") + | ("endTimeUnixNano", json_value) -> + span_set_end_time_unix_nano v (Pbrt_yojson.int64 json_value "span" "end_time_unix_nano") + | ("attributes", `List l) -> begin + span_set_attributes v @@ List.map (function + | json_value -> (Common.decode_json_key_value json_value) + ) l; + end + | ("droppedAttributesCount", json_value) -> + span_set_dropped_attributes_count v (Pbrt_yojson.int32 json_value "span" "dropped_attributes_count") + | ("events", `List l) -> begin + span_set_events v @@ List.map (function + | json_value -> (decode_json_span_event json_value) + ) l; + end + | ("droppedEventsCount", json_value) -> + span_set_dropped_events_count v (Pbrt_yojson.int32 json_value "span" "dropped_events_count") + | ("links", `List l) -> begin + span_set_links v @@ List.map (function + | json_value -> (decode_json_span_link json_value) + ) l; + end + | ("droppedLinksCount", json_value) -> + span_set_dropped_links_count v (Pbrt_yojson.int32 json_value "span" "dropped_links_count") + | ("status", json_value) -> + span_set_status v (decode_json_status json_value) + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + trace_id = v.trace_id; + span_id = v.span_id; + trace_state = v.trace_state; + parent_span_id = v.parent_span_id; + flags = v.flags; + name = v.name; + kind = v.kind; + start_time_unix_nano = v.start_time_unix_nano; + end_time_unix_nano = v.end_time_unix_nano; + attributes = v.attributes; + dropped_attributes_count = v.dropped_attributes_count; + events = v.events; + dropped_events_count = v.dropped_events_count; + links = v.links; + dropped_links_count = v.dropped_links_count; + status = v.status; + } : span) + +let rec decode_json_scope_spans d = + let v = default_scope_spans () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("scope", json_value) -> + scope_spans_set_scope v (Common.decode_json_instrumentation_scope json_value) + | ("spans", `List l) -> begin + scope_spans_set_spans v @@ List.map (function + | json_value -> (decode_json_span json_value) + ) l; + end + | ("schemaUrl", json_value) -> + scope_spans_set_schema_url v (Pbrt_yojson.string json_value "scope_spans" "schema_url") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + scope = v.scope; + spans = v.spans; + schema_url = v.schema_url; + } : scope_spans) + +let rec decode_json_resource_spans d = + let v = default_resource_spans () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("resource", json_value) -> + resource_spans_set_resource v (Resource.decode_json_resource json_value) + | ("scopeSpans", `List l) -> begin + resource_spans_set_scope_spans v @@ List.map (function + | json_value -> (decode_json_scope_spans json_value) + ) l; + end + | ("schemaUrl", json_value) -> + resource_spans_set_schema_url v (Pbrt_yojson.string json_value "resource_spans" "schema_url") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + resource = v.resource; + scope_spans = v.scope_spans; + schema_url = v.schema_url; + } : resource_spans) + +let rec decode_json_traces_data d = + let v = default_traces_data () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("resourceSpans", `List l) -> begin + traces_data_set_resource_spans v @@ List.map (function + | json_value -> (decode_json_resource_spans json_value) + ) l; + end + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; ({ resource_spans = v.resource_spans; } : traces_data) + +let rec decode_json_span_flags json = + match json with + | `String "SPAN_FLAGS_DO_NOT_USE" -> (Span_flags_do_not_use : span_flags) + | `String "SPAN_FLAGS_TRACE_FLAGS_MASK" -> (Span_flags_trace_flags_mask : span_flags) + | `String "SPAN_FLAGS_CONTEXT_HAS_IS_REMOTE_MASK" -> (Span_flags_context_has_is_remote_mask : span_flags) + | `String "SPAN_FLAGS_CONTEXT_IS_REMOTE_MASK" -> (Span_flags_context_is_remote_mask : span_flags) + | _ -> Pbrt_yojson.E.malformed_variant "span_flags" diff --git a/src/proto/trace.mli b/src/proto/trace.mli index bd7598e2d..398625f66 100644 --- a/src/proto/trace.mli +++ b/src/proto/trace.mli @@ -15,19 +15,22 @@ type span_span_kind = | Span_kind_producer | Span_kind_consumer -type span_event = { - time_unix_nano : int64; - name : string; - attributes : Common.key_value list; - dropped_attributes_count : int32; +type span_event = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 3 fields *) + mutable time_unix_nano : int64; + mutable name : string; + mutable attributes : Common.key_value list; + mutable dropped_attributes_count : int32; } -type span_link = { - trace_id : bytes; - span_id : bytes; - trace_state : string; - attributes : Common.key_value list; - dropped_attributes_count : int32; +type span_link = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 5 fields *) + mutable trace_id : bytes; + mutable span_id : bytes; + mutable trace_state : string; + mutable attributes : Common.key_value list; + mutable dropped_attributes_count : int32; + mutable flags : int32; } type status_status_code = @@ -35,85 +38,197 @@ type status_status_code = | Status_code_ok | Status_code_error -type status = { - message : string; - code : status_status_code; +type status = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 2 fields *) + mutable message : string; + mutable code : status_status_code; } -type span = { - trace_id : bytes; - span_id : bytes; - trace_state : string; - parent_span_id : bytes; - name : string; - kind : span_span_kind; - start_time_unix_nano : int64; - end_time_unix_nano : int64; - attributes : Common.key_value list; - dropped_attributes_count : int32; - events : span_event list; - dropped_events_count : int32; - links : span_link list; - dropped_links_count : int32; - status : status option; +type span = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 12 fields *) + mutable trace_id : bytes; + mutable span_id : bytes; + mutable trace_state : string; + mutable parent_span_id : bytes; + mutable flags : int32; + mutable name : string; + mutable kind : span_span_kind; + mutable start_time_unix_nano : int64; + mutable end_time_unix_nano : int64; + mutable attributes : Common.key_value list; + mutable dropped_attributes_count : int32; + mutable events : span_event list; + mutable dropped_events_count : int32; + mutable links : span_link list; + mutable dropped_links_count : int32; + mutable status : status option; } -type scope_spans = { - scope : Common.instrumentation_scope option; - spans : span list; - schema_url : string; +type scope_spans = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) + mutable scope : Common.instrumentation_scope option; + mutable spans : span list; + mutable schema_url : string; } -type resource_spans = { - resource : Resource.resource option; - scope_spans : scope_spans list; - schema_url : string; +type resource_spans = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 1 fields *) + mutable resource : Resource.resource option; + mutable scope_spans : scope_spans list; + mutable schema_url : string; } -type traces_data = { - resource_spans : resource_spans list; +type traces_data = private { + mutable resource_spans : resource_spans list; } +type span_flags = + | Span_flags_do_not_use + | Span_flags_trace_flags_mask + | Span_flags_context_has_is_remote_mask + | Span_flags_context_is_remote_mask + (** {2 Basic values} *) val default_span_span_kind : unit -> span_span_kind -(** [default_span_span_kind ()] is the default value for type [span_span_kind] *) +(** [default_span_span_kind ()] is a new empty value for type [span_span_kind] *) + +val default_span_event : unit -> span_event +(** [default_span_event ()] is a new empty value for type [span_event] *) + +val default_span_link : unit -> span_link +(** [default_span_link ()] is a new empty value for type [span_link] *) + +val default_status_status_code : unit -> status_status_code +(** [default_status_status_code ()] is a new empty value for type [status_status_code] *) + +val default_status : unit -> status +(** [default_status ()] is a new empty value for type [status] *) + +val default_span : unit -> span +(** [default_span ()] is a new empty value for type [span] *) + +val default_scope_spans : unit -> scope_spans +(** [default_scope_spans ()] is a new empty value for type [scope_spans] *) + +val default_resource_spans : unit -> resource_spans +(** [default_resource_spans ()] is a new empty value for type [resource_spans] *) -val default_span_event : +val default_traces_data : unit -> traces_data +(** [default_traces_data ()] is a new empty value for type [traces_data] *) + +val default_span_flags : unit -> span_flags +(** [default_span_flags ()] is a new empty value for type [span_flags] *) + + +(** {2 Make functions} *) + +val make_span_event : ?time_unix_nano:int64 -> ?name:string -> ?attributes:Common.key_value list -> ?dropped_attributes_count:int32 -> unit -> span_event -(** [default_span_event ()] is the default value for type [span_event] *) +(** [make_span_event … ()] is a builder for type [span_event] *) + +val copy_span_event : span_event -> span_event + +val span_event_has_time_unix_nano : span_event -> bool + (** presence of field "time_unix_nano" in [span_event] *) -val default_span_link : +val span_event_set_time_unix_nano : span_event -> int64 -> unit + (** set field time_unix_nano in span_event *) + +val span_event_has_name : span_event -> bool + (** presence of field "name" in [span_event] *) + +val span_event_set_name : span_event -> string -> unit + (** set field name in span_event *) + +val span_event_set_attributes : span_event -> Common.key_value list -> unit + (** set field attributes in span_event *) + +val span_event_has_dropped_attributes_count : span_event -> bool + (** presence of field "dropped_attributes_count" in [span_event] *) + +val span_event_set_dropped_attributes_count : span_event -> int32 -> unit + (** set field dropped_attributes_count in span_event *) + +val make_span_link : ?trace_id:bytes -> ?span_id:bytes -> ?trace_state:string -> ?attributes:Common.key_value list -> ?dropped_attributes_count:int32 -> + ?flags:int32 -> unit -> span_link -(** [default_span_link ()] is the default value for type [span_link] *) +(** [make_span_link … ()] is a builder for type [span_link] *) -val default_status_status_code : unit -> status_status_code -(** [default_status_status_code ()] is the default value for type [status_status_code] *) +val copy_span_link : span_link -> span_link + +val span_link_has_trace_id : span_link -> bool + (** presence of field "trace_id" in [span_link] *) + +val span_link_set_trace_id : span_link -> bytes -> unit + (** set field trace_id in span_link *) + +val span_link_has_span_id : span_link -> bool + (** presence of field "span_id" in [span_link] *) + +val span_link_set_span_id : span_link -> bytes -> unit + (** set field span_id in span_link *) + +val span_link_has_trace_state : span_link -> bool + (** presence of field "trace_state" in [span_link] *) + +val span_link_set_trace_state : span_link -> string -> unit + (** set field trace_state in span_link *) + +val span_link_set_attributes : span_link -> Common.key_value list -> unit + (** set field attributes in span_link *) + +val span_link_has_dropped_attributes_count : span_link -> bool + (** presence of field "dropped_attributes_count" in [span_link] *) -val default_status : +val span_link_set_dropped_attributes_count : span_link -> int32 -> unit + (** set field dropped_attributes_count in span_link *) + +val span_link_has_flags : span_link -> bool + (** presence of field "flags" in [span_link] *) + +val span_link_set_flags : span_link -> int32 -> unit + (** set field flags in span_link *) + +val make_status : ?message:string -> ?code:status_status_code -> unit -> status -(** [default_status ()] is the default value for type [status] *) +(** [make_status … ()] is a builder for type [status] *) + +val copy_status : status -> status + +val status_has_message : status -> bool + (** presence of field "message" in [status] *) + +val status_set_message : status -> string -> unit + (** set field message in status *) + +val status_has_code : status -> bool + (** presence of field "code" in [status] *) -val default_span : +val status_set_code : status -> status_status_code -> unit + (** set field code in status *) + +val make_span : ?trace_id:bytes -> ?span_id:bytes -> ?trace_state:string -> ?parent_span_id:bytes -> + ?flags:int32 -> ?name:string -> ?kind:span_span_kind -> ?start_time_unix_nano:int64 -> @@ -124,106 +239,152 @@ val default_span : ?dropped_events_count:int32 -> ?links:span_link list -> ?dropped_links_count:int32 -> - ?status:status option -> + ?status:status -> unit -> span -(** [default_span ()] is the default value for type [span] *) +(** [make_span … ()] is a builder for type [span] *) -val default_scope_spans : - ?scope:Common.instrumentation_scope option -> - ?spans:span list -> - ?schema_url:string -> - unit -> - scope_spans -(** [default_scope_spans ()] is the default value for type [scope_spans] *) +val copy_span : span -> span -val default_resource_spans : - ?resource:Resource.resource option -> - ?scope_spans:scope_spans list -> - ?schema_url:string -> - unit -> - resource_spans -(** [default_resource_spans ()] is the default value for type [resource_spans] *) +val span_has_trace_id : span -> bool + (** presence of field "trace_id" in [span] *) -val default_traces_data : - ?resource_spans:resource_spans list -> - unit -> - traces_data -(** [default_traces_data ()] is the default value for type [traces_data] *) +val span_set_trace_id : span -> bytes -> unit + (** set field trace_id in span *) +val span_has_span_id : span -> bool + (** presence of field "span_id" in [span] *) -(** {2 Make functions} *) +val span_set_span_id : span -> bytes -> unit + (** set field span_id in span *) +val span_has_trace_state : span -> bool + (** presence of field "trace_state" in [span] *) -val make_span_event : - time_unix_nano:int64 -> - name:string -> - attributes:Common.key_value list -> - dropped_attributes_count:int32 -> - unit -> - span_event -(** [make_span_event … ()] is a builder for type [span_event] *) +val span_set_trace_state : span -> string -> unit + (** set field trace_state in span *) -val make_span_link : - trace_id:bytes -> - span_id:bytes -> - trace_state:string -> - attributes:Common.key_value list -> - dropped_attributes_count:int32 -> - unit -> - span_link -(** [make_span_link … ()] is a builder for type [span_link] *) +val span_has_parent_span_id : span -> bool + (** presence of field "parent_span_id" in [span] *) +val span_set_parent_span_id : span -> bytes -> unit + (** set field parent_span_id in span *) -val make_status : - message:string -> - code:status_status_code -> - unit -> - status -(** [make_status … ()] is a builder for type [status] *) +val span_has_flags : span -> bool + (** presence of field "flags" in [span] *) -val make_span : - trace_id:bytes -> - span_id:bytes -> - trace_state:string -> - parent_span_id:bytes -> - name:string -> - kind:span_span_kind -> - start_time_unix_nano:int64 -> - end_time_unix_nano:int64 -> - attributes:Common.key_value list -> - dropped_attributes_count:int32 -> - events:span_event list -> - dropped_events_count:int32 -> - links:span_link list -> - dropped_links_count:int32 -> - ?status:status option -> - unit -> - span -(** [make_span … ()] is a builder for type [span] *) +val span_set_flags : span -> int32 -> unit + (** set field flags in span *) + +val span_has_name : span -> bool + (** presence of field "name" in [span] *) + +val span_set_name : span -> string -> unit + (** set field name in span *) + +val span_has_kind : span -> bool + (** presence of field "kind" in [span] *) + +val span_set_kind : span -> span_span_kind -> unit + (** set field kind in span *) + +val span_has_start_time_unix_nano : span -> bool + (** presence of field "start_time_unix_nano" in [span] *) + +val span_set_start_time_unix_nano : span -> int64 -> unit + (** set field start_time_unix_nano in span *) + +val span_has_end_time_unix_nano : span -> bool + (** presence of field "end_time_unix_nano" in [span] *) + +val span_set_end_time_unix_nano : span -> int64 -> unit + (** set field end_time_unix_nano in span *) + +val span_set_attributes : span -> Common.key_value list -> unit + (** set field attributes in span *) + +val span_has_dropped_attributes_count : span -> bool + (** presence of field "dropped_attributes_count" in [span] *) + +val span_set_dropped_attributes_count : span -> int32 -> unit + (** set field dropped_attributes_count in span *) + +val span_set_events : span -> span_event list -> unit + (** set field events in span *) + +val span_has_dropped_events_count : span -> bool + (** presence of field "dropped_events_count" in [span] *) + +val span_set_dropped_events_count : span -> int32 -> unit + (** set field dropped_events_count in span *) + +val span_set_links : span -> span_link list -> unit + (** set field links in span *) + +val span_has_dropped_links_count : span -> bool + (** presence of field "dropped_links_count" in [span] *) + +val span_set_dropped_links_count : span -> int32 -> unit + (** set field dropped_links_count in span *) + +val span_set_status : span -> status -> unit + (** set field status in span *) val make_scope_spans : - ?scope:Common.instrumentation_scope option -> - spans:span list -> - schema_url:string -> + ?scope:Common.instrumentation_scope -> + ?spans:span list -> + ?schema_url:string -> unit -> scope_spans (** [make_scope_spans … ()] is a builder for type [scope_spans] *) +val copy_scope_spans : scope_spans -> scope_spans + +val scope_spans_set_scope : scope_spans -> Common.instrumentation_scope -> unit + (** set field scope in scope_spans *) + +val scope_spans_set_spans : scope_spans -> span list -> unit + (** set field spans in scope_spans *) + +val scope_spans_has_schema_url : scope_spans -> bool + (** presence of field "schema_url" in [scope_spans] *) + +val scope_spans_set_schema_url : scope_spans -> string -> unit + (** set field schema_url in scope_spans *) + val make_resource_spans : - ?resource:Resource.resource option -> - scope_spans:scope_spans list -> - schema_url:string -> + ?resource:Resource.resource -> + ?scope_spans:scope_spans list -> + ?schema_url:string -> unit -> resource_spans (** [make_resource_spans … ()] is a builder for type [resource_spans] *) +val copy_resource_spans : resource_spans -> resource_spans + +val resource_spans_set_resource : resource_spans -> Resource.resource -> unit + (** set field resource in resource_spans *) + +val resource_spans_set_scope_spans : resource_spans -> scope_spans list -> unit + (** set field scope_spans in resource_spans *) + +val resource_spans_has_schema_url : resource_spans -> bool + (** presence of field "schema_url" in [resource_spans] *) + +val resource_spans_set_schema_url : resource_spans -> string -> unit + (** set field schema_url in resource_spans *) + val make_traces_data : - resource_spans:resource_spans list -> + ?resource_spans:resource_spans list -> unit -> traces_data (** [make_traces_data … ()] is a builder for type [traces_data] *) +val copy_traces_data : traces_data -> traces_data + +val traces_data_set_resource_spans : traces_data -> resource_spans list -> unit + (** set field resource_spans in traces_data *) + (** {2 Formatters} *) @@ -254,6 +415,9 @@ val pp_resource_spans : Format.formatter -> resource_spans -> unit val pp_traces_data : Format.formatter -> traces_data -> unit (** [pp_traces_data v] formats v *) +val pp_span_flags : Format.formatter -> span_flags -> unit +(** [pp_span_flags v] formats v *) + (** {2 Protobuf Encoding} *) @@ -284,6 +448,9 @@ val encode_pb_resource_spans : resource_spans -> Pbrt.Encoder.t -> unit val encode_pb_traces_data : traces_data -> Pbrt.Encoder.t -> unit (** [encode_pb_traces_data v encoder] encodes [v] with the given [encoder] *) +val encode_pb_span_flags : span_flags -> Pbrt.Encoder.t -> unit +(** [encode_pb_span_flags v encoder] encodes [v] with the given [encoder] *) + (** {2 Protobuf Decoding} *) @@ -313,3 +480,72 @@ val decode_pb_resource_spans : Pbrt.Decoder.t -> resource_spans val decode_pb_traces_data : Pbrt.Decoder.t -> traces_data (** [decode_pb_traces_data decoder] decodes a [traces_data] binary value from [decoder] *) + +val decode_pb_span_flags : Pbrt.Decoder.t -> span_flags +(** [decode_pb_span_flags decoder] decodes a [span_flags] binary value from [decoder] *) + + +(** {2 Protobuf YoJson Encoding} *) + +val encode_json_span_span_kind : span_span_kind -> Yojson.Basic.t +(** [encode_json_span_span_kind v encoder] encodes [v] to to json *) + +val encode_json_span_event : span_event -> Yojson.Basic.t +(** [encode_json_span_event v encoder] encodes [v] to to json *) + +val encode_json_span_link : span_link -> Yojson.Basic.t +(** [encode_json_span_link v encoder] encodes [v] to to json *) + +val encode_json_status_status_code : status_status_code -> Yojson.Basic.t +(** [encode_json_status_status_code v encoder] encodes [v] to to json *) + +val encode_json_status : status -> Yojson.Basic.t +(** [encode_json_status v encoder] encodes [v] to to json *) + +val encode_json_span : span -> Yojson.Basic.t +(** [encode_json_span v encoder] encodes [v] to to json *) + +val encode_json_scope_spans : scope_spans -> Yojson.Basic.t +(** [encode_json_scope_spans v encoder] encodes [v] to to json *) + +val encode_json_resource_spans : resource_spans -> Yojson.Basic.t +(** [encode_json_resource_spans v encoder] encodes [v] to to json *) + +val encode_json_traces_data : traces_data -> Yojson.Basic.t +(** [encode_json_traces_data v encoder] encodes [v] to to json *) + +val encode_json_span_flags : span_flags -> Yojson.Basic.t +(** [encode_json_span_flags v encoder] encodes [v] to to json *) + + +(** {2 JSON Decoding} *) + +val decode_json_span_span_kind : Yojson.Basic.t -> span_span_kind +(** [decode_json_span_span_kind decoder] decodes a [span_span_kind] value from [decoder] *) + +val decode_json_span_event : Yojson.Basic.t -> span_event +(** [decode_json_span_event decoder] decodes a [span_event] value from [decoder] *) + +val decode_json_span_link : Yojson.Basic.t -> span_link +(** [decode_json_span_link decoder] decodes a [span_link] value from [decoder] *) + +val decode_json_status_status_code : Yojson.Basic.t -> status_status_code +(** [decode_json_status_status_code decoder] decodes a [status_status_code] value from [decoder] *) + +val decode_json_status : Yojson.Basic.t -> status +(** [decode_json_status decoder] decodes a [status] value from [decoder] *) + +val decode_json_span : Yojson.Basic.t -> span +(** [decode_json_span decoder] decodes a [span] value from [decoder] *) + +val decode_json_scope_spans : Yojson.Basic.t -> scope_spans +(** [decode_json_scope_spans decoder] decodes a [scope_spans] value from [decoder] *) + +val decode_json_resource_spans : Yojson.Basic.t -> resource_spans +(** [decode_json_resource_spans decoder] decodes a [resource_spans] value from [decoder] *) + +val decode_json_traces_data : Yojson.Basic.t -> traces_data +(** [decode_json_traces_data decoder] decodes a [traces_data] value from [decoder] *) + +val decode_json_span_flags : Yojson.Basic.t -> span_flags +(** [decode_json_span_flags decoder] decodes a [span_flags] value from [decoder] *) diff --git a/src/proto/trace_service.ml b/src/proto/trace_service.ml index 79f5fe8d6..31b4669fe 100644 --- a/src/proto/trace_service.ml +++ b/src/proto/trace_service.ml @@ -1,88 +1,94 @@ -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39-44"] type export_trace_service_request = { - resource_spans : Trace.resource_spans list; + mutable resource_spans : Trace.resource_spans list; } type export_trace_partial_success = { - rejected_spans : int64; - error_message : string; + mutable _presence: Pbrt.Bitfield.t; (** presence for 2 fields *) + mutable rejected_spans : int64; + mutable error_message : string; } type export_trace_service_response = { - partial_success : export_trace_partial_success option; + mutable partial_success : export_trace_partial_success option; } -let rec default_export_trace_service_request - ?resource_spans:((resource_spans:Trace.resource_spans list) = []) - () : export_trace_service_request = { - resource_spans; +let default_export_trace_service_request (): export_trace_service_request = +{ + resource_spans=[]; } -let rec default_export_trace_partial_success - ?rejected_spans:((rejected_spans:int64) = 0L) - ?error_message:((error_message:string) = "") - () : export_trace_partial_success = { - rejected_spans; - error_message; +let default_export_trace_partial_success (): export_trace_partial_success = +{ + _presence=Pbrt.Bitfield.empty; + rejected_spans=0L; + error_message=""; } -let rec default_export_trace_service_response - ?partial_success:((partial_success:export_trace_partial_success option) = None) - () : export_trace_service_response = { - partial_success; +let default_export_trace_service_response (): export_trace_service_response = +{ + partial_success=None; } -type export_trace_service_request_mutable = { - mutable resource_spans : Trace.resource_spans list; -} -let default_export_trace_service_request_mutable () : export_trace_service_request_mutable = { - resource_spans = []; -} +(** {2 Make functions} *) -type export_trace_partial_success_mutable = { - mutable rejected_spans : int64; - mutable error_message : string; -} -let default_export_trace_partial_success_mutable () : export_trace_partial_success_mutable = { - rejected_spans = 0L; - error_message = ""; -} +let[@inline] export_trace_service_request_set_resource_spans (self:export_trace_service_request) (x:Trace.resource_spans list) : unit = + self.resource_spans <- x -type export_trace_service_response_mutable = { - mutable partial_success : export_trace_partial_success option; -} +let copy_export_trace_service_request (self:export_trace_service_request) : export_trace_service_request = + { self with resource_spans = self.resource_spans } -let default_export_trace_service_response_mutable () : export_trace_service_response_mutable = { - partial_success = None; -} +let make_export_trace_service_request + ?(resource_spans=[]) + () : export_trace_service_request = + let _res = default_export_trace_service_request () in + export_trace_service_request_set_resource_spans _res resource_spans; + _res +let[@inline] export_trace_partial_success_has_rejected_spans (self:export_trace_partial_success) : bool = (Pbrt.Bitfield.get self._presence 0) +let[@inline] export_trace_partial_success_has_error_message (self:export_trace_partial_success) : bool = (Pbrt.Bitfield.get self._presence 1) -(** {2 Make functions} *) +let[@inline] export_trace_partial_success_set_rejected_spans (self:export_trace_partial_success) (x:int64) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 0); self.rejected_spans <- x +let[@inline] export_trace_partial_success_set_error_message (self:export_trace_partial_success) (x:string) : unit = + self._presence <- (Pbrt.Bitfield.set self._presence 1); self.error_message <- x -let rec make_export_trace_service_request - ~(resource_spans:Trace.resource_spans list) - () : export_trace_service_request = { - resource_spans; -} +let copy_export_trace_partial_success (self:export_trace_partial_success) : export_trace_partial_success = + { self with rejected_spans = self.rejected_spans } -let rec make_export_trace_partial_success - ~(rejected_spans:int64) - ~(error_message:string) - () : export_trace_partial_success = { - rejected_spans; - error_message; -} +let make_export_trace_partial_success + ?(rejected_spans:int64 option) + ?(error_message:string option) + () : export_trace_partial_success = + let _res = default_export_trace_partial_success () in + (match rejected_spans with + | None -> () + | Some v -> export_trace_partial_success_set_rejected_spans _res v); + (match error_message with + | None -> () + | Some v -> export_trace_partial_success_set_error_message _res v); + _res -let rec make_export_trace_service_response - ?partial_success:((partial_success:export_trace_partial_success option) = None) - () : export_trace_service_response = { - partial_success; -} -[@@@ocaml.warning "-27-30-39"] +let[@inline] export_trace_service_response_set_partial_success (self:export_trace_service_response) (x:export_trace_partial_success) : unit = + self.partial_success <- Some x + +let copy_export_trace_service_response (self:export_trace_service_response) : export_trace_service_response = + { self with partial_success = self.partial_success } + +let make_export_trace_service_response + ?(partial_success:export_trace_partial_success option) + () : export_trace_service_response = + let _res = default_export_trace_service_response () in + (match partial_success with + | None -> () + | Some v -> export_trace_service_response_set_partial_success _res v); + _res + +[@@@ocaml.warning "-23-27-30-39"] (** {2 Formatters} *) @@ -94,8 +100,8 @@ let rec pp_export_trace_service_request fmt (v:export_trace_service_request) = let rec pp_export_trace_partial_success fmt (v:export_trace_partial_success) = let pp_i fmt () = - Pbrt.Pp.pp_record_field ~first:true "rejected_spans" Pbrt.Pp.pp_int64 fmt v.rejected_spans; - Pbrt.Pp.pp_record_field ~first:false "error_message" Pbrt.Pp.pp_string fmt v.error_message; + Pbrt.Pp.pp_record_field ~absent:(not (export_trace_partial_success_has_rejected_spans v)) ~first:true "rejected_spans" Pbrt.Pp.pp_int64 fmt v.rejected_spans; + Pbrt.Pp.pp_record_field ~absent:(not (export_trace_partial_success_has_error_message v)) ~first:false "error_message" Pbrt.Pp.pp_string fmt v.error_message; in Pbrt.Pp.pp_brk pp_i fmt () @@ -105,22 +111,26 @@ let rec pp_export_trace_service_response fmt (v:export_trace_service_response) = in Pbrt.Pp.pp_brk pp_i fmt () -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Encoding} *) let rec encode_pb_export_trace_service_request (v:export_trace_service_request) encoder = - Pbrt.List_util.rev_iter_with (fun x encoder -> + Pbrt.List_util.rev_iter_with (fun x encoder -> Pbrt.Encoder.nested Trace.encode_pb_resource_spans x encoder; Pbrt.Encoder.key 1 Pbrt.Bytes encoder; ) v.resource_spans encoder; () let rec encode_pb_export_trace_partial_success (v:export_trace_partial_success) encoder = - Pbrt.Encoder.int64_as_varint v.rejected_spans encoder; - Pbrt.Encoder.key 1 Pbrt.Varint encoder; - Pbrt.Encoder.string v.error_message encoder; - Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + if export_trace_partial_success_has_rejected_spans v then ( + Pbrt.Encoder.int64_as_varint v.rejected_spans encoder; + Pbrt.Encoder.key 1 Pbrt.Varint encoder; + ); + if export_trace_partial_success_has_error_message v then ( + Pbrt.Encoder.string v.error_message encoder; + Pbrt.Encoder.key 2 Pbrt.Bytes encoder; + ); () let rec encode_pb_export_trace_service_response (v:export_trace_service_response) encoder = @@ -132,67 +142,149 @@ let rec encode_pb_export_trace_service_response (v:export_trace_service_response end; () -[@@@ocaml.warning "-27-30-39"] +[@@@ocaml.warning "-23-27-30-39"] (** {2 Protobuf Decoding} *) let rec decode_pb_export_trace_service_request d = - let v = default_export_trace_service_request_mutable () in + let v = default_export_trace_service_request () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( - v.resource_spans <- List.rev v.resource_spans; + (* put lists in the correct order *) + export_trace_service_request_set_resource_spans v (List.rev v.resource_spans); ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.resource_spans <- (Trace.decode_pb_resource_spans (Pbrt.Decoder.nested d)) :: v.resource_spans; + export_trace_service_request_set_resource_spans v ((Trace.decode_pb_resource_spans (Pbrt.Decoder.nested d)) :: v.resource_spans); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(export_trace_service_request), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "export_trace_service_request" 1 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - resource_spans = v.resource_spans; - } : export_trace_service_request) + (v : export_trace_service_request) let rec decode_pb_export_trace_partial_success d = - let v = default_export_trace_partial_success_mutable () in + let v = default_export_trace_partial_success () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( ); continue__ := false | Some (1, Pbrt.Varint) -> begin - v.rejected_spans <- Pbrt.Decoder.int64_as_varint d; + export_trace_partial_success_set_rejected_spans v (Pbrt.Decoder.int64_as_varint d); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(export_trace_partial_success), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "export_trace_partial_success" 1 pk | Some (2, Pbrt.Bytes) -> begin - v.error_message <- Pbrt.Decoder.string d; + export_trace_partial_success_set_error_message v (Pbrt.Decoder.string d); end | Some (2, pk) -> - Pbrt.Decoder.unexpected_payload "Message(export_trace_partial_success), field(2)" pk + Pbrt.Decoder.unexpected_payload_message "export_trace_partial_success" 2 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; - ({ - rejected_spans = v.rejected_spans; - error_message = v.error_message; - } : export_trace_partial_success) + (v : export_trace_partial_success) let rec decode_pb_export_trace_service_response d = - let v = default_export_trace_service_response_mutable () in + let v = default_export_trace_service_response () in let continue__= ref true in while !continue__ do match Pbrt.Decoder.key d with | None -> ( ); continue__ := false | Some (1, Pbrt.Bytes) -> begin - v.partial_success <- Some (decode_pb_export_trace_partial_success (Pbrt.Decoder.nested d)); + export_trace_service_response_set_partial_success v (decode_pb_export_trace_partial_success (Pbrt.Decoder.nested d)); end | Some (1, pk) -> - Pbrt.Decoder.unexpected_payload "Message(export_trace_service_response), field(1)" pk + Pbrt.Decoder.unexpected_payload_message "export_trace_service_response" 1 pk | Some (_, payload_kind) -> Pbrt.Decoder.skip d payload_kind done; + (v : export_trace_service_response) + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 Protobuf YoJson Encoding} *) + +let rec encode_json_export_trace_service_request (v:export_trace_service_request) = + let assoc = ref [] in + assoc := ( + let l = v.resource_spans |> List.map Trace.encode_json_resource_spans in + ("resourceSpans", `List l) :: !assoc + ); + `Assoc !assoc + +let rec encode_json_export_trace_partial_success (v:export_trace_partial_success) = + let assoc = ref [] in + if export_trace_partial_success_has_rejected_spans v then ( + assoc := ("rejectedSpans", Pbrt_yojson.make_string (Int64.to_string v.rejected_spans)) :: !assoc; + ); + if export_trace_partial_success_has_error_message v then ( + assoc := ("errorMessage", Pbrt_yojson.make_string v.error_message) :: !assoc; + ); + `Assoc !assoc + +let rec encode_json_export_trace_service_response (v:export_trace_service_response) = + let assoc = ref [] in + assoc := (match v.partial_success with + | None -> !assoc + | Some v -> ("partialSuccess", encode_json_export_trace_partial_success v) :: !assoc); + `Assoc !assoc + +[@@@ocaml.warning "-23-27-30-39"] + +(** {2 JSON Decoding} *) + +let rec decode_json_export_trace_service_request d = + let v = default_export_trace_service_request () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("resourceSpans", `List l) -> begin + export_trace_service_request_set_resource_spans v @@ List.map (function + | json_value -> (Trace.decode_json_resource_spans json_value) + ) l; + end + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + resource_spans = v.resource_spans; + } : export_trace_service_request) + +let rec decode_json_export_trace_partial_success d = + let v = default_export_trace_partial_success () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("rejectedSpans", json_value) -> + export_trace_partial_success_set_rejected_spans v (Pbrt_yojson.int64 json_value "export_trace_partial_success" "rejected_spans") + | ("errorMessage", json_value) -> + export_trace_partial_success_set_error_message v (Pbrt_yojson.string json_value "export_trace_partial_success" "error_message") + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; + ({ + _presence = v._presence; + rejected_spans = v.rejected_spans; + error_message = v.error_message; + } : export_trace_partial_success) + +let rec decode_json_export_trace_service_response d = + let v = default_export_trace_service_response () in + let assoc = match d with + | `Assoc assoc -> assoc + | _ -> assert(false) + in + List.iter (function + | ("partialSuccess", json_value) -> + export_trace_service_response_set_partial_success v (decode_json_export_trace_partial_success json_value) + + | (_, _) -> () (*Unknown fields are ignored*) + ) assoc; ({ partial_success = v.partial_success; } : export_trace_service_response) diff --git a/src/proto/trace_service.mli b/src/proto/trace_service.mli index 4b555371e..674047e56 100644 --- a/src/proto/trace_service.mli +++ b/src/proto/trace_service.mli @@ -7,63 +7,78 @@ (** {2 Types} *) -type export_trace_service_request = { - resource_spans : Trace.resource_spans list; +type export_trace_service_request = private { + mutable resource_spans : Trace.resource_spans list; } -type export_trace_partial_success = { - rejected_spans : int64; - error_message : string; +type export_trace_partial_success = private { + mutable _presence: Pbrt.Bitfield.t; (** presence for 2 fields *) + mutable rejected_spans : int64; + mutable error_message : string; } -type export_trace_service_response = { - partial_success : export_trace_partial_success option; +type export_trace_service_response = private { + mutable partial_success : export_trace_partial_success option; } (** {2 Basic values} *) -val default_export_trace_service_request : - ?resource_spans:Trace.resource_spans list -> - unit -> - export_trace_service_request -(** [default_export_trace_service_request ()] is the default value for type [export_trace_service_request] *) +val default_export_trace_service_request : unit -> export_trace_service_request +(** [default_export_trace_service_request ()] is a new empty value for type [export_trace_service_request] *) -val default_export_trace_partial_success : - ?rejected_spans:int64 -> - ?error_message:string -> - unit -> - export_trace_partial_success -(** [default_export_trace_partial_success ()] is the default value for type [export_trace_partial_success] *) +val default_export_trace_partial_success : unit -> export_trace_partial_success +(** [default_export_trace_partial_success ()] is a new empty value for type [export_trace_partial_success] *) -val default_export_trace_service_response : - ?partial_success:export_trace_partial_success option -> - unit -> - export_trace_service_response -(** [default_export_trace_service_response ()] is the default value for type [export_trace_service_response] *) +val default_export_trace_service_response : unit -> export_trace_service_response +(** [default_export_trace_service_response ()] is a new empty value for type [export_trace_service_response] *) (** {2 Make functions} *) val make_export_trace_service_request : - resource_spans:Trace.resource_spans list -> + ?resource_spans:Trace.resource_spans list -> unit -> export_trace_service_request (** [make_export_trace_service_request … ()] is a builder for type [export_trace_service_request] *) +val copy_export_trace_service_request : export_trace_service_request -> export_trace_service_request + +val export_trace_service_request_set_resource_spans : export_trace_service_request -> Trace.resource_spans list -> unit + (** set field resource_spans in export_trace_service_request *) + val make_export_trace_partial_success : - rejected_spans:int64 -> - error_message:string -> + ?rejected_spans:int64 -> + ?error_message:string -> unit -> export_trace_partial_success (** [make_export_trace_partial_success … ()] is a builder for type [export_trace_partial_success] *) +val copy_export_trace_partial_success : export_trace_partial_success -> export_trace_partial_success + +val export_trace_partial_success_has_rejected_spans : export_trace_partial_success -> bool + (** presence of field "rejected_spans" in [export_trace_partial_success] *) + +val export_trace_partial_success_set_rejected_spans : export_trace_partial_success -> int64 -> unit + (** set field rejected_spans in export_trace_partial_success *) + +val export_trace_partial_success_has_error_message : export_trace_partial_success -> bool + (** presence of field "error_message" in [export_trace_partial_success] *) + +val export_trace_partial_success_set_error_message : export_trace_partial_success -> string -> unit + (** set field error_message in export_trace_partial_success *) + val make_export_trace_service_response : - ?partial_success:export_trace_partial_success option -> + ?partial_success:export_trace_partial_success -> unit -> export_trace_service_response (** [make_export_trace_service_response … ()] is a builder for type [export_trace_service_response] *) +val copy_export_trace_service_response : export_trace_service_response -> export_trace_service_response + +val export_trace_service_response_set_partial_success : export_trace_service_response -> export_trace_partial_success -> unit + (** set field partial_success in export_trace_service_response *) + (** {2 Formatters} *) @@ -99,3 +114,27 @@ val decode_pb_export_trace_partial_success : Pbrt.Decoder.t -> export_trace_part val decode_pb_export_trace_service_response : Pbrt.Decoder.t -> export_trace_service_response (** [decode_pb_export_trace_service_response decoder] decodes a [export_trace_service_response] binary value from [decoder] *) + + +(** {2 Protobuf YoJson Encoding} *) + +val encode_json_export_trace_service_request : export_trace_service_request -> Yojson.Basic.t +(** [encode_json_export_trace_service_request v encoder] encodes [v] to to json *) + +val encode_json_export_trace_partial_success : export_trace_partial_success -> Yojson.Basic.t +(** [encode_json_export_trace_partial_success v encoder] encodes [v] to to json *) + +val encode_json_export_trace_service_response : export_trace_service_response -> Yojson.Basic.t +(** [encode_json_export_trace_service_response v encoder] encodes [v] to to json *) + + +(** {2 JSON Decoding} *) + +val decode_json_export_trace_service_request : Yojson.Basic.t -> export_trace_service_request +(** [decode_json_export_trace_service_request decoder] decodes a [export_trace_service_request] value from [decoder] *) + +val decode_json_export_trace_partial_success : Yojson.Basic.t -> export_trace_partial_success +(** [decode_json_export_trace_partial_success decoder] decodes a [export_trace_partial_success] value from [decoder] *) + +val decode_json_export_trace_service_response : Yojson.Basic.t -> export_trace_service_response +(** [decode_json_export_trace_service_response decoder] decodes a [export_trace_service_response] value from [decoder] *) diff --git a/src/trace/common_.ml b/src/trace/common_.ml new file mode 100644 index 000000000..c5744107f --- /dev/null +++ b/src/trace/common_.ml @@ -0,0 +1,7 @@ +module OTEL = Opentelemetry +module Trace = Trace_core (* ocaml-trace *) +module Ambient_context = Ambient_context + +let ( let@ ) = ( @@ ) + +let spf = Printf.sprintf diff --git a/src/trace/dune b/src/trace/dune index 9606e2a50..c03bf9f29 100644 --- a/src/trace/dune +++ b/src/trace/dune @@ -2,5 +2,11 @@ (name opentelemetry_trace) (public_name opentelemetry.trace) (synopsis "Use opentelemetry as a collector for trace") - (optional) - (libraries opentelemetry.ambient-context trace.core opentelemetry)) + (optional) ; trace + (flags :standard -open Opentelemetry_util -open Opentelemetry_atomic) + (libraries + (re_export ambient-context) + (re_export opentelemetry.util) + opentelemetry.atomic + (re_export opentelemetry) + (re_export trace.core))) diff --git a/src/trace/opentelemetry_trace.ml b/src/trace/opentelemetry_trace.ml index 0126257bf..6f90c7802 100644 --- a/src/trace/opentelemetry_trace.ml +++ b/src/trace/opentelemetry_trace.ml @@ -1,383 +1,253 @@ -module Otel = Opentelemetry -module Otrace = Trace_core (* ocaml-trace *) -module TLS = Thread_local_storage - -open struct - let spf = Printf.sprintf -end +open Common_ + +module Extensions = struct + (* extend [Trace]'s types with OTEL specific variants, eg to have a + [Trace.span] be a wrapper around [OTEL.Span.t], or to declare custom actions + to link spans together, or to be able to use [OTEL]-specific metrics types *) + type Trace.span += Span_otel of OTEL.Span.t + + type Trace.extension_event += + | Ev_link_span of Trace.span * OTEL.Span_ctx.t + | Ev_record_exn of { + sp: Trace.span; + exn: exn; + bt: Printexc.raw_backtrace; + } + | Ev_set_span_kind of Trace.span * OTEL.Span_kind.t + | Ev_set_span_status of Trace.span * OTEL.Span_status.t -module Conv = struct - let[@inline] trace_id_of_otel (id : Otel.Trace_id.t) : Otrace.trace_id = - if id == Otel.Trace_id.dummy then - Otrace.Collector.dummy_trace_id - else - Bytes.unsafe_to_string (Otel.Trace_id.to_bytes id) - - let[@inline] trace_id_to_otel (id : Otrace.trace_id) : Otel.Trace_id.t = - if id == Otrace.Collector.dummy_trace_id then - Otel.Trace_id.dummy - else - Otel.Trace_id.of_bytes @@ Bytes.unsafe_of_string id - - let[@inline] span_id_of_otel (id : Otel.Span_id.t) : Otrace.span = - if id == Otel.Span_id.dummy then - Otrace.Collector.dummy_span - else - Bytes.get_int64_le (Otel.Span_id.to_bytes id) 0 - - let[@inline] span_id_to_otel (id : Otrace.span) : Otel.Span_id.t = - if id == Otrace.Collector.dummy_span then - Otel.Span_id.dummy - else ( - let b = Bytes.create 8 in - Bytes.set_int64_le b 0 id; - Otel.Span_id.of_bytes b - ) - - let[@inline] ctx_to_otel (self : Otrace.explicit_span_ctx) : Otel.Span_ctx.t = - Otel.Span_ctx.make - ~trace_id:(trace_id_to_otel self.trace_id) - ~parent_id:(span_id_to_otel self.span) - () - - let[@inline] ctx_of_otel (ctx : Otel.Span_ctx.t) : Otrace.explicit_span_ctx = - { - trace_id = trace_id_of_otel (Otel.Span_ctx.trace_id ctx); - span = span_id_of_otel (Otel.Span_ctx.parent_id ctx); - } + type Trace.metric += + | Metric_hist of OTEL.Metrics.histogram_data_point + | Metric_sum_int of int + | Metric_sum_float of float end -open Conv +open Extensions -module Well_known = struct - let spankind_key = "otrace.spankind" +(* Inject ambient span into [Trace], relying on the [Ambient_context] + library. We use the generic ambient context to carry a [Hmap.t] around with + possible the current [Trace.span], and it is also used by [OTEL] itself + (ambient [OTEL.Span_ctx.t]). - let internal = `String "INTERNAL" - - let server = `String "SERVER" + This mechanism is used by [Trace] so that nested [Trace.with_span] can infer + the correct parent-child relation from implicit context, and produce OTEL + spans accordingly; without it every span would be parentless. *) +module Ambient_span_provider_ = struct + let get_current_span () = + match OTEL.Ambient_span.get () with + | None -> None + | Some sp -> Some (Span_otel sp) - let client = `String "CLIENT" + let with_current_span_set_to () span f = + match span with + | Span_otel sp -> OTEL.Ambient_span.with_ambient sp (fun () -> f span) + | _ -> f span - let producer = `String "PRODUCER" + let callbacks : unit Trace.Ambient_span_provider.Callbacks.t = + { get_current_span; with_current_span_set_to } - let consumer = `String "CONSUMER" + let provider = Trace.Ambient_span_provider.ASP_some ((), callbacks) +end - let spankind_of_string = - let open Otel.Span in - function - | "INTERNAL" -> Span_kind_internal - | "SERVER" -> Span_kind_server - | "CLIENT" -> Span_kind_client - | "PRODUCER" -> Span_kind_producer - | "CONSUMER" -> Span_kind_consumer - | _ -> Span_kind_unspecified +let ambient_span_provider = Ambient_span_provider_.provider - let otel_attrs_of_otrace_data data = - let kind : Otel.Span.kind ref = ref Otel.Span.Span_kind_unspecified in - let data = - List.filter_map - (function - | name, `String v when name = "otrace.spankind" -> - kind := spankind_of_string v; - None - | x -> Some x) - data +open struct + type state = unit + + (* sanity check: otrace meta-map must be the same as hmap *) + let () = ignore (fun (k : _ Hmap.key) : _ Ambient_context.Context.key -> k) + + (** Key to access the current span context. Uses the shared key from core. *) + let k_span_ctx : OTEL.Span_ctx.t Ambient_context.Context.key = + OTEL.Span_ctx.k_ambient + + let enter_span () ~__FUNCTION__ ~__FILE__ ~__LINE__ ~level:_ ~params:_ + ~(data : (_ * Trace.user_data) list) ~parent name : Trace.span = + let start_time = OTEL.Clock.now_main () in + let trace_id, parent_id = + match parent with + | Trace.P_none -> OTEL.Trace_id.create (), None + | Trace.P_some (Span_otel sp) -> + OTEL.Span.trace_id sp, Some (OTEL.Span.id sp) + | _ -> + (match Ambient_context.get k_span_ctx with + | Some sp_ctx -> + OTEL.Span_ctx.trace_id sp_ctx, Some (OTEL.Span_ctx.parent_id sp_ctx) + | None -> OTEL.Trace_id.create (), None) in - !kind, data - (** Key to store an error [Otel.Span.status] with the message. Set - ["otrace.error" = "mymsg"] in a span data to set the span's status to - [{message="mymsg"; code=Error}]. *) - let status_error_key = "otrace.error" -end + let span_id = OTEL.Span_id.create () in -open Well_known - -let on_internal_error = - ref (fun msg -> Printf.eprintf "error in Opentelemetry_trace: %s\n%!" msg) - -type Otrace.extension_event += - | Ev_link_span of Otrace.explicit_span * Otrace.explicit_span - | Ev_set_span_kind of Otrace.explicit_span * Otel.Span_kind.t - | Ev_record_exn of Otrace.explicit_span * exn * Printexc.raw_backtrace - -module Internal = struct - type span_begin = { - start_time: int64; - name: string; - __FILE__: string; - __LINE__: int; - __FUNCTION__: string option; - scope: Otel.Scope.t; - parent: Otel.Span_ctx.t option; - } - - module Active_span_tbl = Hashtbl.Make (struct - include Int64 - - let hash : t -> int = Hashtbl.hash - end) - - (** key to access a OTEL scope from an explicit span *) - let k_explicit_scope : Otel.Scope.t Otrace.Meta_map.key = - Otrace.Meta_map.Key.create () - - (** Per-thread set of active spans. *) - module Active_spans = struct - type t = { tbl: span_begin Active_span_tbl.t } [@@unboxed] - - let create () : t = { tbl = Active_span_tbl.create 32 } - - let k_tls : t TLS.t = TLS.create () - - let[@inline] get () : t = - try TLS.get_exn k_tls - with TLS.Not_set -> - let self = create () in - TLS.set k_tls self; - self - end - - let otrace_of_otel (id : Otel.Span_id.t) : int64 = - let bs = Otel.Span_id.to_bytes id in - (* lucky that it coincides! *) - assert (Bytes.length bs = 8); - Bytes.get_int64_le bs 0 - - let enter_span' ?(explicit_parent : Otrace.explicit_span_ctx option) - ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name = - let open Otel in - let otel_id = Span_id.create () in - let otrace_id = otrace_of_otel otel_id in - - let parent_scope = Scope.get_ambient_scope () in - let trace_id = - match parent_scope with - | Some sc -> sc.trace_id - | None -> Trace_id.create () - in - let parent = - match explicit_parent, parent_scope with - | Some p, _ -> - Some - (Otel.Span_ctx.make ~trace_id ~parent_id:(span_id_to_otel p.span) ()) - | None, Some parent -> Some (Otel.Scope.to_span_ctx parent) - | None, None -> None + let attrs = + ("code.filepath", `String __FILE__) + :: ("code.lineno", `Int __LINE__) + :: data in - let new_scope = Otel.Scope.make ~trace_id ~span_id:otel_id ~attrs:data () in - - let start_time = Timestamp_ns.now_unix_ns () in - let sb = - { - start_time; - name; - __FILE__; - __LINE__; - __FUNCTION__; - scope = new_scope; - parent; - } + let otel_sp : OTEL.Span.t = + OTEL.Span.make ~start_time ~id:span_id ~trace_id ~attrs ?parent:parent_id + ~end_time:0L name in - let active_spans = Active_spans.get () in - Active_span_tbl.add active_spans.tbl otrace_id sb; - - otrace_id, sb - - let exit_span_ - { start_time; name; __FILE__; __LINE__; __FUNCTION__; scope; parent } = - let open Otel in - let end_time = Timestamp_ns.now_unix_ns () in - let kind, attrs = otel_attrs_of_otrace_data (Scope.attrs scope) in - - let status : Span_status.t = - match List.assoc_opt Well_known.status_error_key attrs with - | Some (`String message) -> { message; code = Status_code_error } - | _ -> { message = ""; code = Status_code_ok } + (* add more data if [__FUNCTION__] is present *) + (match __FUNCTION__ with + | Some __FUNCTION__ when OTEL.Span.is_not_dummy otel_sp -> + let function_name, module_path = + try + let last_dot = String.rindex __FUNCTION__ '.' in + let module_path = String.sub __FUNCTION__ 0 last_dot in + let function_name = + String.sub __FUNCTION__ (last_dot + 1) + (String.length __FUNCTION__ - last_dot - 1) + in + function_name, Some module_path + with Not_found -> + (* __FUNCTION__ has no dot, use it as-is *) + __FUNCTION__, None + in + let attrs = + ("code.function", `String function_name) + :: + (match module_path with + | Some module_path -> [ "code.namespace", `String module_path ] + | None -> []) + in + OTEL.Span.add_attrs otel_sp attrs + | _ -> ()); + + Span_otel otel_sp + + let exit_span () sp = + match sp with + | Span_otel span when OTEL.Span.is_not_dummy span -> + (* emit the span after setting the end timestamp *) + let end_time = OTEL.Clock.now_main () in + OTEL.Proto.Trace.span_set_end_time_unix_nano span end_time; + + (* use the current tracer *) + OTEL.Trace_provider.emit span + | _ -> () + + let add_data_to_span _self span (data : (_ * Trace.user_data) list) = + match span with + | Span_otel sp -> OTEL.Span.add_attrs sp data + | _ -> () + + let severity_of_level : Trace_core.Level.t -> _ = function + | Trace -> OTEL.Log_record.Severity_number_trace + | Debug1 -> OTEL.Log_record.Severity_number_debug + | Debug2 -> OTEL.Log_record.Severity_number_debug2 + | Debug3 -> OTEL.Log_record.Severity_number_debug3 + | Error -> OTEL.Log_record.Severity_number_error + | Info -> OTEL.Log_record.Severity_number_info + | Warning -> OTEL.Log_record.Severity_number_warn + + let message () ~(level : Trace_core.Level.t) ~params:_ ~data ~span msg : unit + = + let observed_time_unix_nano = OTEL.Clock.now_main () in + let trace_id, span_id = + match span with + | Some (Span_otel sp) -> + Some (OTEL.Span.trace_id sp), Some (OTEL.Span.id sp) + | _ -> + (match Ambient_context.get k_span_ctx with + | Some sp -> + Some (OTEL.Span_ctx.trace_id sp), Some (OTEL.Span_ctx.parent_id sp) + | _ -> None, None) in - let attrs = - match __FUNCTION__ with - | None -> - [ "code.filepath", `String __FILE__; "code.lineno", `Int __LINE__ ] - @ attrs - | Some __FUNCTION__ -> - let last_dot = String.rindex __FUNCTION__ '.' in - let module_path = String.sub __FUNCTION__ 0 last_dot in - let function_name = - String.sub __FUNCTION__ (last_dot + 1) - (String.length __FUNCTION__ - last_dot - 1) - in - [ - "code.filepath", `String __FILE__; - "code.lineno", `Int __LINE__; - "code.function", `String function_name; - "code.namespace", `String module_path; - ] - @ attrs + let severity = severity_of_level level in + let log = + OTEL.Log_record.make ~severity ?trace_id ?span_id ~attrs:data + ~observed_time_unix_nano (`String msg) + in + OTEL.Log_provider.emit log + + let metric () ~level:_ ~params:_ ~data:attrs name v : unit = + let now = OTEL.Clock.now_main () in + let kind = + let open Trace_core.Core_ext in + match v with + | Metric_int i -> `gauge (OTEL.Metrics.int ~attrs ~now i) + | Metric_float v -> `gauge (OTEL.Metrics.float ~attrs ~now v) + | Metric_sum_int i -> `sum (OTEL.Metrics.int ~attrs ~now i) + | Metric_sum_float v -> `sum (OTEL.Metrics.float ~attrs ~now v) + | Metric_hist h -> `hist h + | _ -> `none in - let parent_id = Option.map Otel.Span_ctx.parent_id parent in - Span.create ~kind ~trace_id:scope.trace_id ?parent:parent_id ~status - ~id:scope.span_id ~start_time ~end_time ~attrs - ~events:(Scope.events scope) name - |> fst - - let exit_span' otrace_id otel_span_begin = - let active_spans = Active_spans.get () in - Active_span_tbl.remove active_spans.tbl otrace_id; - exit_span_ otel_span_begin - - let exit_span_from_id otrace_id = - let active_spans = Active_spans.get () in - match Active_span_tbl.find_opt active_spans.tbl otrace_id with - | None -> None - | Some otel_span_begin -> - Active_span_tbl.remove active_spans.tbl otrace_id; - Some (exit_span_ otel_span_begin) + let m = + match kind with + | `none -> [] + | `gauge v -> [ OTEL.Metrics.gauge ~name [ v ] ] + | `sum v -> [ OTEL.Metrics.sum ~name [ v ] ] + | `hist h -> [ OTEL.Metrics.histogram ~name [ h ] ] + in + if m <> [] then OTEL.Emitter.emit (OTEL.Meter_provider.get ()).emit m + + let extension (_self : state) ~level:_ ev = + match ev with + | Ev_link_span (Span_otel sp1, sc2) -> + OTEL.Span.add_links sp1 [ OTEL.Span_link.of_span_ctx sc2 ] + | Ev_link_span _ -> () + | Ev_set_span_kind (Span_otel sp, k) -> OTEL.Span.set_kind sp k + | Ev_set_span_kind _ -> () + | Ev_set_span_status (Span_otel sp, st) -> OTEL.Span.set_status sp st + | Ev_set_span_status _ -> () + | Ev_record_exn { sp = Span_otel sp; exn; bt } -> + OTEL.Span.record_exception sp exn bt + | Ev_record_exn _ -> () + | _ -> () + + let init () = Trace.set_ambient_context_provider ambient_span_provider + + let shutdown () = () + + let callbacks : state Trace.Collector.Callbacks.t = + Trace.Collector.Callbacks.make ~enter_span ~exit_span ~add_data_to_span + ~message ~metric ~extension ~init ~shutdown () +end - let[@inline] get_scope (span : Otrace.explicit_span) : Otel.Scope.t option = - Otrace.Meta_map.find k_explicit_scope span.meta +let collector : Trace_core.collector = + Trace_core.Collector.C_some ((), callbacks) - module M = struct - let with_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name cb = - let otrace_id, sb = - enter_span' ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name - in +let with_ambient_span (sp : Trace.span) f = + match sp with + | Span_otel sp -> + Ambient_context.with_key_bound_to k_span_ctx (OTEL.Span.to_span_ctx sp) f + | _ -> f () - Otel.Scope.with_ambient_scope sb.scope @@ fun () -> - match cb otrace_id with - | res -> - let otel_span = exit_span' otrace_id sb in - Otel.Trace.emit [ otel_span ]; - res - | exception e -> - let bt = Printexc.get_raw_backtrace () in - - Otel.Scope.record_exception sb.scope e bt; - let otel_span = exit_span' otrace_id sb in - Otel.Trace.emit [ otel_span ]; - - Printexc.raise_with_backtrace e bt - - let enter_span ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name : - Trace_core.span = - let otrace_id, _sb = - enter_span' ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name - in - (* NOTE: we cannot enter ambient scope in a disjoint way - with the exit, because we only have [Ambient_context.with_binding], - no [set_binding] *) - otrace_id - - let exit_span otrace_id = - match exit_span_from_id otrace_id with - | None -> () - | Some otel_span -> Otel.Trace.emit [ otel_span ] - - let enter_manual_span ~(parent : Otrace.explicit_span_ctx option) ~flavor:_ - ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name : Otrace.explicit_span = - let otrace_id, sb = - match parent with - | None -> enter_span' ~__FUNCTION__ ~__FILE__ ~__LINE__ ~data name - | Some parent -> - enter_span' ~explicit_parent:parent ~__FUNCTION__ ~__FILE__ ~__LINE__ - ~data name - in +let with_ambient_span_ctx (sp : OTEL.Span_ctx.t) f = + Ambient_context.with_key_bound_to k_span_ctx sp f - let active_spans = Active_spans.get () in - Active_span_tbl.add active_spans.tbl otrace_id sb; - - Otrace. - { - span = otrace_id; - trace_id = trace_id_of_otel sb.scope.trace_id; - meta = Meta_map.(empty |> add k_explicit_scope sb.scope); - } - - let exit_manual_span Otrace.{ span = otrace_id; _ } = - let active_spans = Active_spans.get () in - match Active_span_tbl.find_opt active_spans.tbl otrace_id with - | None -> !on_internal_error (spf "no active span with ID %Ld" otrace_id) - | Some sb -> - let otel_span = exit_span' otrace_id sb in - Otel.Trace.emit [ otel_span ] - - let add_data_to_span otrace_id data = - let active_spans = Active_spans.get () in - match Active_span_tbl.find_opt active_spans.tbl otrace_id with - | None -> !on_internal_error (spf "no active span with ID %Ld" otrace_id) - | Some sb -> Otel.Scope.add_attrs sb.scope (fun () -> data) - - let add_data_to_manual_span (span : Otrace.explicit_span) data : unit = - match get_scope span with - | None -> - !on_internal_error (spf "manual span does not a contain an OTEL scope") - | Some scope -> Otel.Scope.add_attrs scope (fun () -> data) - - let message ?span ~data:_ msg : unit = - (* gather information from context *) - let old_scope = Otel.Scope.get_ambient_scope () in - let trace_id = Option.map (fun sc -> sc.Otel.Scope.trace_id) old_scope in - - let span_id = - match span with - | Some id -> Some (span_id_to_otel id) - | None -> Option.map (fun sc -> sc.Otel.Scope.span_id) old_scope - in +let link_span_to_otel_ctx (sp1 : Trace.span) (sp2 : OTEL.Span_ctx.t) : unit = + if Trace.enabled () then Trace.extension_event @@ Ev_link_span (sp1, sp2) - let log = Otel.Logs.make_str ?trace_id ?span_id msg in - Otel.Logs.emit [ log ] - - let shutdown () = () - - let name_process _name = () - - let name_thread _name = () - - let counter_int ~data name cur_val : unit = - let _kind, attrs = otel_attrs_of_otrace_data data in - let m = Otel.Metrics.(gauge ~name [ int ~attrs cur_val ]) in - Otel.Metrics.emit [ m ] - - let counter_float ~data name cur_val : unit = - let _kind, attrs = otel_attrs_of_otrace_data data in - let m = Otel.Metrics.(gauge ~name [ float ~attrs cur_val ]) in - Otel.Metrics.emit [ m ] - - let extension_event = function - | Ev_link_span (sp1, sp2) -> - (match get_scope sp1, get_scope sp2 with - | Some sc1, Some sc2 -> - Otel.Scope.add_links sc1 (fun () -> [ Otel.Scope.to_span_link sc2 ]) - | _ -> !on_internal_error "could not find scope for OTEL span") - | Ev_set_span_kind (sp, k) -> - (match get_scope sp with - | None -> !on_internal_error "could not find scope for OTEL span" - | Some sc -> Otel.Scope.set_kind sc k) - | Ev_record_exn (sp, exn, bt) -> - (match get_scope sp with - | None -> !on_internal_error "could not find scope for OTEL span" - | Some sc -> Otel.Scope.record_exception sc exn bt) - | _ -> () - end -end +let link_spans (sp1 : Trace.span) (sp2 : Trace.span) : unit = + if Trace.enabled () then ( + match sp2 with + | Span_otel sp2 -> + Trace.extension_event @@ Ev_link_span (sp1, OTEL.Span.to_span_ctx sp2) + | _ -> () + ) -let link_spans (sp1 : Otrace.explicit_span) (sp2 : Otrace.explicit_span) : unit - = - if Otrace.enabled () then Otrace.extension_event @@ Ev_link_span (sp1, sp2) +let[@inline] set_span_kind sp k : unit = + if Trace.enabled () then Trace.extension_event @@ Ev_set_span_kind (sp, k) -let set_span_kind sp k : unit = - if Otrace.enabled () then Otrace.extension_event @@ Ev_set_span_kind (sp, k) +let[@inline] set_span_status sp status : unit = + if Trace.enabled () then + Trace.extension_event @@ Ev_set_span_status (sp, status) let record_exception sp exn bt : unit = - if Otrace.enabled () then Otrace.extension_event @@ Ev_record_exn (sp, exn, bt) + if Trace.enabled () then + Trace.extension_event @@ Ev_record_exn { sp; exn; bt } + +let setup () = Trace.setup_collector collector -let collector () : Otrace.collector = (module Internal.M) +let setup_with_otel_exporter exp : unit = + OTEL.Sdk.set exp; + Trace.setup_collector collector -let setup () = Otrace.setup_collector @@ collector () +let setup_with_otel_backend = setup_with_otel_exporter -let setup_with_otel_backend b : unit = - Otel.Collector.set_backend b; - setup () +module Well_known = struct end diff --git a/src/trace/opentelemetry_trace.mli b/src/trace/opentelemetry_trace.mli index 060f4f13c..c0cf19192 100644 --- a/src/trace/opentelemetry_trace.mli +++ b/src/trace/opentelemetry_trace.mli @@ -1,21 +1,3 @@ -module Otel := Opentelemetry -module Otrace := Trace_core -module TLS := Thread_local_storage - -module Conv : sig - val trace_id_of_otel : Otel.Trace_id.t -> string - - val trace_id_to_otel : string -> Otel.Trace_id.t - - val span_id_of_otel : Otel.Span_id.t -> int64 - - val span_id_to_otel : int64 -> Otel.Span_id.t - - val ctx_to_otel : Otrace.explicit_span_ctx -> Otel.Span_ctx.t - - val ctx_of_otel : Otel.Span_ctx.t -> Otrace.explicit_span_ctx -end - (** [opentelemetry.trace] implements a {!Trace_core.Collector} for {{:https://v3.ocaml.org/p/trace} ocaml-trace}. @@ -23,205 +5,92 @@ end that use [ocaml-trace], and they will automatically emit OpenTelemetry spans and logs. - Both explicit scope (in the [_manual] functions such as [enter_manual_span]) - and implicit scope (in {!Internal.M.with_span}, via {!Ambient_context}) are - supported; see the detailed notes on {!Internal.M.enter_manual_span}. - - {1:wellknown Well-known identifiers} - - Because [ocaml-trace]'s API is a subset of OpenTelemetry functionality, this - interface allows for a few 'well-known' identifiers to be used in - [Trace]-instrumented libraries that wish to further support OpenTelemetry - usage. - - (These strings will not change in subsequent versions of this library, so - you do not need to depend on [opentelemetry.trace] to use them.) + [Ambient_context] is used to propagate the current span to child spans. - - If a key of exactly ["otrace.spankind"] is included in the - {!Trace_core.user_data} passed to [with_span] et al., it will be used as - the {!Opentelemetry.Span.kind} of the emitted span. (See - {!Internal.spankind_of_string} for the list of supported values.) + [Trace_core.extension_event] is used to expose OTEL-specific features on top + of the common tracing interface, e.g. to set the span kind: {[ - ocaml - let describe () = [ Opentelemetry_trace.(spankind_key, client) ] in - Trace_core.with_span ~__FILE__ ~__LINE__ ~data:describe "my-span" - @@ fun _ -> - (* ... *) + let@ span = Trace_core.with_span ~__FILE__ ~__LINE__ "my-span" in + Opentelemetry_trace.set_span_kind span Span_kind_client + (* ... *) ]} *) -val on_internal_error : (string -> unit) ref -(** Callback to print errors in the library itself (ie bugs) *) +module OTEL := Opentelemetry_core +module Otrace := Trace_core -val setup : unit -> unit -(** Install the OTEL backend as a Trace collector *) +(** The extension events for {!Trace_core}. *) +module Extensions : sig + type Otrace.span += + | Span_otel of OTEL.Span.t (** The type of span used for OTEL *) + + type Otrace.extension_event += + | Ev_link_span of Otrace.span * OTEL.Span_ctx.t + (** Link the given span to the given context. The context isn't the + parent, but the link can be used to correlate both spans. *) + | Ev_record_exn of { + sp: Otrace.span; + exn: exn; + bt: Printexc.raw_backtrace; + } + (** Record exception and potentially turn span to an error *) + | Ev_set_span_kind of Otrace.span * OTEL.Span_kind.t + | Ev_set_span_status of Otrace.span * OTEL.Span_status.t + + type Otrace.metric += + | Metric_hist of OTEL.Metrics.histogram_data_point + | Metric_sum_int of int + | Metric_sum_float of float +end -val setup_with_otel_backend : Opentelemetry.Collector.backend -> unit -(** Same as {!setup}, but also install the given backend as OTEL backend *) +val setup : unit -> unit +(** Install the OTEL backend as a [Trace] collector. The trace collector will + use {!Trace_provider.get}, {!Log_provider.get}, and {!Meter_provider.get} to + get the current tracer, logger, meter and use that to emit signals. -val collector : unit -> Trace_core.collector -(** Make a Trace collector that uses the OTEL backend to send spans and logs *) + This will not do much until a proper {!OTEL.Exporter.t} is installed via + {!OTEL.Sdk.set}. *) -val link_spans : Otrace.explicit_span -> Otrace.explicit_span -> unit -(** [link_spans sp1 sp2] modifies [sp1] by adding a span link to [sp2]. - @since 0.11 *) +val setup_with_otel_exporter : OTEL.Exporter.t -> unit +(** Same as {!setup}, but also calls [OTEL.Sdk.set otel_exporter] *) -val set_span_kind : Otrace.explicit_span -> Otel.Span.kind -> unit -(** [set_span_kind sp k] sets the span's kind. - @since 0.11 *) +val setup_with_otel_backend : OTEL.Exporter.t -> unit +[@@deprecated "use setup_with_otel_exporter"] -val record_exception : - Otrace.explicit_span -> exn -> Printexc.raw_backtrace -> unit -(** Record exception in the current span. - @since 0.11 *) +val collector : Trace_core.collector +(** Make a Trace collector that uses the main OTEL providers to emit traces, + metrics, and logs *) -(** Static references for well-known identifiers; see {!label-wellknown}. *) -module Well_known : sig - val spankind_key : string +val ambient_span_provider : Trace_core.Ambient_span_provider.t +(** Uses {!Ambient_context} to provide contextual spans in {!Trace_core}. It is + automatically installed by the {!collector}. *) - val internal : Otrace.user_data +val link_spans : Otrace.span -> Otrace.span -> unit +(** [link_spans sp1 sp2] modifies [sp1] by adding a span link to [sp2]. + @since 0.11 *) - val server : Otrace.user_data +val link_span_to_otel_ctx : Otrace.span -> OTEL.Span_ctx.t -> unit +(** [link_spans sp1 sp_ctx2] modifies [sp1] by adding a span link to [sp_ctx2]. + It must be the case that [sp1] is a currently active span. + @since 0.90 *) - val client : Otrace.user_data +val set_span_kind : Otrace.span -> OTEL.Span.kind -> unit +(** [set_span_kind sp k] sets the span's kind. *) - val producer : Otrace.user_data +val set_span_status : Otrace.span -> OTEL.Span_status.t -> unit +(** @since 0.90 *) - val consumer : Otrace.user_data +val record_exception : Otrace.span -> exn -> Printexc.raw_backtrace -> unit +(** Record exception in the current span. *) - val spankind_of_string : string -> Otel.Span.kind +val with_ambient_span : Otrace.span -> (unit -> 'a) -> 'a +(** [with_ambient_span sp f] calls [f()] in an ambient context where [sp] is the + current span. *) - val otel_attrs_of_otrace_data : - (string * Otrace.user_data) list -> - Otel.Span.kind * Otel.Span.key_value list -end -[@@deprecated "use the regular functions for this"] - -(**/**) - -(** Internal implementation details; do not consider these stable. *) -module Internal : sig - module M : sig - val with_span : - __FUNCTION__:string option -> - __FILE__:string -> - __LINE__:int -> - data:(string * Otrace.user_data) list -> - string (* span name *) -> - (Otrace.span -> 'a) -> - 'a - (** Implements {!Trace_core.Collector.S.with_span}, with the OpenTelemetry - collector as the backend. Invoked via {!Trace_core.with_span}. - - Notably, this has the same implicit-scope semantics as - {!Opentelemetry.Trace.with_}, and requires configuration of - {!Ambient_context}. - - @see - ambient-context docs *) - - val enter_manual_span : - parent:Otrace.explicit_span_ctx option -> - flavor:'a -> - __FUNCTION__:string option -> - __FILE__:string -> - __LINE__:int -> - data:(string * Otrace.user_data) list -> - string (* span name *) -> - Otrace.explicit_span - (** Implements {!Trace_core.Collector.S.enter_manual_span}, with the - OpenTelemetry collector as the backend. Invoked at - {!Trace_core.enter_manual_toplevel_span} and - {!Trace_core.enter_manual_sub_span}; requires an eventual call to - {!Trace_core.exit_manual_span}. - - These 'manual span' functions {e do not} implement the same implicit- - scope semantics of {!with_span}; and thus don't need to wrap a single - stack-frame / callback; you can freely enter a span at any point, store - the returned {!Trace_core.explicit_span}, and exit it at any later point - with {!Trace_core.exit_manual_span}. - - However, for that same reason, they also cannot update the - {!Ambient_context} — that is, when you invoke the various [manual] - functions, if you then invoke other functions that use - {!Trace_core.with_span}, those callees {e will not} see the span you - entered manually as their [parent]. - - Generally, the best practice is to only use these [manual] functions at - the 'leaves' of your callstack: that is, don't invoke user callbacks - from within them; or if you do, make sure to pass the [explicit_span] - you recieve from this function onwards to the user callback, so they can - create further child-spans. *) - - val exit_manual_span : Otrace.explicit_span -> unit - (** Implements {!Trace_core.Collector.S.exit_manual_span}, with the - OpenTelemetry collector as the backend. Invoked at - {!Trace_core.exit_manual_span}. Expects the [explicit_span] returned - from an earlier call to {!Trace_core.enter_manual_toplevel_span} or - {!Trace_core.enter_manual_sub_span}. - - (See the notes at {!enter_manual_span} about {!Ambient_context}.) *) - - val add_data_to_span : - Otrace.span -> (string * Otrace.user_data) list -> unit - - val add_data_to_manual_span : - Otrace.explicit_span -> (string * Otrace.user_data) list -> unit - - val message : - ?span:Otrace.span -> - data:(string * Otrace.user_data) list -> - string -> - unit - - val shutdown : unit -> unit - - val name_process : string -> unit - - val name_thread : string -> unit - - val counter_int : - data:(string * Otrace.user_data) list -> string -> int -> unit - - val counter_float : - data:(string * Otrace.user_data) list -> string -> float -> unit - end - - type span_begin = { - start_time: int64; - name: string; - __FILE__: string; - __LINE__: int; - __FUNCTION__: string option; - scope: Otel.Scope.t; - parent: Otel.Span_ctx.t option; - } - - module Active_span_tbl : Hashtbl.S with type key = Otrace.span - - (** Table indexed by ocaml-trace spans. *) - module Active_spans : sig - type t = private { tbl: span_begin Active_span_tbl.t } [@@unboxed] - - val create : unit -> t - - val k_tls : t TLS.t - - val get : unit -> t - end - - val otrace_of_otel : Otel.Span_id.t -> Otrace.span - - val enter_span' : - ?explicit_parent:Otrace.explicit_span_ctx -> - __FUNCTION__:string option -> - __FILE__:string -> - __LINE__:int -> - data:(string * Otrace.user_data) list -> - string -> - Otrace.span * span_begin - - val exit_span' : Otrace.span -> span_begin -> Otel.Span.t -end +val with_ambient_span_ctx : OTEL.Span_ctx.t -> (unit -> 'a) -> 'a +(** [with_ambient_span_ctx spc f] calls [f()] in a scope where [spc] is the + ambient span-context *) -(**/**) +module Well_known : sig end +[@@deprecated + "use the regular functions such as `link_spans` or `set_span_kind` for this"] diff --git a/src/core/AList.ml b/src/util/alist.ml similarity index 81% rename from src/core/AList.ml rename to src/util/alist.ml index 356f26304..973a2e31b 100644 --- a/src/core/AList.ml +++ b/src/util/alist.ml @@ -12,12 +12,14 @@ let[@inline] is_empty self : bool = let get = Atomic.get let add self x = + let backoff = ref 1 in while let old = Atomic.get self in let l' = x :: old in not (Atomic.compare_and_set self old l') do - () + Opentelemetry_domain.relax_loop !backoff; + backoff := min 128 (2 * !backoff) done let rec pop_all self = diff --git a/src/core/AList.mli b/src/util/alist.mli similarity index 100% rename from src/core/AList.mli rename to src/util/alist.mli diff --git a/src/util/aswitch.ml b/src/util/aswitch.ml new file mode 100644 index 000000000..a7f618afa --- /dev/null +++ b/src/util/aswitch.ml @@ -0,0 +1,66 @@ +open Opentelemetry_atomic + +module Int_map = Map.Make (struct + type t = int + + let compare = compare +end) + +type cb = unit -> unit + +type state = + | On of { + n: int; + m: cb Int_map.t; (** removable callbacks *) + l: cb list; + } + | Off + +type t = { st: state Atomic.t } [@@unboxed] + +type trigger = t + +let dummy : t = { st = Atomic.make Off } + +let on_turn_off (self : t) (f : cb) : unit = + let must_fire = + Util_atomic.update_cas self.st @@ function + | Off -> true, Off + | On r -> false, On { r with l = f :: r.l } + in + if must_fire then (* call now *) f () + +let turn_off' self = + (* When calling turn_off' from a signal handler, Trace.message may cause the thread + to be killed. For this reason, we provide a way to disable tracing here. *) + match Atomic.exchange self.st Off with + | Off -> `Was_off + | On { l; m; n = _ } -> + List.iter (fun f -> f ()) l; + Int_map.iter (fun _ f -> f ()) m; + `Was_on + +let[@inline] turn_off self = ignore (turn_off' self : [> `Was_on ]) + +let[@inline] link parent tr : unit = on_turn_off parent (fun () -> turn_off tr) + +let create ?parent () : t * trigger = + let self = { st = Atomic.make (On { l = []; n = 0; m = Int_map.empty }) } in + (* if there's a parent, turning the parent off must turn us off too *) + Option.iter (fun p -> link p self) parent; + self, self + +let[@inline] is_on self : bool = + match Atomic.get self.st with + | On _ -> true + | Off -> false + +let[@inline] is_off self = not (is_on self) + +let show self = Printf.sprintf "" (is_on self) + +let pp out self = Format.fprintf out "" (is_on self) + +module Unsafe = struct + let trigger_of_switch = Fun.id +end diff --git a/src/util/aswitch.mli b/src/util/aswitch.mli new file mode 100644 index 000000000..bc05da335 --- /dev/null +++ b/src/util/aswitch.mli @@ -0,0 +1,50 @@ +(** Aswitch for level-triggered cancellation and cleanup, atomically. + + A switch can be flipped to false once, and remains off forever afterwards. + + Inspired from https://ocsigen.org/lwt/5.5.0/api/Lwt_switch but thread-safe. +*) + +type t + +type trigger +(** Can be used to turn the switch off *) + +val pp : Format.formatter -> t -> unit + +val show : t -> string + +val create : ?parent:t -> unit -> t * trigger +(** New switch. + @param parent + inherit from this switch. It means that the result switches off if the + parent does, but conversely we can turn the result off without affecting + the parent. In other words, this switch's lifetime is a subset of the + parent's lifetime *) + +val on_turn_off : t -> (unit -> unit) -> unit +(** [on_turn_off sw f] will call [f()] when [sw] is turned off. If [sw] is + already off then [f()] is called immediately. + + {b NOTE} [f] really should not fail, and should be as fast and light as + possible. *) + +val is_on : t -> bool + +val is_off : t -> bool + +val turn_off : trigger -> unit + +val turn_off' : trigger -> [ `Was_off | `Was_on ] +(** Turn off switch, return previous state *) + +val link : t -> trigger -> unit +(** [link parent trigger] turns off [trigger] when [parent] is turned off *) + +val dummy : t +(** Always off switch *) + +module Unsafe : sig + val trigger_of_switch : t -> trigger + [@@alert unsafe "hope you know what you're doing"] +end diff --git a/src/util/cb_set.ml b/src/util/cb_set.ml new file mode 100644 index 000000000..37079bfc1 --- /dev/null +++ b/src/util/cb_set.ml @@ -0,0 +1,11 @@ +type cb = unit -> unit + +type t = { cbs: cb Alist.t } [@@unboxed] + +let create () : t = { cbs = Alist.make () } + +let[@inline] register self f = Alist.add self.cbs f + +let[@inline] trigger self = List.iter (fun f -> f ()) (Alist.get self.cbs) + +let clear self : unit = ignore (Alist.pop_all self.cbs : _ list) diff --git a/src/util/cb_set.mli b/src/util/cb_set.mli new file mode 100644 index 000000000..c64d613dd --- /dev/null +++ b/src/util/cb_set.mli @@ -0,0 +1,13 @@ +(** A collection of callbacks. thread-safe. *) + +type t +(** Thread safe set of callbacks *) + +val create : unit -> t + +val register : t -> (unit -> unit) -> unit + +val trigger : t -> unit + +val clear : t -> unit +(** Remove all callbacks. *) diff --git a/src/util/dune b/src/util/dune new file mode 100644 index 000000000..0d2df6b9c --- /dev/null +++ b/src/util/dune @@ -0,0 +1,11 @@ +(library + (name opentelemetry_util) + (public_name opentelemetry.util) + (flags :standard -open Opentelemetry_atomic) + (libraries + (re_export opentelemetry.atomic) + ptime + (re_export threads) + (re_export threads.posix) + opentelemetry.domain) + (synopsis "Basic utilities for opentelemetry")) diff --git a/src/util/timestamp_ns.ml b/src/util/timestamp_ns.ml new file mode 100644 index 000000000..89c08b5da --- /dev/null +++ b/src/util/timestamp_ns.ml @@ -0,0 +1,21 @@ +(** Unix timestamp. + + These timestamps measure time since the Unix epoch (jan 1, 1970) UTC in + nanoseconds. *) + +type t = int64 + +open struct + let ns_in_a_day = Int64.(mul 1_000_000_000L (of_int (24 * 3600))) +end + +let pp_debug out (self : t) = + let d = Int64.(to_int (div self ns_in_a_day)) in + let ns = Int64.(rem self ns_in_a_day) in + let ps = Int64.(mul ns 1_000L) in + match Ptime.Span.of_d_ps (d, ps) with + | None -> Format.fprintf out "ts: <%Ld ns>" self + | Some span -> + (match Ptime.add_span Ptime.epoch span with + | None -> Format.fprintf out "ts: <%Ld ns>" self + | Some ptime -> Ptime.pp_rfc3339 ~space:false ~frac_s:6 () out ptime) diff --git a/src/util/util_atomic.ml b/src/util/util_atomic.ml new file mode 100644 index 000000000..45dfef5c8 --- /dev/null +++ b/src/util/util_atomic.ml @@ -0,0 +1,18 @@ +module Atomic = Opentelemetry_atomic.Atomic + +(** Update loop *) +let update_cas (type res) (self : 'a Atomic.t) (f : 'a -> res * 'a) : res = + let exception Ret of res in + let backoff = ref 1 in + try + while true do + let old_val = Atomic.get self in + let res, new_val = f old_val in + if Atomic.compare_and_set self old_val new_val then + raise_notrace (Ret res); + + Opentelemetry_domain.relax_loop !backoff; + backoff := min 128 (2 * !backoff) + done; + assert false + with Ret r -> r diff --git a/src/util/util_bytes_.ml b/src/util/util_bytes_.ml new file mode 100644 index 000000000..91e65a52e --- /dev/null +++ b/src/util/util_bytes_.ml @@ -0,0 +1,49 @@ +open struct + let spf = Printf.sprintf +end + +let int_to_hex (i : int) = + if i < 10 then + Char.chr (i + Char.code '0') + else + Char.chr (i - 10 + Char.code 'a') + +let bytes_to_hex_into b res off : unit = + for i = 0 to Bytes.length b - 1 do + let n = Char.code (Bytes.get b i) in + Bytes.set res ((2 * i) + off) (int_to_hex ((n land 0xf0) lsr 4)); + Bytes.set res ((2 * i) + 1 + off) (int_to_hex (n land 0x0f)) + done + +let bytes_to_hex (b : bytes) : string = + let res = Bytes.create (2 * Bytes.length b) in + bytes_to_hex_into b res 0; + Bytes.unsafe_to_string res + +let int_of_hex = function + | '0' .. '9' as c -> Char.code c - Char.code '0' + | 'a' .. 'f' as c -> 10 + Char.code c - Char.code 'a' + | c -> raise (Invalid_argument (spf "invalid hex char: %C" c)) + +let bytes_of_hex_substring (s : string) off len = + if len mod 2 <> 0 then + raise (Invalid_argument "hex sequence must be of even length"); + let res = Bytes.make (len / 2) '\x00' in + for i = 0 to (len / 2) - 1 do + let n1 = int_of_hex (String.get s (off + (2 * i))) in + let n2 = int_of_hex (String.get s (off + (2 * i) + 1)) in + let n = (n1 lsl 4) lor n2 in + Bytes.set res i (Char.chr n) + done; + res + +let bytes_of_hex (s : string) : bytes = + bytes_of_hex_substring s 0 (String.length s) + +let bytes_non_zero (self : bytes) : bool = + try + for i = 0 to Bytes.length self - 1 do + if Char.code (Bytes.unsafe_get self i) <> 0 then raise_notrace Exit + done; + false + with Exit -> true diff --git a/src/core/util_mutex.ml b/src/util/util_mutex.ml similarity index 100% rename from src/core/util_mutex.ml rename to src/util/util_mutex.ml diff --git a/src/core/util_mutex.mli b/src/util/util_mutex.mli similarity index 100% rename from src/core/util_mutex.mli rename to src/util/util_mutex.mli diff --git a/tests/bin/cohttp_client.ml b/tests/bin/cohttp_client.ml index a45238475..e9bd71049 100644 --- a/tests/bin/cohttp_client.ml +++ b/tests/bin/cohttp_client.ml @@ -1,8 +1,6 @@ -module T = Opentelemetry +module OT = Opentelemetry module Otel_lwt = Opentelemetry_lwt -let spf = Printf.sprintf - let ( let@ ) f x = f x let sleep_inner = ref 0.1 @@ -10,19 +8,19 @@ let sleep_inner = ref 0.1 let sleep_outer = ref 2.0 let mk_client ~scope = - Opentelemetry_cohttp_lwt.client ~scope (module Cohttp_lwt_unix.Client) + Opentelemetry_cohttp_lwt.client ~span:scope (module Cohttp_lwt_unix.Client) let run () = let open Lwt.Syntax in let rec go () = let@ scope = - Otel_lwt.Trace.with_ ~kind:T.Span.Span_kind_producer "loop.outer" + Otel_lwt.Tracer.with_ ~kind:OT.Span.Span_kind_producer "loop.outer" in let* () = Lwt_unix.sleep !sleep_outer in let module C = (val mk_client ~scope) in (* Using the same default server O *) let* _res, body = - C.get (Uri.of_string Opentelemetry_client.Config.default_url) + C.get (Uri.of_string Opentelemetry_client.Http_config.default_url) in let* () = Cohttp_lwt.Body.drain_body body in go () @@ -31,8 +29,8 @@ let run () = let () = Sys.catch_break true; - T.Globals.service_name := "ocaml-otel-cohttp-client"; - T.Globals.service_namespace := Some "ocaml-otel.test"; + OT.Globals.service_name := "ocaml-otel-cohttp-client"; + OT.Globals.service_namespace := Some "ocaml-otel.test"; let debug = ref false in let batch_traces = ref 400 in @@ -60,8 +58,8 @@ let () = in let config = Opentelemetry_client_cohttp_lwt.Config.make ~debug:!debug - ~batch_traces:(some_if_nzero batch_traces) - ~batch_metrics:(some_if_nzero batch_metrics) + ?batch_traces:(some_if_nzero batch_traces) + ?batch_metrics:(some_if_nzero batch_metrics) () in Format.printf "@[<2>sleep outer: %.3fs,@ sleep inner: %.3fs,@ config: %a@]@." diff --git a/tests/bin/dune b/tests/bin/dune index 475f7c046..e98b0e8e2 100644 --- a/tests/bin/dune +++ b/tests/bin/dune @@ -3,10 +3,35 @@ (modules emit1) (libraries unix + threads opentelemetry - opentelemetry.client + opentelemetry-client opentelemetry-client-ocurl)) +(executable + (name emit1_ocurl_lwt) + (modules emit1_ocurl_lwt) + (preprocess + (pps lwt_ppx)) + (libraries + threads + lwt + lwt.unix + unix + opentelemetry + opentelemetry-client + opentelemetry-client-ocurl-lwt)) + +(executable + (name emit1_stdout) + (modules emit1_stdout) + (libraries + unix + threads + opentelemetry + opentelemetry-client + opentelemetry-client.sync)) + (executable (name emit1_cohttp) (modules emit1_cohttp) @@ -14,9 +39,10 @@ (pps lwt_ppx)) (libraries unix + threads opentelemetry opentelemetry-lwt - opentelemetry.client + opentelemetry-client opentelemetry-client-cohttp-lwt lwt.unix)) @@ -32,7 +58,8 @@ logs.fmt logs.threaded opentelemetry - opentelemetry.client + opentelemetry-lwt + opentelemetry-client opentelemetry-client-cohttp-eio)) (executable @@ -42,17 +69,24 @@ (pps lwt_ppx)) (libraries cohttp-lwt-unix - opentelemetry + opentelemetry-lwt opentelemetry-client-cohttp-lwt opentelemetry-cohttp-lwt opentelemetry-logs - logs)) + logs + unix + lwt.unix + logs.fmt)) (executable (name cohttp_client) (modules cohttp_client) (libraries cohttp-lwt-unix + lwt + lwt.unix + unix + uri opentelemetry opentelemetry-client-cohttp-lwt opentelemetry-cohttp-lwt)) diff --git a/tests/bin/emit1.ml b/tests/bin/emit1.ml index 95a4d55b0..4dbdac006 100644 --- a/tests/bin/emit1.ml +++ b/tests/bin/emit1.ml @@ -1,8 +1,6 @@ -module T = Opentelemetry +module OT = Opentelemetry module Atomic = Opentelemetry_atomic.Atomic -let spf = Printf.sprintf - let ( let@ ) = ( @@ ) let sleep_inner = ref 0.1 @@ -11,85 +9,97 @@ let sleep_outer = ref 2.0 let n_jobs = ref 1 +let iterations = ref 4 + let n = ref max_int let num_sleep = Atomic.make 0 let stress_alloc_ = ref true -let stop = Atomic.make false - let num_tr = Atomic.make 0 let run_job () = - let@ () = Fun.protect ~finally:(fun () -> Atomic.set stop true) in + let active = OT.Sdk.active () in let i = ref 0 in let cnt = ref 0 in - while (not @@ Atomic.get stop) && !cnt < !n do + while OT.Aswitch.is_on active && !cnt < !n do let@ _scope = Atomic.incr num_tr; - T.Trace.with_ ~kind:T.Span.Span_kind_producer "loop.outer" + OT.Tracer.with_ ~kind:OT.Span.Span_kind_producer "loop.outer" ~attrs:[ "i", `Int !i ] in (* Printf.printf "cnt=%d\n%!" !cnt; *) incr cnt; - for j = 0 to 4 do + for j = 1 to !iterations do (* parent scope is found via thread local storage *) let@ scope = Atomic.incr num_tr; - T.Trace.with_ ~kind:T.Span.Span_kind_internal + OT.Tracer.with_ ~kind:OT.Span.Span_kind_internal ~parent:_scope ~attrs:[ "j", `Int j ] "loop.inner" in - Unix.sleepf !sleep_outer; - Atomic.incr num_sleep; + if !sleep_outer > 0. then ( + Unix.sleepf !sleep_outer; + Atomic.incr num_sleep + ); - T.Logs.( - emit - [ - make_strf ~trace_id:scope.trace_id ~span_id:scope.span_id - ~severity:Severity_number_info "inner at %d" j; - ]); + OT.Logger.logf ~trace_id:(OT.Span.trace_id scope) + ~span_id:(OT.Span.id scope) ~severity:Severity_number_info (fun k -> + k "inner at %d" j); incr i; try - Atomic.incr num_tr; - let@ _ = T.Trace.with_ ~kind:T.Span.Span_kind_internal ~scope "alloc" in (* allocate some stuff *) if !stress_alloc_ then ( - let _arr = Sys.opaque_identity @@ Array.make (25 * 25551) 42.0 in - ignore _arr + let@ _ = + OT.Tracer.with_ ~kind:OT.Span.Span_kind_internal ~parent:scope + "alloc" + in + Atomic.incr num_tr; + + let _arr : _ array = + Sys.opaque_identity @@ Array.make (25 * 25551) 42.0 + in + ignore _arr; + + OT.Span.add_event scope (OT.Event.make "done with alloc") ); - Unix.sleepf !sleep_inner; - Atomic.incr num_sleep; - - if j = 4 && !i mod 13 = 0 then failwith "oh no"; + if !sleep_inner > 0. then ( + Unix.sleepf !sleep_inner; + Atomic.incr num_sleep + ); (* simulate a failure *) - Opentelemetry.Scope.add_event scope (fun () -> - T.Event.make "done with alloc") + if j = 4 && !i mod 13 = 0 then failwith "oh no" with Failure _ -> () done - done + done; + + (* Printf.eprintf "emit1.run_job: exit\n%!"; *) + () let run () = - T.GC_metrics.basic_setup (); + OT.Gc_metrics.setup (); - T.Metrics_callbacks.register (fun () -> - T.Metrics. + OT.Meter.add_cb (fun ~clock:_ () -> OT.Sdk.self_metrics ()); + OT.Meter.add_cb (fun ~clock () -> + let now = OT.Clock.now clock in + OT.Metrics. [ sum ~name:"num-sleep" ~is_monotonic:true - [ int (Atomic.get num_sleep) ]; + [ int ~now (Atomic.get num_sleep) ]; ]); + OT.Meter.add_to_main_exporter OT.Meter.default; let n_jobs = max 1 !n_jobs in - Printf.printf "run %d jobs\n%!" n_jobs; + Printf.printf "run %d job(s)\n%!" n_jobs; let jobs = Array.init n_jobs (fun _ -> @@ -99,8 +109,8 @@ let run () = Array.iter Thread.join jobs let () = - T.Globals.service_name := "t1"; - T.Globals.service_namespace := Some "ocaml-otel.test"; + OT.Globals.service_name := "t1"; + OT.Globals.service_namespace := Some "ocaml-otel.test"; let ts_start = Unix.gettimeofday () in let debug = ref false in @@ -108,8 +118,12 @@ let () = let batch_traces = ref 400 in let batch_metrics = ref 3 in let batch_logs = ref 400 in + let self_trace = ref true in + let final_stats = ref false in let n_bg_threads = ref 0 in + let url = ref None in + let n_procs = ref 1 in let opts = [ "--debug", Arg.Bool (( := ) debug), " enable debug output"; @@ -125,13 +139,27 @@ let () = "--sleep-outer", Arg.Set_float sleep_outer, " sleep (in s) in outer loop"; "-j", Arg.Set_int n_jobs, " number of parallel jobs"; "--bg-threads", Arg.Set_int n_bg_threads, " number of background threads"; - "-n", Arg.Set_int n, " number of iterations (default ∞)"; + "--no-self-trace", Arg.Clear self_trace, " disable self tracing"; + "-n", Arg.Set_int n, " number of outer iterations (default ∞)"; + ( "--iterations", + Arg.Set_int iterations, + " the number of inner iterations to run" ); + ( "--url", + Arg.String (fun s -> url := Some s), + " set the url for the OTel collector" ); + "--final-stats", Arg.Set final_stats, " display some metrics at the end"; + "--procs", Arg.Set_int n_procs, " number of processes (stub)"; ] |> Arg.align in Arg.parse opts (fun _ -> ()) "emit1 [opt]*"; + if !n_procs > 1 then + failwith + "TODO: add support for running multiple processes to the lwt-cohttp \ + emitter"; + let some_if_nzero r = if !r > 0 then Some !r @@ -139,20 +167,32 @@ let () = None in let config = - Opentelemetry_client_ocurl.Config.make ~debug:!debug ~self_trace:true + Opentelemetry_client_ocurl.Config.make ~debug:!debug ~self_trace:!self_trace + ?url:!url ?bg_threads:(some_if_nzero n_bg_threads) - ~batch_traces:(some_if_nzero batch_traces) - ~batch_metrics:(some_if_nzero batch_metrics) - ~batch_logs:(some_if_nzero batch_logs) () + ?batch_traces:(some_if_nzero batch_traces) + ?batch_metrics:(some_if_nzero batch_metrics) + ?batch_logs:(some_if_nzero batch_logs) () in Format.printf "@[<2>sleep outer: %.3fs,@ sleep inner: %.3fs,@ config: %a@]@." !sleep_outer !sleep_inner Opentelemetry_client_ocurl.Config.pp config; - let@ () = - Fun.protect ~finally:(fun () -> - let elapsed = Unix.gettimeofday () -. ts_start in - let n_per_sec = float (Atomic.get num_tr) /. elapsed in - Printf.printf "\ndone. %d spans in %.4fs (%.4f/s)\n%!" - (Atomic.get num_tr) elapsed n_per_sec) + let finally () = + let elapsed = Unix.gettimeofday () -. ts_start in + let n_per_sec = float (Atomic.get num_tr) /. elapsed in + Printf.printf "\ndone. %d spans in %.4fs (%.4f/s)\n%!" (Atomic.get num_tr) + elapsed n_per_sec in - Opentelemetry_client_ocurl.with_setup ~stop ~config () run + let after_exp_shutdown exp = + (* print some stats *) + if !final_stats then ( + let ms = OT.Exporter.self_metrics exp in + Format.eprintf "@[exporter metrics:@ %a@]@." + (Format.pp_print_list Opentelemetry.Metrics.pp) + ms + ) + in + + let@ () = Fun.protect ~finally in + Opentelemetry_client_ocurl.with_setup ~config () run + ~after_shutdown:after_exp_shutdown diff --git a/tests/bin/emit1_cohttp.ml b/tests/bin/emit1_cohttp.ml index 14f657cd2..5de2c615f 100644 --- a/tests/bin/emit1_cohttp.ml +++ b/tests/bin/emit1_cohttp.ml @@ -2,8 +2,6 @@ module T = Opentelemetry_lwt module Atomic = Opentelemetry_atomic.Atomic open Lwt.Syntax -let spf = Printf.sprintf - let ( let@ ) f x = f x let sleep_inner = ref 0.1 @@ -12,90 +10,92 @@ let sleep_outer = ref 2.0 let n_jobs = ref 1 +let n = ref max_int + let iterations = ref 1 let num_sleep = Atomic.make 0 let stress_alloc_ = ref true -let stop = Atomic.make false - let num_tr = Atomic.make 0 -(* Counter used to mark simulated failures *) -let i = ref 0 - let run_job job_id : unit Lwt.t = - while%lwt not @@ Atomic.get stop do + let i = ref 0 in + while%lwt T.Aswitch.is_on (T.Sdk.active ()) && !i < !n do + (* Printf.eprintf "test: run outer loop job_id=%d i=%d\n%!" job_id !i; *) let@ scope = Atomic.incr num_tr; - T.Trace.with_ ~kind:T.Span.Span_kind_producer "loop.outer" - ~attrs:[ "i", `Int job_id ] + T.Tracer.with_ ~kind:T.Span.Span_kind_producer "loop.outer" + ~attrs:[ "i", `Int !i; "job_id", `Int job_id ] in - for%lwt j = 0 to !iterations do - if j >= !iterations then - (* Terminate program, having reached our max iterations *) - Lwt.return @@ Atomic.set stop true - else - (* parent scope is found via thread local storage *) - let@ scope = - Atomic.incr num_tr; - T.Trace.with_ ~scope ~kind:T.Span.Span_kind_internal - ~attrs:[ "j", `Int j ] - "loop.inner" - in - - let* () = Lwt_unix.sleep !sleep_outer in - Atomic.incr num_sleep; - - T.Logs.( - emit - [ - make_strf ~trace_id:scope.trace_id ~span_id:scope.span_id - ~severity:Severity_number_info "inner at %d" j; - ]); - - incr i; - - try%lwt - Atomic.incr num_tr; - let@ scope = - T.Trace.with_ ~kind:T.Span.Span_kind_internal ~scope "alloc" - in - (* allocate some stuff *) + incr i; + + for%lwt j = 1 to !iterations do + (* parent scope is found via thread local storage *) + (* Printf.eprintf "test: run inner loop job_id=%d i=%d j=%d\n%!" job_id !i j; *) + let@ span = + Atomic.incr num_tr; + T.Tracer.with_ ~parent:scope ~kind:T.Span.Span_kind_internal + ~attrs:[ "j", `Int j ] + "loop.inner" + in + + let* () = Lwt_unix.sleep !sleep_outer in + Atomic.incr num_sleep; + + T.Logger.logf ~trace_id:(T.Span.trace_id span) ~span_id:(T.Span.id span) + ~severity:Severity_number_info (fun k -> k "inner at %d" j); + try%lwt + Atomic.incr num_tr; + (* allocate some stuff *) + let%lwt () = if !stress_alloc_ then ( + let@ scope = + T.Tracer.with_ ~kind:T.Span.Span_kind_internal ~parent:span + "alloc" + in let _arr = Sys.opaque_identity @@ Array.make (25 * 25551) 42.0 in - ignore _arr - ); - - let* () = Lwt_unix.sleep !sleep_inner in - Atomic.incr num_sleep; + ignore _arr; + T.Span.add_event scope (T.Event.make "done with alloc"); + Lwt.return () + ) else + Lwt.return () + in - (* simulate a failure *) - if j = 4 && !i mod 13 = 0 then failwith "oh no"; + let* () = Lwt_unix.sleep !sleep_inner in + Atomic.incr num_sleep; - Opentelemetry.Scope.add_event scope (fun () -> - T.Event.make "done with alloc"); + (* simulate a failure *) + if j = 4 && !i mod 13 = 0 then + Lwt.fail (Failure "oh no") + else Lwt.return () - with Failure _ -> Lwt.return () + with Failure _ -> Lwt.return () done done +(* >>= fun () -> + Printf.eprintf "test: job done\n%!"; + Lwt.return ()*) let run () : unit Lwt.t = - T.GC_metrics.basic_setup (); + T.Gc_metrics.setup (); - T.Metrics_callbacks.register (fun () -> + T.Meter.add_cb (fun ~clock () -> + let now = T.Clock.now clock in T.Metrics. [ sum ~name:"num-sleep" ~is_monotonic:true - [ int (Atomic.get num_sleep) ]; + [ int ~now (Atomic.get num_sleep) ]; ]); + T.Meter.add_to_main_exporter T.Meter.default; let n_jobs = max 1 !n_jobs in - Printf.printf "run %d jobs\n%!" n_jobs; + (* Printf.printf "run %d jobs\n%!" n_jobs; *) let jobs = List.init n_jobs run_job in + (* Printf.eprintf "test: joining jobs\n%!"; *) Lwt.join jobs let () = @@ -108,6 +108,7 @@ let () = let batch_traces = ref 400 in let batch_metrics = ref 3 in let batch_logs = ref 400 in + let self_trace = ref true in let url = ref None in let n_procs = ref 1 in let opts = @@ -126,9 +127,13 @@ let () = "--batch-logs", Arg.Int (( := ) batch_logs), " size of logs batch"; "--sleep-inner", Arg.Set_float sleep_inner, " sleep (in s) in inner loop"; "--sleep-outer", Arg.Set_float sleep_outer, " sleep (in s) in outer loop"; - "--iterations", Arg.Set_int iterations, " the number of iterations to run"; + ( "--iterations", + Arg.Set_int iterations, + " the number of inner iterations to run" ); "-j", Arg.Set_int n_jobs, " number of parallel jobs"; - "--procs", Arg.Set_int n_procs, " number of processes"; + "-n", Arg.Set_int n, " number of outer iterations (default ∞)"; + "--self-trace", Arg.Bool (( := ) self_trace), " self tracing"; + "--procs", Arg.Set_int n_procs, " number of processes (stub)"; ] |> Arg.align in @@ -148,9 +153,10 @@ let () = in let config = Opentelemetry_client_cohttp_lwt.Config.make ~debug:!debug ?url:!url - ~batch_traces:(some_if_nzero batch_traces) - ~batch_metrics:(some_if_nzero batch_metrics) - ~batch_logs:(some_if_nzero batch_logs) () + ~self_trace:!self_trace + ?batch_traces:(some_if_nzero batch_traces) + ?batch_metrics:(some_if_nzero batch_metrics) + ?batch_logs:(some_if_nzero batch_logs) () in Format.printf "@[<2>sleep outer: %.3fs,@ sleep inner: %.3fs,@ config: %a@]@." !sleep_outer !sleep_inner Opentelemetry_client_cohttp_lwt.Config.pp config; @@ -162,5 +168,4 @@ let () = Printf.printf "\ndone. %d spans in %.4fs (%.4f/s)\n%!" (Atomic.get num_tr) elapsed n_per_sec) in - Opentelemetry_client_cohttp_lwt.with_setup ~stop ~config () run - |> Lwt_main.run + Opentelemetry_client_cohttp_lwt.with_setup ~config () run |> Lwt_main.run diff --git a/tests/bin/emit1_eio.ml b/tests/bin/emit1_eio.ml index 9990b227a..40efe1df1 100644 --- a/tests/bin/emit1_eio.ml +++ b/tests/bin/emit1_eio.ml @@ -1,8 +1,6 @@ module OT = Opentelemetry module Atomic = Opentelemetry_atomic.Atomic -let spf = Printf.sprintf - let ( let@ ) f x = f x let sleep_inner = ref 0.1 @@ -15,29 +13,26 @@ let stress_alloc_ = ref true let num_sleep = Atomic.make 0 -let stop = Atomic.make false - let num_tr = Atomic.make 0 -(* Counter used to mark simulated failures *) -let i = Atomic.make 0 +let n = ref max_int let run_job clock _job_id iterations : unit = - let@ scope = - Atomic.incr num_tr; - OT.Trace.with_ ~kind:OT.Span.Span_kind_producer "loop.outer" - ~attrs:[ "i", `Int (Atomic.get i) ] - in + let i = ref 0 in + while OT.Aswitch.is_on (OT.Sdk.active ()) && !i < !n do + let@ scope = + Atomic.incr num_tr; + OT.Tracer.with_ ~kind:OT.Span.Span_kind_producer "loop.outer" + ~attrs:[ "i", `Int !i ] + in - for j = 0 to iterations do - if j >= iterations then - (* Terminate program, having reached our max iterations *) - Atomic.set stop true - else + incr i; + + for j = 1 to iterations do (* parent scope is found via thread local storage *) let@ scope = Atomic.incr num_tr; - OT.Trace.with_ ~scope ~kind:OT.Span.Span_kind_internal + OT.Tracer.with_ ~parent:scope ~kind:OT.Span.Span_kind_internal ~attrs:[ "j", `Int j ] "loop.inner" in @@ -45,19 +40,14 @@ let run_job clock _job_id iterations : unit = let () = Eio.Time.sleep clock !sleep_outer in Atomic.incr num_sleep; - OT.Logs.( - emit - [ - make_strf ~trace_id:scope.trace_id ~span_id:scope.span_id - ~severity:Severity_number_info "inner at %d" j; - ]); - - Atomic.incr i; + OT.Logger.logf ~trace_id:(OT.Span.trace_id scope) + ~span_id:(OT.Span.id scope) ~severity:Severity_number_info (fun k -> + k "inner at %d" j); try Atomic.incr num_tr; let@ scope = - OT.Trace.with_ ~kind:OT.Span.Span_kind_internal ~scope "alloc" + OT.Tracer.with_ ~kind:OT.Span.Span_kind_internal ~parent:scope "alloc" in (* allocate some stuff *) if !stress_alloc_ then ( @@ -68,23 +58,27 @@ let run_job clock _job_id iterations : unit = let () = Eio.Time.sleep clock !sleep_inner in Atomic.incr num_sleep; - if j = 4 && Atomic.get i mod 13 = 0 then failwith "oh no"; + if j = 4 && !i mod 13 = 0 then failwith "oh no"; (* simulate a failure *) - Opentelemetry.Scope.add_event scope (fun () -> - OT.Event.make "done with alloc") + OT.Span.add_event scope (OT.Event.make "done with alloc") with Failure _ -> () + done done let run env proc iterations () : unit = - OT.GC_metrics.basic_setup (); + OT.Gc_metrics.setup (); - OT.Metrics_callbacks.register (fun () -> + OT.Meter.add_cb (fun ~clock () -> + let now = OT.Clock.now clock in OT.Metrics. [ sum ~name:"num-sleep" ~is_monotonic:true - [ int (Atomic.get num_sleep) ]; + [ int ~now (Atomic.get num_sleep) ]; ]); + OT.Meter.add_to_main_exporter + ~min_interval:Mtime.Span.(10 * ms) + OT.Meter.default; let n_jobs = max 1 !n_jobs in Printf.printf "run %d jobs in proc %d\n%!" n_jobs proc; @@ -127,6 +121,7 @@ let () = Arg.Set_int n_iterations, " the number of iterations to run" ); "-j", Arg.Set_int n_jobs, " number of jobs per processes"; + "-n", Arg.Set_int n, " number of iterations (default ∞)"; "--procs", Arg.Set_int n_procs, " number of processes"; ] |> Arg.align @@ -142,9 +137,9 @@ let () = in let config = Opentelemetry_client_cohttp_eio.Config.make ~debug:!debug ?url:!url - ~batch_traces:(some_if_nzero batch_traces) - ~batch_metrics:(some_if_nzero batch_metrics) - ~batch_logs:(some_if_nzero batch_logs) () + ?batch_traces:(some_if_nzero batch_traces) + ?batch_metrics:(some_if_nzero batch_metrics) + ?batch_logs:(some_if_nzero batch_logs) () in Format.printf "@[<2>sleep outer: %.3fs,@ sleep inner: %.3fs,@ config: %a@]@." !sleep_outer !sleep_inner Opentelemetry_client_cohttp_eio.Config.pp config; @@ -157,16 +152,14 @@ let () = (Atomic.get num_tr) elapsed n_per_sec) in Eio_main.run @@ fun env -> - (if !n_procs < 2 then - Opentelemetry_client_cohttp_eio.with_setup ~stop ~config - (run env 0 !n_iterations) env - else - Eio.Switch.run @@ fun sw -> - Opentelemetry_client_cohttp_eio.setup ~stop ~config ~sw env; - let dm = Eio.Stdenv.domain_mgr env in - Eio.Switch.run (fun sw -> - for proc = 1 to !n_procs do - Eio.Fiber.fork ~sw @@ fun () -> - Eio.Domain_manager.run dm (run env proc !n_iterations) - done)); - Opentelemetry.Collector.remove_backend () ~on_done:ignore + if !n_procs < 2 then + Opentelemetry_client_cohttp_eio.with_setup ~config env + (run env 0 !n_iterations) + else + Opentelemetry_client_cohttp_eio.with_setup ~config env @@ fun () -> + let dm = Eio.Stdenv.domain_mgr env in + Eio.Switch.run (fun sw -> + for proc = 1 to !n_procs do + Eio.Fiber.fork ~sw @@ fun () -> + Eio.Domain_manager.run dm (run env proc !n_iterations) + done) diff --git a/tests/bin/emit1_ocurl_lwt.ml b/tests/bin/emit1_ocurl_lwt.ml new file mode 100644 index 000000000..0bccb3c1a --- /dev/null +++ b/tests/bin/emit1_ocurl_lwt.ml @@ -0,0 +1,195 @@ +module OT = Opentelemetry +module Atomic = Opentelemetry_atomic.Atomic + +let ( let@ ) = ( @@ ) + +let sleep_inner = ref 0.1 + +let sleep_outer = ref 2.0 + +let n_jobs = ref 1 + +let iterations = ref 4 + +let n = ref max_int + +let num_sleep = Atomic.make 0 + +let stress_alloc_ = ref true + +let num_tr = Atomic.make 0 + +let run_job () : unit Lwt.t = + let active = OT.Sdk.active () in + let i = ref 0 in + let cnt = ref 0 in + + while%lwt OT.Aswitch.is_on active && !cnt < !n do + let@ _scope = + Atomic.incr num_tr; + OT.Tracer.with_ ~kind:OT.Span.Span_kind_producer "loop.outer" + ~attrs:[ "i", `Int !i ] + in + + (* Printf.printf "cnt=%d\n%!" !cnt; *) + incr cnt; + + for%lwt j = 1 to !iterations do + (* parent scope is found via thread local storage *) + let@ span = + Atomic.incr num_tr; + OT.Tracer.with_ ~kind:OT.Span.Span_kind_internal ~parent:_scope + ~attrs:[ "j", `Int j ] + "loop.inner" + in + + if !sleep_outer > 0. then ( + Unix.sleepf !sleep_outer; + Atomic.incr num_sleep + ); + + OT.Logger.logf ~trace_id:(OT.Span.trace_id span) + ~span_id:(OT.Span.id span) ~severity:Severity_number_info (fun k -> + k "inner at %d" j); + try%lwt + Atomic.incr num_tr; + (* allocate some stuff *) + let%lwt () = + if !stress_alloc_ then ( + let@ scope = + OT.Tracer.with_ ~kind:OT.Span.Span_kind_internal ~parent:span + "alloc" + in + let _arr = Sys.opaque_identity @@ Array.make (25 * 25551) 42.0 in + ignore _arr; + OT.Span.add_event scope (OT.Event.make "done with alloc"); + Lwt.return () + ) else + Lwt.return () + in + + let%lwt () = Lwt_unix.sleep !sleep_inner in + Atomic.incr num_sleep; + + (* simulate a failure *) + if j = 4 && !i mod 13 = 0 then + Lwt.fail (Failure "oh no") + else + Lwt.return () + with Failure _ -> Lwt.return () + done + done +(* >>= fun () -> + Printf.eprintf "test: job done\n%!"; + Lwt.return ()*) + +let run () : unit Lwt.t = + OT.Gc_metrics.setup (); + + OT.Meter.add_cb (fun ~clock:_ () -> OT.Sdk.self_metrics ()); + OT.Meter.add_cb (fun ~clock () -> + let now = OT.Clock.now clock in + OT.Metrics. + [ + sum ~name:"num-sleep" ~is_monotonic:true + [ int ~now (Atomic.get num_sleep) ]; + ]); + OT.Meter.add_to_main_exporter OT.Meter.default; + + let n_jobs = max 1 !n_jobs in + Printf.printf "run %d job(s)\n%!" n_jobs; + + let jobs = + List.init n_jobs (fun _ -> try run_job () with Sys.Break -> Lwt.return ()) + in + Lwt.join jobs + +let () = + OT.Globals.service_name := "t1"; + OT.Globals.service_namespace := Some "ocaml-otel.test"; + let ts_start = Unix.gettimeofday () in + + let debug = ref false in + + let batch_traces = ref 400 in + let batch_metrics = ref 3 in + let batch_logs = ref 400 in + let self_trace = ref true in + let final_stats = ref false in + + let n_bg_threads = ref 0 in + let url = ref None in + let n_procs = ref 1 in + let opts = + [ + "--debug", Arg.Bool (( := ) debug), " enable debug output"; + ( "--stress-alloc", + Arg.Bool (( := ) stress_alloc_), + " perform heavy allocs in inner loop" ); + ( "--batch-metrics", + Arg.Int (( := ) batch_metrics), + " size of metrics batch" ); + "--batch-traces", Arg.Int (( := ) batch_traces), " size of traces batch"; + "--batch-logs", Arg.Int (( := ) batch_logs), " size of logs batch"; + "--sleep-inner", Arg.Set_float sleep_inner, " sleep (in s) in inner loop"; + "--sleep-outer", Arg.Set_float sleep_outer, " sleep (in s) in outer loop"; + "-j", Arg.Set_int n_jobs, " number of parallel jobs"; + "--bg-threads", Arg.Set_int n_bg_threads, " number of background threads"; + "--no-self-trace", Arg.Clear self_trace, " disable self tracing"; + "-n", Arg.Set_int n, " number of iterations (default ∞)"; + ( "--iterations", + Arg.Set_int iterations, + " the number of inner iterations to run" ); + ( "--url", + Arg.String (fun s -> url := Some s), + " set the url for the OTel collector" ); + "--final-stats", Arg.Set final_stats, " display some metrics at the end"; + "--procs", Arg.Set_int n_procs, " number of processes (stub)"; + ] + |> Arg.align + in + + Arg.parse opts (fun _ -> ()) "emit1 [opt]*"; + + if !n_procs > 1 then + failwith + "TODO: add support for running multiple processes to the lwt-cohttp \ + emitter"; + + let some_if_nzero r = + if !r > 0 then + Some !r + else + None + in + let config = + Opentelemetry_client_ocurl_lwt.Config.make ~debug:!debug + ~self_trace:!self_trace ?url:!url + ?http_concurrency_level:(some_if_nzero n_bg_threads) + ?batch_traces:(some_if_nzero batch_traces) + ?batch_metrics:(some_if_nzero batch_metrics) + ?batch_logs:(some_if_nzero batch_logs) () + in + Format.printf "@[<2>sleep outer: %.3fs,@ sleep inner: %.3fs,@ config: %a@]@." + !sleep_outer !sleep_inner Opentelemetry_client_ocurl_lwt.Config.pp config; + + let finally () = + let elapsed = Unix.gettimeofday () -. ts_start in + let n_per_sec = float (Atomic.get num_tr) /. elapsed in + Printf.printf "\ndone. %d spans in %.4fs (%.4f/s)\n%!" (Atomic.get num_tr) + elapsed n_per_sec + in + let after_exp_shutdown exp = + (* print some stats *) + if !final_stats then ( + let ms = OT.Exporter.self_metrics exp in + Format.eprintf "@[exporter metrics:@ %a@]@." + (Format.pp_print_list Opentelemetry.Metrics.pp) + ms + ) + in + + let@ () = Fun.protect ~finally in + Lwt_main.run + (Opentelemetry_client_ocurl_lwt.with_setup ~config () run + ~after_shutdown:after_exp_shutdown) diff --git a/tests/bin/emit1_stdout.ml b/tests/bin/emit1_stdout.ml new file mode 100644 index 000000000..df11f6768 --- /dev/null +++ b/tests/bin/emit1_stdout.ml @@ -0,0 +1,186 @@ +module OT = Opentelemetry +module OTC = Opentelemetry_client + +let ( let@ ) = ( @@ ) + +let sleep_inner = ref 0.1 + +let sleep_outer = ref 2.0 + +let n_jobs = ref 1 + +let iterations = ref 4 + +let n = ref max_int + +let num_sleep = Atomic.make 0 + +let stress_alloc_ = ref true + +let num_tr = Atomic.make 0 + +let run_job () = + let active = OT.Sdk.active () in + let i = ref 0 in + let cnt = ref 0 in + + while OT.Aswitch.is_on active && !cnt < !n do + let@ _scope = + Atomic.incr num_tr; + OT.Tracer.with_ ~kind:OT.Span.Span_kind_producer "loop.outer" + ~attrs:[ "i", `Int !i ] + in + + (* Printf.printf "cnt=%d\n%!" !cnt; *) + incr cnt; + + for j = 1 to !iterations do + (* parent scope is found via thread local storage *) + let@ scope = + Atomic.incr num_tr; + OT.Tracer.with_ ~kind:OT.Span.Span_kind_internal ~parent:_scope + ~attrs:[ "j", `Int j ] + "loop.inner" + in + + if !sleep_outer > 0. then ( + Unix.sleepf !sleep_outer; + Atomic.incr num_sleep + ); + + OT.Logger.logf ~trace_id:(OT.Span.trace_id scope) + ~span_id:(OT.Span.id scope) ~severity:Severity_number_info (fun k -> + k "inner at %d" j); + + incr i; + + try + Atomic.incr num_tr; + (* allocate some stuff *) + (if !stress_alloc_ then + let@ _ = + OT.Tracer.with_ ~kind:OT.Span.Span_kind_internal ~parent:scope + "alloc" + in + let _arr : _ array = + Sys.opaque_identity @@ Array.make (25 * 25551) 42.0 + in + ignore _arr); + + if !sleep_inner > 0. then ( + Unix.sleepf !sleep_inner; + Atomic.incr num_sleep + ); + + if j = 4 && !i mod 13 = 0 then failwith "oh no"; + + (* simulate a failure *) + OT.Span.add_event scope (OT.Event.make "done with alloc") + with Failure _ -> () + done + done; + (* Printf.eprintf "emit1.run_job: exit\n%!"; *) + () + +let run () = + OT.Gc_metrics.setup (); + + OT.Meter.add_cb (fun ~clock () -> + let now = OT.Clock.now clock in + OT.Metrics. + [ + sum ~name:"num-sleep" ~is_monotonic:true + [ int ~now (Atomic.get num_sleep) ]; + ]); + OT.Meter.add_to_main_exporter OT.Meter.default; + + let n_jobs = max 1 !n_jobs in + Printf.printf "run %d job(s)\n%!" n_jobs; + + let jobs = + Array.init n_jobs (fun _ -> + let job () = try run_job () with Sys.Break -> () in + Thread.create job ()) + in + Array.iter Thread.join jobs + +module Consumer_exporter = + OTC.Generic_consumer_exporter.Make + (Opentelemetry_client_sync.Io_sync) + (Opentelemetry_client_sync.Notifier_sync) + +let () = + OT.Globals.service_name := "t1"; + OT.Globals.service_namespace := Some "ocaml-otel.test"; + let ts_start = Unix.gettimeofday () in + + let debug = ref false in + + let batch_traces = ref 400 in + let batch_metrics = ref 3 in + let batch_logs = ref 400 in + let queued = ref false in + let self_trace = ref true in + + let n_bg_threads = ref 0 in + let opts = + [ + "--debug", Arg.Bool (( := ) debug), " enable debug output"; + ( "--stress-alloc", + Arg.Bool (( := ) stress_alloc_), + " perform heavy allocs in inner loop" ); + ( "--batch-metrics", + Arg.Int (( := ) batch_metrics), + " size of metrics batch" ); + "--batch-traces", Arg.Int (( := ) batch_traces), " size of traces batch"; + "--batch-logs", Arg.Int (( := ) batch_logs), " size of logs batch"; + "--sleep-inner", Arg.Set_float sleep_inner, " sleep (in s) in inner loop"; + "--sleep-outer", Arg.Set_float sleep_outer, " sleep (in s) in outer loop"; + "-j", Arg.Set_int n_jobs, " number of parallel jobs"; + "--bg-threads", Arg.Set_int n_bg_threads, " number of background threads"; + "--no-self-trace", Arg.Clear self_trace, " disable self tracing"; + "-n", Arg.Set_int n, " number of outer iterations (default ∞)"; + ( "--iterations", + Arg.Set_int iterations, + " the number of inner iterations to run" ); + "--queued", Arg.Set queued, " queue exporter"; + ] + |> Arg.align + in + + Arg.parse opts (fun _ -> ()) "emit1 [opt]*"; + + Format.printf "@[<2>sleep outer: %.3fs,@ sleep inner: %.3fs,@ queued: %b@]@." + !sleep_outer !sleep_inner !queued; + + let exporter, finally = + let exp = OTC.Exporter_stdout.stdout () in + if !queued then ( + let q = + Opentelemetry_client_sync.Bounded_queue_sync.create + ~high_watermark:20_000 () + in + let exp = + OTC.Exporter_queued.create ~clock:OT.Clock.ptime_clock ~q + ~consumer:(Consumer_exporter.consumer exp) + () + in + let finally () = Opentelemetry_client_sync.Shutdown_sync.shutdown exp in + exp, finally + ) else + exp, ignore + in + + OT.Sdk.set exporter; + let@ () = Fun.protect ~finally in + + if !self_trace then Opentelemetry_client.Self_trace.set_enabled true; + + let@ () = + Fun.protect ~finally:(fun () -> + let elapsed = Unix.gettimeofday () -. ts_start in + let n_per_sec = float (Atomic.get num_tr) /. elapsed in + Printf.printf "\ndone. %d spans in %.4fs (%.4f/s)\n%!" + (Atomic.get num_tr) elapsed n_per_sec) + in + run () diff --git a/tests/bin/emit_logs_cohttp.ml b/tests/bin/emit_logs_cohttp.ml index acd846e36..62f045077 100644 --- a/tests/bin/emit_logs_cohttp.ml +++ b/tests/bin/emit_logs_cohttp.ml @@ -22,8 +22,9 @@ let varied_tag_set = |> add string_list_tag [ "foo"; "bar"; "baz" ]) let run () = + Opentelemetry.Globals.service_name := "emit_logs"; let otel_reporter = - Opentelemetry_logs.otel_reporter ~service_name:"emit_logs" + Opentelemetry_logs.otel_reporter ~attributes:[ "my_reporter_attr", `String "foo" ] () in @@ -35,7 +36,7 @@ let run () = Logs.err (fun m -> m "emit_logs: error log"); Logs.app (fun m -> m "emit_logs: app log"); let%lwt () = - T.Trace.with_ ~kind:T.Span.Span_kind_producer "my_scope" (fun _scope -> + T.Tracer.with_ ~kind:T.Span.Span_kind_producer "my_scope" (fun _scope -> Logs.info (fun m -> m ~tags:varied_tag_set "emit_logs: this log is emitted with varied tags from a span"); @@ -50,7 +51,8 @@ let run () = let fmt_logger = Logs_fmt.reporter ~dst:Format.err_formatter () in let combined_logger = - Opentelemetry_logs.attach_otel_reporter ~service_name:"emit_logs_fmt" + Opentelemetry_logs.attach_otel_reporter + (* FIXME ~service_name:"emit_logs_fmt" *) ~attributes:[ "my_fmt_attr", `String "bar" ] fmt_logger in @@ -93,9 +95,9 @@ let () = in let config = Opentelemetry_client_cohttp_lwt.Config.make ~debug:!debug ?url:!url - ~batch_traces:(some_if_nzero batch_traces) - ~batch_metrics:(some_if_nzero batch_metrics) - ~batch_logs:(some_if_nzero batch_logs) () + ?batch_traces:(some_if_nzero batch_traces) + ?batch_metrics:(some_if_nzero batch_metrics) + ?batch_logs:(some_if_nzero batch_logs) () in Format.printf "@[@ config: %a@]@." Opentelemetry_client_cohttp_lwt.Config.pp config; diff --git a/tests/client/dune b/tests/client/dune index a8c9c9619..fdfcde111 100644 --- a/tests/client/dune +++ b/tests/client/dune @@ -1,4 +1,4 @@ (tests (names test_client_lib) - (package opentelemetry) - (libraries alcotest opentelemetry.client)) + (package opentelemetry-client) + (libraries alcotest opentelemetry-client)) diff --git a/tests/client/test_client_lib.ml b/tests/client/test_client_lib.ml index c3f8a3601..1bb520fc8 100644 --- a/tests/client/test_client_lib.ml +++ b/tests/client/test_client_lib.ml @@ -1,5 +1,5 @@ open Alcotest -module Config = Opentelemetry_client.Config +module Config = Opentelemetry_client.Http_config let test_config_printing () = let module Env = Config.Env () in @@ -7,40 +7,20 @@ let test_config_printing () = Format.asprintf "%a" Config.pp @@ Env.make (fun common () -> common) () in let expected = - {|{ debug=false; - self_trace=false; url_traces="http://localhost:4318/v1/traces"; - url_metrics="http://localhost:4318/v1/metrics"; - url_logs="http://localhost:4318/v1/logs"; headers=; batch_traces=400; - batch_metrics=20; batch_logs=400; batch_timeout_ms=2000 }|} + "{ debug=false; log_level=info; sdk_disabled=false; self_trace=false;\n\ + \ self_metrics=false; url_traces=\"http://localhost:4318/v1/traces\";\n\ + \ url_metrics=\"http://localhost:4318/v1/metrics\";\n\ + \ url_logs=\"http://localhost:4318/v1/logs\"; headers=[]; headers_traces=[];\n\ + \ headers_metrics=[]; headers_logs=[]; protocol=http/protobuf;\n\ + \ timeout_ms=10000; timeout_traces_ms=10000; timeout_metrics_ms=10000;\n\ + \ timeout_logs_ms=10000; traces={batch=400; timeout=2s}; metrics={batch=200;\n\ + \ timeout=2s}; logs={batch=400; timeout=2s}; http_concurrency_level=None;\n\ + \ retry_max_attempts=3; retry_initial_delay_ms=100; retry_max_delay_ms=5000;\n\ + \ retry_backoff_multiplier=2.0 }" in check' string ~msg:"is rendered correctly" ~actual ~expected -let test_overriding_stateful_config () = - let module Env = Config.Env () in - Env.set_headers [ "foo", "bar" ]; - Env.set_debug true; - let headers = [ "changed", "header" ] in - let debug = false in - let config : Config.t = - Env.make (fun common () -> common) ~debug ~headers () - in - check' - (list (pair string string)) - ~msg:"header is overriden" ~actual:(Env.get_headers ()) ~expected:headers; - check' - (list (pair string string)) - ~msg:"config and stateful headers are the same" ~actual:(Env.get_headers ()) - ~expected:config.headers; - check' bool ~msg:"debug is overriden" ~actual:(Env.get_debug ()) - ~expected:debug; - check' bool ~msg:"config and stateful debug are the same" - ~actual:(Env.get_debug ()) ~expected:config.debug - let suite = - [ - test_case "default config pretty printing" `Quick test_config_printing; - test_case "overriding default stateful values via make constructor" `Quick - test_overriding_stateful_config; - ] + [ test_case "default config pretty printing" `Quick test_config_printing ] let () = Alcotest.run "Opentelemetry_client" [ "Config", suite ] diff --git a/tests/client_e2e/clients_e2e_lib.ml b/tests/client_e2e/clients_e2e_lib.ml index 3206bfe9c..1ced783fb 100644 --- a/tests/client_e2e/clients_e2e_lib.ml +++ b/tests/client_e2e/clients_e2e_lib.ml @@ -6,13 +6,13 @@ module Client = Opentelemetry_client module Proto = Opentelemetry.Proto open Containers -let batch_size : Client.Signal.t -> int = function +let batch_size : Client.Resource_signal.t -> int = function | Traces ts -> List.length ts | Logs ls -> List.length ls | Metrics ms -> List.length ms -let avg_batch_size (p : Client.Signal.t -> bool) - (batches : Client.Signal.t list) : int = +let avg_batch_size (p : Client.Resource_signal.t -> bool) + (batches : Client.Resource_signal.t list) : int = let sum = List.fold_left (fun acc b -> @@ -24,7 +24,7 @@ let avg_batch_size (p : Client.Signal.t -> bool) in sum / List.length batches -let signals_from_batch (signal_batch : Client.Signal.t) = +let signals_from_batch (signal_batch : Client.Resource_signal.t) = match signal_batch with | Traces ts -> List.map (fun t -> `Trace t) ts | Logs ls -> List.map (fun l -> `Log l) ls @@ -32,11 +32,12 @@ let signals_from_batch (signal_batch : Client.Signal.t) = let filter_map_spans f signals = signals - |> List.filter_map (function - | `Log _ | `Metric _ -> None + |> CCList.flat_map (function + | `Log _ | `Metric _ -> [] | `Trace (r : Proto.Trace.resource_spans) -> r.scope_spans - |> List.find_map (fun ss -> ss.Proto.Trace.spans |> List.find_map f)) + |> CCList.flat_map (fun ss -> + ss.Proto.Trace.spans |> List.filter_map f)) let count_spans_with_name name signals = signals @@ -49,12 +50,12 @@ let count_spans_with_name name signals = let filter_map_metrics f signals = signals - |> List.filter_map (function - | `Log _ | `Trace _ -> None + |> CCList.flat_map (function + | `Log _ | `Trace _ -> [] | `Metric (r : Proto.Metrics.resource_metrics) -> r.scope_metrics - |> List.find_map (fun ss -> - ss.Proto.Metrics.metrics |> List.find_map f)) + |> CCList.flat_map (fun ss -> + ss.Proto.Metrics.metrics |> List.filter_map f)) let count_metrics_with_name name signals = signals @@ -79,21 +80,23 @@ let get_metric_values name signals = Option.some @@ match m.data with - | Sum { data_points; is_monotonic = true; _ } -> + | Some (Sum { data_points; is_monotonic = true; _ }) -> List.fold_left (fun acc (p : Proto.Metrics.number_data_point) -> - acc +. number_data_point_to_float p.value) + acc + +. CCOption.map_or ~default:0. number_data_point_to_float + p.value) 0. data_points | _ -> failwith "TODO: Support for getting other metrics") let filter_map_logs (f : Proto.Logs.log_record -> 'a option) signals : 'a list = signals - |> List.filter_map (function - | `Metric _ | `Trace _ -> None + |> CCList.flat_map (function + | `Metric _ | `Trace _ -> [] | `Log (r : Proto.Logs.resource_logs) -> r.scope_logs - |> List.find_map (fun ss -> - ss.Proto.Logs.log_records |> List.find_map f)) + |> CCList.flat_map (fun ss -> + ss.Proto.Logs.log_records |> List.filter_map f)) let count_logs_with_body p signals = signals @@ -108,13 +111,14 @@ type params = { url: string; jobs: int; procs: int; + n_outer: int; batch_traces: int; batch_metrics: int; batch_logs: int; iterations: int; } -let cmd exec params = +let cmd exec params : string list = [ exec; "-j"; @@ -123,6 +127,8 @@ let cmd exec params = string_of_int params.procs; "--url"; params.url; + "-n"; + string_of_int params.n_outer; "--iterations"; string_of_int params.iterations; "--batch-traces"; @@ -149,21 +155,23 @@ let tests params signal_batches = ~msg: "number of occurrences should equal the configured jobs * the \ configured processes" - ~expected:(params.jobs * params.procs) + ~expected:(params.jobs * params.procs * params.n_outer) ~actual:(count_spans_with_name "loop.outer" signals)); test "loop.inner spans" (fun () -> Alcotest.(check' int) ~msg: "number of occurrences should equal the configured jobs * the \ configured iterations * configured processes" - ~expected:(params.jobs * params.iterations * params.procs) + ~expected: + (params.jobs * params.iterations * params.procs * params.n_outer) ~actual:(count_spans_with_name "loop.inner" signals)); test "alloc spans" (fun () -> Alcotest.(check' int) ~msg: "number of occurrences should equal the configured jobs * the \ configured iterations * configured processes" - ~expected:(params.jobs * params.iterations * params.procs) + ~expected: + (params.jobs * params.iterations * params.procs * params.n_outer) ~actual:(count_spans_with_name "alloc" signals); Alcotest.(check' bool) ~msg:"should have 'done with alloc' event" ~expected:true @@ -191,9 +199,10 @@ let tests params signal_batches = test "logs" (fun () -> Alcotest.(check' int) ~msg: - "should record jobs * iterations occurrences * configured \ + "should record jobs * iterations occurrences * configured * n \ processes of 'inner at n'" - ~expected:(params.jobs * params.iterations * params.procs) + ~expected: + (params.jobs * params.iterations * params.procs * params.n_outer) ~actual: (signals |> count_logs_with_body (function @@ -203,16 +212,19 @@ let tests params signal_batches = | _ -> false))); ] -let run_tests ~port cmds = +let run_tests ~port (cmds : _ list) : unit = let suites = - cmds - |> List.map (fun (exec, params) -> + let open Lwt.Syntax in + Lwt_main.run + @@ Lwt_list.map_s + (fun (exec, params) -> let cmd = cmd exec params in - let name = cmd |> String.concat " " in - let signal_batches = Signal_gatherer.gather_signals ~port cmd in + let name = Printf.sprintf "'test: %s'" (String.concat " " cmd) in + let* signal_batches = Signal_gatherer.gather_signals ~port cmd in (* Let server reset *) - Unix.sleep 1; - name, tests params signal_batches) + let* () = Lwt_unix.sleep 1. in + Lwt.return (name, tests params signal_batches)) + cmds in let open Alcotest in run "Collector integration tests" suites diff --git a/tests/client_e2e/dune b/tests/client_e2e/dune index 8952b1a73..2fdccbebf 100644 --- a/tests/client_e2e/dune +++ b/tests/client_e2e/dune @@ -5,6 +5,7 @@ (binaries (../bin/emit1.exe as emit1) (../bin/emit1_cohttp.exe as emit1_cohttp) + (../bin/emit1_ocurl_lwt.exe as emit1_ocurl_lwt) (../bin/emit1_eio.exe as emit1_eio) (./gather_signals.exe as gather_signals)))) @@ -12,40 +13,59 @@ (name signal_gatherer) (modules signal_gatherer) (libraries - str - alcotest - cohttp-lwt-unix - fmt - unix - containers + (re_export str) + (re_export alcotest) + (re_export cohttp) + conduit-lwt + conduit-lwt-unix + (re_export cohttp-lwt) + (re_export cohttp-lwt-unix) + (re_export fmt) + (re_export unix) + (re_export containers) logs.fmt logs.threaded - opentelemetry.client)) + (re_export lwt) + (re_export lwt.unix) + (re_export opentelemetry) + (re_export opentelemetry-client))) (library (name clients_e2e_lib) (modules clients_e2e_lib) - (libraries alcotest signal_gatherer)) + (libraries alcotest lwt lwt.unix signal_gatherer)) (tests - (names test_cottp_lwt_client_e2e) - (modules test_cottp_lwt_client_e2e) + (names test_cohttp_lwt_client_e2e) + (modules test_cohttp_lwt_client_e2e) (package opentelemetry-client-cohttp-lwt) - (enabled_if - (>= %{ocaml_version} 5.0)) (deps %{bin:emit1_cohttp}) - (libraries clients_e2e_lib alcotest opentelemetry opentelemetry.client)) + (libraries clients_e2e_lib alcotest opentelemetry opentelemetry-client)) (tests - (names test_cottp_eio_client_e2e) - (modules test_cottp_eio_client_e2e) + (names test_cohttp_eio_client_e2e) + (modules test_cohttp_eio_client_e2e) (package opentelemetry-client-cohttp-eio) (deps %{bin:emit1_eio}) (enabled_if (>= %{ocaml_version} 5.0)) - (libraries clients_e2e_lib alcotest opentelemetry opentelemetry.client)) + (libraries clients_e2e_lib alcotest opentelemetry opentelemetry-client)) + +(tests + (names test_ocurl_client_e2e) + (modules test_ocurl_client_e2e) + (package opentelemetry-client-ocurl) + (deps %{bin:emit1}) + (libraries clients_e2e_lib alcotest opentelemetry opentelemetry-client)) + +(tests + (names test_ocurl_lwt_client_e2e) + (modules test_ocurl_lwt_client_e2e) + (package opentelemetry-client-ocurl-lwt) + (deps %{bin:emit1_ocurl_lwt}) + (libraries clients_e2e_lib alcotest opentelemetry opentelemetry-client)) (executable (name signal_reporter_server) (modules signal_reporter_server) - (libraries signal_gatherer)) + (libraries signal_gatherer lwt lwt.unix)) diff --git a/tests/client_e2e/signal_gatherer.ml b/tests/client_e2e/signal_gatherer.ml index 234feaf2b..061e7bcdf 100644 --- a/tests/client_e2e/signal_gatherer.ml +++ b/tests/client_e2e/signal_gatherer.ml @@ -1,7 +1,7 @@ (* A runs tests against a OTel-instrumented program *) module Client = Opentelemetry_client -module Signal = Client.Signal +module Signal = Client.Resource_signal open Lwt.Syntax let debug = @@ -111,14 +111,12 @@ module Tested_program = struct end let default_port = - String.split_on_char ':' Client.Config.default_url |> function + String.split_on_char ':' Client.Http_config.default_url |> function (* Extracting the port from 'http://foo:' *) | [ _; _; port ] -> int_of_string port | _ -> failwith "unexpected format in Client.Config.default_url" -let gather_signals ?(port = default_port) program_to_test = - Lwt_main.run - @@ +let gather_signals ?(port = default_port) program_to_test : _ Lwt.t = let stream, push = Lwt_stream.create () in let* () = Lwt.pick [ Server.run port push; Tested_program.run program_to_test ] @@ -128,14 +126,22 @@ let gather_signals ?(port = default_port) program_to_test = Lwt_stream.to_list stream (* Just run the server, and print the signals gathered. *) -let run ?(port = default_port) () = - Lwt_main.run - @@ +let run ?(port = default_port) () : _ Lwt.t = let stream, push = Lwt_stream.create () in Lwt.join [ Server.run port push; Lwt_stream.iter_s - (fun s -> Format.asprintf "%a" Signal.Pp.pp s |> Lwt_io.printl) + (fun s -> + let open Lwt.Syntax in + let printed = Format.asprintf "%a" Signal.Pp.pp s in + + (* redact current ocaml version, for expect tests *) + let printed = + CCString.replace ~which:`All ~sub:Sys.ocaml_version + ~by:"ocaml_version" printed + in + let* () = Lwt_io.printl printed in + Lwt_io.flush Lwt_io.stdout) stream; ] diff --git a/tests/client_e2e/signal_gatherer.mli b/tests/client_e2e/signal_gatherer.mli index b948d0596..40148bc19 100644 --- a/tests/client_e2e/signal_gatherer.mli +++ b/tests/client_e2e/signal_gatherer.mli @@ -2,7 +2,7 @@ server that can receive the signals make them available for inspection. *) val gather_signals : - ?port:int -> string list -> Opentelemetry_client.Signal.t list + ?port:int -> string list -> Opentelemetry_client.Resource_signal.t list Lwt.t (** [gather_signals program_to_test] is a list of all the signals emitted by the [program_to_test], which the server was able to record. This function assumes that the program to test will be sending its signals to the @@ -12,7 +12,7 @@ val gather_signals : the port where signals will be received. Default is port set in {!Opentelemetry_client.Config.default_url}. *) -val run : ?port:int -> unit -> unit +val run : ?port:int -> unit -> unit Lwt.t (** [run ()] runs a signal gathering server and prints all batches of signals received to stdout. diff --git a/tests/client_e2e/signal_reporter_server.ml b/tests/client_e2e/signal_reporter_server.ml index a7f177086..aed834a5c 100644 --- a/tests/client_e2e/signal_reporter_server.ml +++ b/tests/client_e2e/signal_reporter_server.ml @@ -1,4 +1,4 @@ (** Runs a signal gatherer server, and prints out every batch of signals received to stdout. This can be used to monitor the signals sent by an application, e.g., the test executables defined in /tests/bin/emit1*.ml *) -let () = Signal_gatherer.run () +let () = Lwt_main.run @@ Signal_gatherer.run () diff --git a/tests/client_e2e/test_cohttp_eio_client_e2e.ml b/tests/client_e2e/test_cohttp_eio_client_e2e.ml new file mode 100644 index 000000000..04ef9a786 --- /dev/null +++ b/tests/client_e2e/test_cohttp_eio_client_e2e.ml @@ -0,0 +1,56 @@ +open Clients_e2e_lib + +(* NOTE: This port must be different from that used by other integration tests, + to prevent socket binding clashes. *) +let port = 4328 + +let url = Printf.sprintf "http://localhost:%d" port + +let () = + Clients_e2e_lib.run_tests ~port + [ + ( "emit1_eio", + { + url; + jobs = 1; + procs = 1; + n_outer = 1; + iterations = 1; + batch_traces = 2; + batch_metrics = 2; + batch_logs = 2; + } ); + ( "emit1_eio", + { + url; + jobs = 3; + procs = 1; + n_outer = 1; + iterations = 1; + batch_traces = 400; + batch_metrics = 3; + batch_logs = 400; + } ); + ( "emit1_eio", + { + url; + jobs = 3; + procs = 1; + n_outer = 5; + iterations = 1; + batch_traces = 100; + batch_metrics = 20; + batch_logs = 400; + } ); + ( "emit1_eio", + { + url; + jobs = 3; + procs = 3; + n_outer = 1; + iterations = 1; + batch_traces = 400; + batch_metrics = 3; + batch_logs = 400; + } ); + ] diff --git a/tests/client_e2e/test_cottp_lwt_client_e2e.ml b/tests/client_e2e/test_cohttp_lwt_client_e2e.ml similarity index 78% rename from tests/client_e2e/test_cottp_lwt_client_e2e.ml rename to tests/client_e2e/test_cohttp_lwt_client_e2e.ml index b1ba3772c..94da1c256 100644 --- a/tests/client_e2e/test_cottp_lwt_client_e2e.ml +++ b/tests/client_e2e/test_cohttp_lwt_client_e2e.ml @@ -1,5 +1,3 @@ -module Client = Opentelemetry_client -module Proto = Opentelemetry.Proto open Clients_e2e_lib (* NOTE: This port must be different from that used by other integration tests, @@ -26,6 +24,7 @@ let () = url; jobs = 1; procs = 1; + n_outer = 1; iterations = 1; batch_traces = 2; batch_metrics = 2; @@ -36,6 +35,18 @@ let () = url; jobs = 3; procs = 1; + n_outer = 1; + iterations = 1; + batch_traces = 400; + batch_metrics = 3; + batch_logs = 400; + } ); + ( "emit1_cohttp", + { + url; + jobs = 3; + procs = 1; + n_outer = 5; iterations = 1; batch_traces = 400; batch_metrics = 3; diff --git a/tests/client_e2e/test_cottp_eio_client_e2e.ml b/tests/client_e2e/test_ocurl_client_e2e.ml similarity index 82% rename from tests/client_e2e/test_cottp_eio_client_e2e.ml rename to tests/client_e2e/test_ocurl_client_e2e.ml index ab5cf9855..96ee34c35 100644 --- a/tests/client_e2e/test_cottp_eio_client_e2e.ml +++ b/tests/client_e2e/test_ocurl_client_e2e.ml @@ -1,41 +1,42 @@ -module Client = Opentelemetry_client -module Proto = Opentelemetry.Proto open Clients_e2e_lib (* NOTE: This port must be different from that used by other integration tests, to prevent socket binding clashes. *) -let port = 4328 +let port = 4361 let url = Printf.sprintf "http://localhost:%d" port let () = Clients_e2e_lib.run_tests ~port [ - ( "emit1_eio", + ( "emit1", { url; jobs = 1; procs = 1; + n_outer = 1; iterations = 1; batch_traces = 2; batch_metrics = 2; batch_logs = 2; } ); - ( "emit1_eio", + ( "emit1", { url; jobs = 3; procs = 1; + n_outer = 1; iterations = 1; batch_traces = 400; batch_metrics = 3; batch_logs = 400; } ); - ( "emit1_eio", + ( "emit1", { url; jobs = 3; - procs = 3; + procs = 1; + n_outer = 5; iterations = 1; batch_traces = 400; batch_metrics = 3; diff --git a/tests/client_e2e/test_ocurl_lwt_client_e2e.ml b/tests/client_e2e/test_ocurl_lwt_client_e2e.ml new file mode 100644 index 000000000..b7c7d28cd --- /dev/null +++ b/tests/client_e2e/test_ocurl_lwt_client_e2e.ml @@ -0,0 +1,45 @@ +open Clients_e2e_lib + +(* NOTE: This port must be different from that used by other integration tests, + to prevent socket binding clashes. *) +let port = 4359 + +let url = Printf.sprintf "http://localhost:%d" port + +let () = + Clients_e2e_lib.run_tests ~port + [ + ( "emit1_ocurl_lwt", + { + url; + jobs = 1; + procs = 1; + n_outer = 1; + iterations = 1; + batch_traces = 2; + batch_metrics = 2; + batch_logs = 2; + } ); + ( "emit1_ocurl_lwt", + { + url; + jobs = 3; + procs = 1; + n_outer = 1; + iterations = 1; + batch_traces = 400; + batch_metrics = 3; + batch_logs = 400; + } ); + ( "emit1_ocurl_lwt", + { + url; + jobs = 3; + procs = 1; + n_outer = 5; + iterations = 1; + batch_traces = 400; + batch_metrics = 3; + batch_logs = 400; + } ); + ] diff --git a/tests/cohttp/dune b/tests/cohttp/dune index 162b785a8..239982750 100644 --- a/tests/cohttp/dune +++ b/tests/cohttp/dune @@ -1,4 +1,4 @@ (tests (names test_urls) (package opentelemetry-client-cohttp-lwt) - (libraries opentelemetry opentelemetry-client-cohttp-lwt)) + (libraries opentelemetry opentelemetry-client-cohttp-lwt unix)) diff --git a/tests/core/dune b/tests/core/dune index 8a702b103..f158b3def 100644 --- a/tests/core/dune +++ b/tests/core/dune @@ -1,4 +1,4 @@ (tests - (names test_trace_context) + (names test_trace_context t_size t_histogram test_span_dummy) (package opentelemetry) - (libraries opentelemetry)) + (libraries pbrt opentelemetry)) diff --git a/tests/core/t_histogram.expected b/tests/core/t_histogram.expected new file mode 100644 index 000000000..7be6189fc --- /dev/null +++ b/tests/core/t_histogram.expected @@ -0,0 +1,100 @@ +{ name = "test.latency"; + description = "test histogram"; + unit_ = "" (* absent *); + data = + Some( + Histogram( + { data_points = + [{ attributes = []; + start_time_unix_nano = 0 (* absent *); + time_unix_nano = 0; + count = 4; + sum = 15.; + bucket_counts = [1;1;1;1]; + explicit_bounds = [1.;2.;5.]; + exemplars = []; + flags = 0 (* absent *); + min = 0. (* absent *); + max = 0. (* absent *); + } + ]; + aggregation_temporality = + Aggregation_temporality_unspecified (* absent *); + })); + metadata = []; +} +{ name = "test.size"; + description = "" (* absent *); + unit_ = "" (* absent *); + data = + Some( + Histogram( + { data_points = + [{ attributes = []; + start_time_unix_nano = 0 (* absent *); + time_unix_nano = 0; + count = 4; + sum = 2.6; + bucket_counts = [3;1;0]; + explicit_bounds = [1.;5.]; + exemplars = []; + flags = 0 (* absent *); + min = 0. (* absent *); + max = 0. (* absent *); + } + ]; + aggregation_temporality = + Aggregation_temporality_unspecified (* absent *); + })); + metadata = []; +} +{ name = "test.empty"; + description = "" (* absent *); + unit_ = "" (* absent *); + data = + Some( + Histogram( + { data_points = + [{ attributes = []; + start_time_unix_nano = 0 (* absent *); + time_unix_nano = 0; + count = 0; + sum = 0.; + bucket_counts = [0;0;0;0]; + explicit_bounds = [1.;2.;5.]; + exemplars = []; + flags = 0 (* absent *); + min = 0. (* absent *); + max = 0. (* absent *); + } + ]; + aggregation_temporality = + Aggregation_temporality_unspecified (* absent *); + })); + metadata = []; +} +{ name = "test.boundary"; + description = "" (* absent *); + unit_ = "" (* absent *); + data = + Some( + Histogram( + { data_points = + [{ attributes = []; + start_time_unix_nano = 0 (* absent *); + time_unix_nano = 0; + count = 3; + sum = 8.; + bucket_counts = [1;1;1;0]; + explicit_bounds = [1.;2.;5.]; + exemplars = []; + flags = 0 (* absent *); + min = 0. (* absent *); + max = 0. (* absent *); + } + ]; + aggregation_temporality = + Aggregation_temporality_unspecified (* absent *); + })); + metadata = []; +} diff --git a/tests/core/t_histogram.ml b/tests/core/t_histogram.ml new file mode 100644 index 000000000..81ba42c36 --- /dev/null +++ b/tests/core/t_histogram.ml @@ -0,0 +1,64 @@ +open Opentelemetry + +(** A deterministic clock that always returns timestamp 0 *) +let dummy_clock : Clock.t = { Clock.now = (fun () -> 0L) } + +let emit h = h.Instrument.emit ~clock:dummy_clock () + +let pp_metrics metrics = List.iter (Format.printf "%a@." Metrics.pp) metrics + +(* ------------------------------------------------------------------ *) +(* Test 1: one value per bucket, plus one in the overflow bucket *) +(* bounds [1; 2; 5] → 4 buckets: (≤1) (1,2] (2,5] (5,∞) *) +let () = + let h = + Instrument.Histogram.create ~name:"test.latency" + ~description:"test histogram" ~bounds:[ 1.; 2.; 5. ] () + in + Instrument.Histogram.record h 0.5; + (* bucket 0: ≤1 *) + Instrument.Histogram.record h 1.5; + (* bucket 1: ≤2 *) + Instrument.Histogram.record h 3.0; + (* bucket 2: ≤5 *) + Instrument.Histogram.record h 10.; + (* bucket 3: >5 *) + (* count=4 sum=15.0 bucket_counts=[1;1;1;1] *) + pp_metrics (emit h) + +(* ------------------------------------------------------------------ *) +(* Test 2: multiple values pile into the same bucket *) +let () = + let h = Instrument.Histogram.create ~name:"test.size" ~bounds:[ 1.; 5. ] () in + Instrument.Histogram.record h 0.1; + Instrument.Histogram.record h 0.2; + Instrument.Histogram.record h 0.3; + (* 3 values in bucket 0 *) + Instrument.Histogram.record h 2.0; + (* 1 value in bucket 1 *) + (* count=4 sum=2.6 bucket_counts=[3;1;0] *) + pp_metrics (emit h) + +(* ------------------------------------------------------------------ *) +(* Test 3: empty histogram *) +let () = + let h = + Instrument.Histogram.create ~name:"test.empty" ~bounds:[ 1.; 2.; 5. ] () + in + (* count=0 sum=0.0 bucket_counts=[0;0;0;0] *) + pp_metrics (emit h) + +(* ------------------------------------------------------------------ *) +(* Test 4: value exactly on a bound goes into that bound's bucket *) +let () = + let h = + Instrument.Histogram.create ~name:"test.boundary" ~bounds:[ 1.; 2.; 5. ] () + in + Instrument.Histogram.record h 1.0; + (* exactly on bound → bucket 0 *) + Instrument.Histogram.record h 2.0; + (* exactly on bound → bucket 1 *) + Instrument.Histogram.record h 5.0; + (* exactly on bound → bucket 2 *) + (* count=3 sum=8.0 bucket_counts=[1;1;1;0] *) + pp_metrics (emit h) diff --git a/tests/core/t_size.expected b/tests/core/t_size.expected new file mode 100644 index 000000000..a6f0adc38 --- /dev/null +++ b/tests/core/t_size.expected @@ -0,0 +1,352 @@ +metrics size: 149B +res1: { resource = None; + scope_metrics = + [{ scope = None; + metrics = + [{ name = "sum.foo"; + description = "" (* absent *); + unit_ = "" (* absent *); + data = + Some( + Sum( + { data_points = + [{ attributes = []; + start_time_unix_nano = 42; + time_unix_nano = 45; + value = Some(As_int(10)); + exemplars = []; + flags = 0 (* absent *); + }; + { attributes = []; + start_time_unix_nano = 52; + time_unix_nano = 55; + value = Some(As_int(20)); + exemplars = []; + flags = 0 (* absent *); + } + ]; + aggregation_temporality = + Aggregation_temporality_cumulative; + is_monotonic = false (* absent *); + })); + metadata = []; + }; + { name = "gauge.bar"; + description = "" (* absent *); + unit_ = "" (* absent *); + data = + Some( + Gauge( + { data_points = + [{ attributes = []; + start_time_unix_nano = 42; + time_unix_nano = 45; + value = Some(As_double(10.)); + exemplars = []; + flags = 0 (* absent *); + }; + { attributes = []; + start_time_unix_nano = 52; + time_unix_nano = 55; + value = Some(As_double(20.)); + exemplars = []; + flags = 0 (* absent *); + } + ]; + })); + metadata = []; + } + ]; + schema_url = "" (* absent *); + } + ]; + schema_url = "" (* absent *); + } +res1: { resource = None; + scope_metrics = + [{ scope = None; + metrics = + [{ name = "sum.foo"; + description = "" (* absent *); + unit_ = "" (* absent *); + data = + Some( + Sum( + { data_points = + [{ attributes = []; + start_time_unix_nano = 42; + time_unix_nano = 45; + value = Some(As_int(10)); + exemplars = []; + flags = 0 (* absent *); + }; + { attributes = []; + start_time_unix_nano = 52; + time_unix_nano = 55; + value = Some(As_int(20)); + exemplars = []; + flags = 0 (* absent *); + } + ]; + aggregation_temporality = + Aggregation_temporality_cumulative; + is_monotonic = false (* absent *); + })); + metadata = []; + }; + { name = "gauge.bar"; + description = "" (* absent *); + unit_ = "" (* absent *); + data = + Some( + Gauge( + { data_points = + [{ attributes = []; + start_time_unix_nano = 42; + time_unix_nano = 45; + value = Some(As_double(10.)); + exemplars = []; + flags = 0 (* absent *); + }; + { attributes = []; + start_time_unix_nano = 52; + time_unix_nano = 55; + value = Some(As_double(20.)); + exemplars = []; + flags = 0 (* absent *); + } + ]; + })); + metadata = []; + } + ]; + schema_url = "" (* absent *); + } + ]; + schema_url = "" (* absent *); + } +trace size: 371B +trace1: { resource = None; + scope_spans = + [{ scope = None; + spans = + [{ trace_id = ; + span_id = ; + trace_state = "" (* absent *); + parent_span_id = (* absent *); + flags = 0 (* absent *); + name = "sp1"; + kind = Span_kind_unspecified (* absent *); + start_time_unix_nano = 10; + end_time_unix_nano = 15; + attributes = []; + dropped_attributes_count = 0 (* absent *); + events = []; + dropped_events_count = 0 (* absent *); + links = []; + dropped_links_count = 0 (* absent *); + status = None; + }; + { trace_id = ; + span_id = ; + trace_state = "" (* absent *); + parent_span_id = ; + flags = 0 (* absent *); + name = "sp2"; + kind = Span_kind_unspecified (* absent *); + start_time_unix_nano = 20; + end_time_unix_nano = 25; + attributes = []; + dropped_attributes_count = 0 (* absent *); + events = []; + dropped_events_count = 0 (* absent *); + links = []; + dropped_links_count = 0 (* absent *); + status = None; + }; + { trace_id = ; + span_id = ; + trace_state = "" (* absent *); + parent_span_id = ; + flags = 0 (* absent *); + name = "sp3"; + kind = Span_kind_unspecified (* absent *); + start_time_unix_nano = 30; + end_time_unix_nano = 35; + attributes = []; + dropped_attributes_count = 0 (* absent *); + events = []; + dropped_events_count = 0 (* absent *); + links = []; + dropped_links_count = 0 (* absent *); + status = None; + }; + { trace_id = ; + span_id = ; + trace_state = "" (* absent *); + parent_span_id = ; + flags = 0 (* absent *); + name = "sp4"; + kind = Span_kind_unspecified (* absent *); + start_time_unix_nano = 40; + end_time_unix_nano = 45; + attributes = []; + dropped_attributes_count = 0 (* absent *); + events = []; + dropped_events_count = 0 (* absent *); + links = []; + dropped_links_count = 0 (* absent *); + status = None; + }; + { trace_id = ; + span_id = ; + trace_state = "" (* absent *); + parent_span_id = ; + flags = 0 (* absent *); + name = "sp5"; + kind = Span_kind_unspecified (* absent *); + start_time_unix_nano = 50; + end_time_unix_nano = 55; + attributes = []; + dropped_attributes_count = 0 (* absent *); + events = []; + dropped_events_count = 0 (* absent *); + links = []; + dropped_links_count = 0 (* absent *); + status = None; + }; + { trace_id = ; + span_id = ; + trace_state = "" (* absent *); + parent_span_id = ; + flags = 0 (* absent *); + name = "sp6"; + kind = Span_kind_unspecified (* absent *); + start_time_unix_nano = 60; + end_time_unix_nano = 65; + attributes = []; + dropped_attributes_count = 0 (* absent *); + events = []; + dropped_events_count = 0 (* absent *); + links = []; + dropped_links_count = 0 (* absent *); + status = None; + } + ]; + schema_url = "" (* absent *); + } + ]; + schema_url = "" (* absent *); + } +trace2: { resource = None; + scope_spans = + [{ scope = None; + spans = + [{ trace_id = ; + span_id = ; + trace_state = "" (* absent *); + parent_span_id = (* absent *); + flags = 0 (* absent *); + name = "sp1"; + kind = Span_kind_unspecified (* absent *); + start_time_unix_nano = 10; + end_time_unix_nano = 15; + attributes = []; + dropped_attributes_count = 0 (* absent *); + events = []; + dropped_events_count = 0 (* absent *); + links = []; + dropped_links_count = 0 (* absent *); + status = None; + }; + { trace_id = ; + span_id = ; + trace_state = "" (* absent *); + parent_span_id = ; + flags = 0 (* absent *); + name = "sp2"; + kind = Span_kind_unspecified (* absent *); + start_time_unix_nano = 20; + end_time_unix_nano = 25; + attributes = []; + dropped_attributes_count = 0 (* absent *); + events = []; + dropped_events_count = 0 (* absent *); + links = []; + dropped_links_count = 0 (* absent *); + status = None; + }; + { trace_id = ; + span_id = ; + trace_state = "" (* absent *); + parent_span_id = ; + flags = 0 (* absent *); + name = "sp3"; + kind = Span_kind_unspecified (* absent *); + start_time_unix_nano = 30; + end_time_unix_nano = 35; + attributes = []; + dropped_attributes_count = 0 (* absent *); + events = []; + dropped_events_count = 0 (* absent *); + links = []; + dropped_links_count = 0 (* absent *); + status = None; + }; + { trace_id = ; + span_id = ; + trace_state = "" (* absent *); + parent_span_id = ; + flags = 0 (* absent *); + name = "sp4"; + kind = Span_kind_unspecified (* absent *); + start_time_unix_nano = 40; + end_time_unix_nano = 45; + attributes = []; + dropped_attributes_count = 0 (* absent *); + events = []; + dropped_events_count = 0 (* absent *); + links = []; + dropped_links_count = 0 (* absent *); + status = None; + }; + { trace_id = ; + span_id = ; + trace_state = "" (* absent *); + parent_span_id = ; + flags = 0 (* absent *); + name = "sp5"; + kind = Span_kind_unspecified (* absent *); + start_time_unix_nano = 50; + end_time_unix_nano = 55; + attributes = []; + dropped_attributes_count = 0 (* absent *); + events = []; + dropped_events_count = 0 (* absent *); + links = []; + dropped_links_count = 0 (* absent *); + status = None; + }; + { trace_id = ; + span_id = ; + trace_state = "" (* absent *); + parent_span_id = ; + flags = 0 (* absent *); + name = "sp6"; + kind = Span_kind_unspecified (* absent *); + start_time_unix_nano = 60; + end_time_unix_nano = 65; + attributes = []; + dropped_attributes_count = 0 (* absent *); + events = []; + dropped_events_count = 0 (* absent *); + links = []; + dropped_links_count = 0 (* absent *); + status = None; + } + ]; + schema_url = "" (* absent *); + } + ]; + schema_url = "" (* absent *); + } diff --git a/tests/core/t_size.ml b/tests/core/t_size.ml new file mode 100644 index 000000000..cfa024b5b --- /dev/null +++ b/tests/core/t_size.ml @@ -0,0 +1,87 @@ +(* test the size of serialized data *) + +open Opentelemetry + +let res1 : Proto.Metrics.resource_metrics = + Proto.Metrics.make_resource_metrics + ~scope_metrics: + [ + Proto.Metrics.make_scope_metrics + ~metrics: + [ + Metrics.sum ~name:"sum.foo" + [ + Metrics.int ~start_time_unix_nano:42L ~now:45L 10; + Metrics.int ~start_time_unix_nano:52L ~now:55L 20; + ]; + Metrics.gauge ~name:"gauge.bar" + [ + Metrics.float ~start_time_unix_nano:42L ~now:45L 10.; + Metrics.float ~start_time_unix_nano:52L ~now:55L 20.; + ]; + ] + (); + ] + () + +let str = + let enc = Pbrt.Encoder.create () in + Proto.Metrics.encode_pb_resource_metrics res1 enc; + Pbrt.Encoder.to_string enc + +let () = Printf.printf "metrics size: %dB\n" (String.length str) + +let () = + let dec = Pbrt.Decoder.of_string str in + let res2 = Proto.Metrics.decode_pb_resource_metrics dec in + Format.printf "res1: %a@." Proto.Metrics.pp_resource_metrics res1; + Format.printf "res1: %a@." Proto.Metrics.pp_resource_metrics res2; + () + +(* traces *) + +let trace1 : Proto.Trace.resource_spans = + let span_id = Span_id.dummy |> Span_id.to_bytes in + let trace_id = Trace_id.dummy |> Trace_id.to_bytes in + Proto.Trace.make_resource_spans + ~scope_spans: + [ + Proto.Trace.make_scope_spans + ~spans: + [ + Proto.Trace.make_span ~trace_id ~span_id ~name:"sp1" + ~start_time_unix_nano:10L ~end_time_unix_nano:15L ~events:[] + ~links:[] ~attributes:[] (); + Proto.Trace.make_span ~trace_id ~span_id ~name:"sp2" + ~start_time_unix_nano:20L ~end_time_unix_nano:25L ~events:[] + ~links:[] ~attributes:[] ~parent_span_id:span_id (); + Proto.Trace.make_span ~trace_id ~span_id ~name:"sp3" + ~start_time_unix_nano:30L ~end_time_unix_nano:35L ~events:[] + ~links:[] ~attributes:[] ~parent_span_id:span_id (); + Proto.Trace.make_span ~trace_id ~span_id ~name:"sp4" + ~start_time_unix_nano:40L ~end_time_unix_nano:45L ~events:[] + ~links:[] ~attributes:[] ~parent_span_id:span_id (); + Proto.Trace.make_span ~trace_id ~span_id ~name:"sp5" + ~start_time_unix_nano:50L ~end_time_unix_nano:55L ~events:[] + ~links:[] ~attributes:[] ~parent_span_id:span_id (); + Proto.Trace.make_span ~trace_id ~span_id ~name:"sp6" + ~start_time_unix_nano:60L ~end_time_unix_nano:65L ~events:[] + ~links:[] ~attributes:[] ~parent_span_id:span_id (); + ] + (); + ] + () + +let str = + let enc = Pbrt.Encoder.create () in + Proto.Trace.encode_pb_resource_spans trace1 enc; + Pbrt.Encoder.to_string enc + +let () = Printf.printf "trace size: %dB\n" (String.length str) + +let () = + let dec = Pbrt.Decoder.of_string str in + let trace2 = Proto.Trace.decode_pb_resource_spans dec in + Format.printf "trace1: %a@." Proto.Trace.pp_resource_spans trace1; + Format.printf "trace2: %a@." Proto.Trace.pp_resource_spans trace2; + () diff --git a/tests/core/test_span_dummy.expected b/tests/core/test_span_dummy.expected new file mode 100644 index 000000000..22703951b --- /dev/null +++ b/tests/core/test_span_dummy.expected @@ -0,0 +1,27 @@ +ok: add_attrs +ok: add_attrs' +ok: add_event +ok: add_event' +ok: add_links +ok: add_links' +ok: set_status +ok: set_kind +ok: record_exception +span dummy at the end: { trace_id = ; + span_id = ; + trace_state = "" (* absent *); + parent_span_id = (* absent *); + flags = 0 (* absent *); + name = "" (* absent *); + kind = Span_kind_unspecified (* absent *); + start_time_unix_nano = 0 (* absent *); + end_time_unix_nano = 0 (* absent *); + attributes = []; + dropped_attributes_count = 0 (* absent *); + events = []; + dropped_events_count = 0 (* absent *); + links = []; + dropped_links_count = 0 (* absent *); + status = None; + } +all ok diff --git a/tests/core/test_span_dummy.ml b/tests/core/test_span_dummy.ml new file mode 100644 index 000000000..fe64c3b61 --- /dev/null +++ b/tests/core/test_span_dummy.ml @@ -0,0 +1,47 @@ +open Opentelemetry + +(** Check that Span.dummy is never modified by mutation functions *) + +let check_pristine () = + let d = Span.dummy in + assert (Span.attrs d = []); + assert (Span.events d = []); + assert (Span.links d = []); + assert (Span.status d = None); + assert (Span.kind d = None); + assert (not (Span.is_not_dummy d)) + +let check name f = + f (); + check_pristine (); + Printf.printf "ok: %s\n" name + +let trace_id = Trace_id.create () + +let span_id = Span_id.create () + +let () = + check_pristine (); + check "add_attrs" (fun () -> Span.add_attrs Span.dummy [ "k", `String "v" ]); + check "add_attrs'" (fun () -> + Span.add_attrs' Span.dummy (fun () -> [ "k", `Int 42 ])); + check "add_event" (fun () -> Span.add_event Span.dummy (Event.make "ev")); + check "add_event'" (fun () -> + Span.add_event' Span.dummy (fun () -> Event.make "ev")); + check "add_links" (fun () -> + Span.add_links Span.dummy [ Span_link.make ~trace_id ~span_id () ]); + check "add_links'" (fun () -> + Span.add_links' Span.dummy (fun () -> + [ Span_link.make ~trace_id ~span_id () ])); + check "set_status" (fun () -> + Span.set_status Span.dummy + (Span_status.make ~message:"err" ~code:Span_status.Status_code_error)); + check "set_kind" (fun () -> Span.set_kind Span.dummy Span_kind_server); + check "record_exception" (fun () -> + try raise Exit + with exn -> + let bt = Printexc.get_raw_backtrace () in + Span.record_exception Span.dummy exn bt); + Format.printf "span dummy at the end: %a@." Opentelemetry_proto.Trace.pp_span + Span.dummy; + print_endline "all ok" diff --git a/tests/implicit_scope/sync/dune b/tests/implicit_scope/sync/dune index 8b5407f4d..eb17095c9 100644 --- a/tests/implicit_scope/sync/dune +++ b/tests/implicit_scope/sync/dune @@ -1,4 +1,9 @@ (tests (names test_implicit_scope_sync) (package opentelemetry-client-cohttp-lwt) - (libraries alcotest opentelemetry opentelemetry-client-cohttp-lwt)) + (libraries + threads + alcotest + opentelemetry + unix + opentelemetry-client-cohttp-lwt)) diff --git a/tests/implicit_scope/sync/test_implicit_scope_sync.ml b/tests/implicit_scope/sync/test_implicit_scope_sync.ml index d8bf632bd..be526b39c 100644 --- a/tests/implicit_scope/sync/test_implicit_scope_sync.ml +++ b/tests/implicit_scope/sync/test_implicit_scope_sync.ml @@ -1,57 +1,58 @@ open Alcotest module Otel = Opentelemetry -let spans_emitted : Otel.Proto.Trace.resource_spans list ref = ref [] +let spans_emitted : Otel.Span.t list ref = ref [] -module Test_backend = struct - open Otel.Collector - open Otel.Proto - include Noop_backend +let test_exporter : Otel.Exporter.t = + { + Otel.Exporter.export = + (fun sig_ -> + match sig_ with + | Otel.Any_signal_l.Spans sp -> + spans_emitted := List.rev_append sp !spans_emitted + | _ -> ()); + active = (fun () -> Opentelemetry_util.Aswitch.dummy); + shutdown = ignore; + self_metrics = (fun () -> []); + } - let record_emitted_spans (l : Trace.resource_spans list) ~ret = - spans_emitted := l @ !spans_emitted; - ret () - - let send_trace : Trace.resource_spans list sender = - { send = record_emitted_spans } -end - -let with_test_backend f = +let with_test_exporter f = (* uncomment for eprintf debugging: *) - (* let module Debug_and_test_backend = Otel.Collector.Debug_backend (Test_backend) in - let backend = (module Debug_and_test_backend : Otel.Collector.BACKEND) in *) - let backend = (module Test_backend : Otel.Collector.BACKEND) in - Otel.Collector.with_setup_debug_backend backend () f + (* let test_exporter = Opentelemetry_client.Exporter_debug.debug test_exporter in*) + Otel.Sdk.set + ~traces:(Otel.Provider_config.make ()) + ~metrics:(Otel.Provider_config.make ()) + ~logs:(Otel.Provider_config.make ()) + test_exporter; + Fun.protect f ~finally:(fun () -> + let sq = Opentelemetry_client_sync.Sync_queue.create () in + Otel.Sdk.remove + ~on_done:(fun () -> Opentelemetry_client_sync.Sync_queue.push sq ()) + (); + Opentelemetry_client_sync.Sync_queue.pop sq) -let bytes_to_hex = Otel.Util_.bytes_to_hex +let bytes_to_hex = Opentelemetry_util.Util_bytes_.bytes_to_hex let test_stack_based_implicit_scope () = let run () = - Otel.Trace.with_ "first trace" @@ fun _scope -> + Otel.Tracer.with_ "first trace" @@ fun _scope -> Thread.delay 0.2; - Otel.Trace.with_ "second trace" @@ fun _scope -> + Otel.Tracer.with_ "second trace" @@ fun _scope -> Thread.delay 0.2; - Otel.Trace.with_ "third trace" @@ fun _scope -> + Otel.Tracer.with_ "third trace" @@ fun _scope -> Thread.delay 0.2; () in - with_test_backend @@ fun () -> + with_test_exporter @@ fun () -> (* start *) run (); check' int ~msg:"count of spans emitted" ~actual:(List.length !spans_emitted) ~expected:3; let open Otel.Proto.Trace in - let f prev_span_id { scope_spans; _ } = - Format.printf "\n%a@\n" (Format.pp_print_list pp_scope_spans) scope_spans; - check' int ~msg:"count of scope_spans in emitted span" - ~actual:(List.length scope_spans) ~expected:1; - let { scope; spans; _ } = List.hd scope_spans in - check' bool ~msg:"scope exists in emitted span" - ~actual:(Option.is_some scope) ~expected:true; - check' int ~msg:"count of spans in scope_span" ~actual:(List.length spans) - ~expected:1; - let { name; trace_id; span_id; parent_span_id; _ } = List.hd spans in + let f prev_span_id (sp : Otel.Span.t) = + Format.printf "%a@." pp_span sp; + let { name; trace_id; span_id; parent_span_id; _ } = sp in Printf.printf "name='%s' trace_id='%s' span_id='%s' parent_span_id='%s' \ prev_span_id='%s'\n" diff --git a/tests/logs/test_logs_e2e.expected b/tests/logs/test_logs_e2e.expected index e408710ed..cab4f568b 100644 --- a/tests/logs/test_logs_e2e.expected +++ b/tests/logs/test_logs_e2e.expected @@ -1,22 +1,16 @@ { resource = Some( - { attributes = - [{ key = "service.namespace"; - value = Some(String_value("ocaml-otel.test")); - }; - { key = "service.name"; value = Some(String_value("emit_logs")); }; - { key = "src"; value = Some(String_value("application")); }; - { key = "my_reporter_attr"; value = Some(String_value("foo")); } - ]; - dropped_attributes_count = 0; + { attributes = []; + dropped_attributes_count = 0 (* absent *); + entity_refs = []; }); scope_logs = [{ scope = Some( - { name = "ocaml-otel"; - version = "%%VERSION_NUM%%"; + { name = "opentelemetry"; + version = ""; attributes = []; - dropped_attributes_count = 0; + dropped_attributes_count = 0 (* absent *); }); log_records = [{ time_unix_nano = 0; @@ -24,332 +18,143 @@ severity_number = Severity_number_debug; severity_text = "debug"; body = Some(String_value("emit_logs: starting")); - attributes = []; - dropped_attributes_count = 0; - flags = 0; - trace_id = ; - span_id = ; - } - ]; - schema_url = ""; - } - ]; - schema_url = ""; -} -{ resource = - Some( - { attributes = - [{ key = "service.namespace"; - value = Some(String_value("ocaml-otel.test")); - }; - { key = "service.name"; value = Some(String_value("emit_logs")); }; - { key = "src"; value = Some(String_value("application")); }; - { key = "my_reporter_attr"; value = Some(String_value("foo")); } - ]; - dropped_attributes_count = 0; - }); - scope_logs = - [{ scope = - Some( - { name = "ocaml-otel"; - version = "%%VERSION_NUM%%"; - attributes = []; - dropped_attributes_count = 0; - }); - log_records = - [{ time_unix_nano = 0; - observed_time_unix_nano = 0; - severity_number = Severity_number_info2; - severity_text = "info"; - body = Some(String_value("emit_logs: info log")); - attributes = []; - dropped_attributes_count = 0; - flags = 0; - trace_id = ; - span_id = ; - } - ]; - schema_url = ""; - } - ]; - schema_url = ""; - } -{ resource = - Some( - { attributes = - [{ key = "service.namespace"; - value = Some(String_value("ocaml-otel.test")); - }; - { key = "service.name"; - value = Some(String_value("emit_logs")); - }; - { key = "src"; value = Some(String_value("application")); }; + attributes = + [{ key = "src"; value = Some(String_value("application")); }; { key = "my_reporter_attr"; value = Some(String_value("foo")); } ]; - dropped_attributes_count = 0; - }); - scope_logs = - [{ scope = - Some( - { name = "ocaml-otel"; - version = "%%VERSION_NUM%%"; - attributes = []; - dropped_attributes_count = 0; - }); - log_records = - [{ time_unix_nano = 0; - observed_time_unix_nano = 0; - severity_number = Severity_number_warn; - severity_text = "warning"; - body = Some(String_value("emit_logs: warn log")); - attributes = []; - dropped_attributes_count = 0; - flags = 0; - trace_id = ; - span_id = ; - } - ]; - schema_url = ""; - } - ]; - schema_url = ""; - } -{ resource = - Some( - { attributes = - [{ key = "service.namespace"; - value = Some(String_value("ocaml-otel.test")); - }; - { key = "service.name"; - value = Some(String_value("emit_logs")); - }; - { key = "src"; value = Some(String_value("application")); }; - { key = "my_reporter_attr"; - value = Some(String_value("foo")); - } - ]; - dropped_attributes_count = 0; - }); - scope_logs = - [{ scope = - Some( - { name = "ocaml-otel"; - version = "%%VERSION_NUM%%"; - attributes = []; - dropped_attributes_count = 0; - }); - log_records = - [{ time_unix_nano = 0; - observed_time_unix_nano = 0; - severity_number = Severity_number_error; - severity_text = "error"; - body = Some(String_value("emit_logs: error log")); - attributes = []; - dropped_attributes_count = 0; - flags = 0; - trace_id = ; - span_id = ; - } - ]; - schema_url = ""; - } - ]; - schema_url = ""; - } -{ resource = - Some( - { attributes = - [{ key = "service.namespace"; - value = Some(String_value("ocaml-otel.test")); - }; - { key = "service.name"; - value = Some(String_value("emit_logs")); - }; - { key = "src"; value = Some(String_value("application")); }; - { key = "my_reporter_attr"; - value = Some(String_value("foo")); - } - ]; - dropped_attributes_count = 0; - }); - scope_logs = - [{ scope = - Some( - { name = "ocaml-otel"; - version = "%%VERSION_NUM%%"; - attributes = []; - dropped_attributes_count = 0; - }); - log_records = - [{ time_unix_nano = 0; - observed_time_unix_nano = 0; - severity_number = Severity_number_info; - severity_text = "app"; - body = Some(String_value("emit_logs: app log")); - attributes = []; - dropped_attributes_count = 0; - flags = 0; - trace_id = ; - span_id = ; - } - ]; - schema_url = ""; - } - ]; - schema_url = ""; - } -{ resource = + dropped_attributes_count = 0 (* absent *); + flags = 0 (* absent *); + trace_id = (* absent *); + span_id = (* absent *); + event_name = "" (* absent *); + }; + { time_unix_nano = 1; + observed_time_unix_nano = 1; + severity_number = Severity_number_info2; + severity_text = "info"; + body = Some(String_value("emit_logs: info log")); + attributes = + [{ key = "src"; value = Some(String_value("application")); }; + { key = "my_reporter_attr"; value = Some(String_value("foo")); } + ]; + dropped_attributes_count = 0 (* absent *); + flags = 0 (* absent *); + trace_id = (* absent *); + span_id = (* absent *); + event_name = "" (* absent *); + }; + { time_unix_nano = 2; + observed_time_unix_nano = 2; + severity_number = Severity_number_warn; + severity_text = "warning"; + body = Some(String_value("emit_logs: warn log")); + attributes = + [{ key = "src"; value = Some(String_value("application")); }; + { key = "my_reporter_attr"; value = Some(String_value("foo")); } + ]; + dropped_attributes_count = 0 (* absent *); + flags = 0 (* absent *); + trace_id = (* absent *); + span_id = (* absent *); + event_name = "" (* absent *); + }; + { time_unix_nano = 3; + observed_time_unix_nano = 3; + severity_number = Severity_number_error; + severity_text = "error"; + body = Some(String_value("emit_logs: error log")); + attributes = + [{ key = "src"; value = Some(String_value("application")); }; + { key = "my_reporter_attr"; value = Some(String_value("foo")); } + ]; + dropped_attributes_count = 0 (* absent *); + flags = 0 (* absent *); + trace_id = (* absent *); + span_id = (* absent *); + event_name = "" (* absent *); + }; + { time_unix_nano = 4; + observed_time_unix_nano = 4; + severity_number = Severity_number_info; + severity_text = "app"; + body = Some(String_value("emit_logs: app log")); + attributes = + [{ key = "src"; value = Some(String_value("application")); }; + { key = "my_reporter_attr"; value = Some(String_value("foo")); } + ]; + dropped_attributes_count = 0 (* absent *); + flags = 0 (* absent *); + trace_id = (* absent *); + span_id = (* absent *); + event_name = "" (* absent *); + }; + { time_unix_nano = 5; + observed_time_unix_nano = 5; + severity_number = Severity_number_info2; + severity_text = "info"; + body = + Some( + String_value( + "emit_logs: this log is emitted with varied tags from a span")); + attributes = + [{ key = "src"; value = Some(String_value("application")); }; + { key = "string_list_attr"; value = Some(String_value("")); }; + { key = "bool_attr"; value = Some(String_value("")); }; + { key = "float_attr"; value = Some(String_value("")); }; + { key = "int_attr"; value = Some(String_value("")); }; + { key = "string_attr"; value = Some(String_value("")); }; + { key = "my_reporter_attr"; value = Some(String_value("foo")); } + ]; + dropped_attributes_count = 0 (* absent *); + flags = 0 (* absent *); + trace_id = ; + span_id = ; + event_name = "" (* absent *); + }; + { time_unix_nano = 6; + observed_time_unix_nano = 6; + severity_number = Severity_number_info2; + severity_text = "info"; + body = Some( - { attributes = - [{ key = "service.namespace"; - value = Some(String_value("ocaml-otel.test")); - }; - { key = "service.name"; - value = Some(String_value("emit_logs")); - }; - { key = "src"; - value = Some(String_value("application")); - }; - { key = "string_list_attr"; - value = Some(String_value("")); - }; - { key = "bool_attr"; value = Some(String_value("")); }; - { key = "float_attr"; value = Some(String_value("")); }; - { key = "int_attr"; value = Some(String_value("")); }; - { key = "string_attr"; value = Some(String_value("")); }; - { key = "my_reporter_attr"; - value = Some(String_value("foo")); - } - ]; - dropped_attributes_count = 0; - }); - scope_logs = - [{ scope = - Some( - { name = "ocaml-otel"; - version = "%%VERSION_NUM%%"; - attributes = []; - dropped_attributes_count = 0; - }); - log_records = - [{ time_unix_nano = 0; - observed_time_unix_nano = 0; - severity_number = Severity_number_info2; - severity_text = "info"; - body = - Some( - String_value( - "emit_logs: this log is emitted with varied tags from a span")); - attributes = []; - dropped_attributes_count = 0; - flags = 0; - trace_id = ; - span_id = ; - } - ]; - schema_url = ""; - } + String_value( + "emit_logs: this log will be emitted with varied tags")); + attributes = + [{ key = "src"; value = Some(String_value("application")); }; + { key = "string_list_attr"; value = Some(String_value("")); }; + { key = "bool_attr"; value = Some(String_value("")); }; + { key = "float_attr"; value = Some(String_value("")); }; + { key = "int_attr"; value = Some(String_value("")); }; + { key = "string_attr"; value = Some(String_value("")); }; + { key = "my_reporter_attr"; value = Some(String_value("foo")); } ]; - schema_url = ""; + dropped_attributes_count = 0 (* absent *); + flags = 0 (* absent *); + trace_id = (* absent *); + span_id = (* absent *); + event_name = "" (* absent *); + }; + { time_unix_nano = 7; + observed_time_unix_nano = 7; + severity_number = Severity_number_info2; + severity_text = "info"; + body = + Some( + String_value( + "emit_logs: this log will be emitted from otel and fmt reporter")); + attributes = + [{ key = "src"; value = Some(String_value("application")); }; + { key = "my_fmt_attr"; value = Some(String_value("bar")); } + ]; + dropped_attributes_count = 0 (* absent *); + flags = 0 (* absent *); + trace_id = (* absent *); + span_id = (* absent *); + event_name = "" (* absent *); } -{ resource = - Some( - { attributes = - [{ key = "service.namespace"; - value = Some(String_value("ocaml-otel.test")); - }; - { key = "service.name"; - value = Some(String_value("emit_logs")); - }; - { key = "src"; - value = Some(String_value("application")); - }; - { key = "string_list_attr"; - value = Some(String_value("")); - }; - { key = "bool_attr"; value = Some(String_value("")); }; - { key = "float_attr"; value = Some(String_value("")); }; - { key = "int_attr"; value = Some(String_value("")); }; - { key = "string_attr"; value = Some(String_value("")); }; - { key = "my_reporter_attr"; - value = Some(String_value("foo")); - } - ]; - dropped_attributes_count = 0; - }); - scope_logs = - [{ scope = - Some( - { name = "ocaml-otel"; - version = "%%VERSION_NUM%%"; - attributes = []; - dropped_attributes_count = 0; - }); - log_records = - [{ time_unix_nano = 0; - observed_time_unix_nano = 0; - severity_number = Severity_number_info2; - severity_text = "info"; - body = - Some( - String_value( - "emit_logs: this log will be emitted with varied tags")); - attributes = []; - dropped_attributes_count = 0; - flags = 0; - trace_id = ; - span_id = ; - } - ]; - schema_url = ""; - } - ]; - schema_url = ""; - } -{ resource = - Some( - { attributes = - [{ key = "service.namespace"; - value = Some(String_value("ocaml-otel.test")); - }; - { key = "service.name"; - value = Some(String_value("emit_logs_fmt")); - }; - { key = "src"; - value = Some(String_value("application")); - }; - { key = "my_fmt_attr"; - value = Some(String_value("bar")); - } - ]; - dropped_attributes_count = 0; - }); - scope_logs = - [{ scope = - Some( - { name = "ocaml-otel"; - version = "%%VERSION_NUM%%"; - attributes = []; - dropped_attributes_count = 0; - }); - log_records = - [{ time_unix_nano = 0; - observed_time_unix_nano = 0; - severity_number = Severity_number_info2; - severity_text = "info"; - body = - Some( - String_value( - "emit_logs: this log will be emitted from otel and fmt reporter")); - attributes = []; - dropped_attributes_count = 0; - flags = 0; - trace_id = ; - span_id = ; - } - ]; - schema_url = ""; - } - ]; - schema_url = ""; - } + ]; + schema_url = "" (* absent *); + } + ]; + schema_url = "" (* absent *); +} diff --git a/tests/logs/test_logs_e2e.ml b/tests/logs/test_logs_e2e.ml index 51af2968c..68a7a80a3 100644 --- a/tests/logs/test_logs_e2e.ml +++ b/tests/logs/test_logs_e2e.ml @@ -1,43 +1,67 @@ module Client = Opentelemetry_client module L = Opentelemetry_proto.Logs +module Res = Opentelemetry_proto.Resource (* NOTE: This port must be different from that used by other integration tests, to prevent socket binding clashes. *) -let port = 4359 +let port = 4399 let url = Printf.sprintf "http://localhost:%d" port let cmd = [ "emit_logs_cohttp"; "--url"; url ] -let tests (signal_batches : Client.Signal.t list) = +let tests (signal_batches : Client.Resource_signal.t list) = ignore signal_batches; + let cur_time = ref 0 in List.iter - (fun (signal_batch : Client.Signal.t) -> + (fun (signal_batch : Client.Resource_signal.t) -> match signal_batch with | Logs ls -> ls (* Mask out the times so tests don't change in between runs *) |> List.map (fun (l : L.resource_logs) -> + let masked_resource = + l.resource + |> Option.map (fun (r : Res.resource) -> + let r = Res.copy_resource r in + (* just remove the metadata... *) + Res.resource_set_attributes r []; + r) + in let masked_scope_logs = List.map (fun (sl : L.scope_logs) -> let masked_log_records = List.map (fun (lr : L.log_record) -> - { - lr with - time_unix_nano = 0L; - observed_time_unix_nano = 0L; - }) + let lr = L.copy_log_record lr in + let pseudo_time = Int64.of_int !cur_time in + incr cur_time; + L.log_record_set_time_unix_nano lr pseudo_time; + L.log_record_set_observed_time_unix_nano lr + pseudo_time; + lr) sl.log_records in - { sl with log_records = masked_log_records }) + Option.iter + (fun sc -> + Opentelemetry_proto.Common + .instrumentation_scope_set_version sc "") + sl.scope; + let sl = L.copy_scope_logs sl in + L.scope_logs_set_log_records sl masked_log_records; + sl) l.scope_logs in - { l with scope_logs = masked_scope_logs }) + let l = L.copy_resource_logs l in + L.resource_logs_set_scope_logs l masked_scope_logs; + Option.iter (L.resource_logs_set_resource l) masked_resource; + l) |> List.iter (Format.printf "%a\n" L.pp_resource_logs) | _ -> ()) signal_batches let () = - let signal_batches = Signal_gatherer.gather_signals ~port cmd in + let signal_batches = + Lwt_main.run (Signal_gatherer.gather_signals ~port cmd) + in tests signal_batches diff --git a/tests/ocurl-lwt/dune b/tests/ocurl-lwt/dune new file mode 100644 index 000000000..da21e72a8 --- /dev/null +++ b/tests/ocurl-lwt/dune @@ -0,0 +1,4 @@ +(tests + (names test_urls) + (package opentelemetry-client-ocurl-lwt) + (libraries opentelemetry opentelemetry-client-ocurl-lwt)) diff --git a/tests/ocurl-lwt/test_urls.ml b/tests/ocurl-lwt/test_urls.ml new file mode 100644 index 000000000..6f2953a63 --- /dev/null +++ b/tests/ocurl-lwt/test_urls.ml @@ -0,0 +1,31 @@ +module C = Opentelemetry_client_ocurl_lwt + +let () = + let config1 = C.Config.make () in + Format.printf "config1: %a\n%!" C.Config.pp config1; + assert (config1.url_traces = "http://localhost:4318/v1/traces"); + assert (config1.url_metrics = "http://localhost:4318/v1/metrics"); + assert (config1.url_logs = "http://localhost:4318/v1/logs"); + () + +let () = + let config2 = C.Config.make ~url:"http://example.com:1234" () in + Format.printf "config2: %a\n%!" C.Config.pp config2; + assert (config2.url_traces = "http://example.com:1234/v1/traces"); + assert (config2.url_metrics = "http://example.com:1234/v1/metrics"); + assert (config2.url_logs = "http://example.com:1234/v1/logs"); + () + +let () = + let config3 = + C.Config.make ~url_traces:"http://example.com/traces" + ~url_metrics:"http://example.com/metrics" + ~url_logs:"http://example.com/logs" () + in + Format.printf "config3: %a\n%!" C.Config.pp config3; + assert (config3.url_traces = "http://example.com/traces"); + assert (config3.url_metrics = "http://example.com/metrics"); + assert (config3.url_logs = "http://example.com/logs"); + () + +let () = print_endline "All URL tests passed" diff --git a/tests/ocurl/dune b/tests/ocurl/dune index 499e9ea3b..f60d81a0f 100644 --- a/tests/ocurl/dune +++ b/tests/ocurl/dune @@ -1,4 +1,4 @@ (tests (names test_urls) (package opentelemetry-client-ocurl) - (libraries opentelemetry opentelemetry-client-ocurl)) + (libraries unix opentelemetry opentelemetry-client-ocurl)) diff --git a/vendor/opentelemetry-proto b/vendor/opentelemetry-proto index c4dfbc51f..c0a98a184 160000 --- a/vendor/opentelemetry-proto +++ b/vendor/opentelemetry-proto @@ -1 +1 @@ -Subproject commit c4dfbc51f3cd4089778555a2ac5d9bc093ed2956 +Subproject commit c0a98a1847d3124ac5f9ecd02d0e2d2732bbb590