From d62f680fc3bebd26c6815fbe3b0b0197f658aa8d Mon Sep 17 00:00:00 2001 From: Shon Feder Date: Mon, 9 Jun 2025 21:12:44 -0400 Subject: [PATCH 1/8] Refactor client configuration Enabling sharing all common configuration logic --- src/client-cohttp-lwt/common_.ml | 52 --- src/client-cohttp-lwt/config.ml | 80 +---- src/client-cohttp-lwt/config.mli | 78 +---- src/client-cohttp-lwt/dune | 1 + .../opentelemetry_client_cohttp_lwt.ml | 30 +- src/client-ocurl/common_.ml | 52 --- src/client-ocurl/config.ml | 97 ++---- src/client-ocurl/config.mli | 66 +--- src/client-ocurl/dune | 1 + .../opentelemetry_client_ocurl.ml | 27 +- src/client/client.ml | 304 ++++++++++++++++++ src/client/dune | 4 + tests/cohttp/test_urls.ml | 8 +- tests/ocurl/test_urls.ml | 6 +- 14 files changed, 393 insertions(+), 413 deletions(-) create mode 100644 src/client/client.ml create mode 100644 src/client/dune diff --git a/src/client-cohttp-lwt/common_.ml b/src/client-cohttp-lwt/common_.ml index 0219c525..fa371e4b 100644 --- a/src/client-cohttp-lwt/common_.ml +++ b/src/client-cohttp-lwt/common_.ml @@ -5,55 +5,3 @@ let[@inline] ( let@ ) f x = f x let spf = Printf.sprintf let tid () = Thread.id @@ Thread.self () - -let debug_ = - ref - (match Sys.getenv_opt "OTEL_OCAML_DEBUG" with - | Some ("1" | "true") -> true - | _ -> false) - -let default_url = "http://localhost:4318" - -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 diff --git a/src/client-cohttp-lwt/config.ml b/src/client-cohttp-lwt/config.ml index 1d8605db..328b0f46 100644 --- a/src/client-cohttp-lwt/config.ml +++ b/src/client-cohttp-lwt/config.ml @@ -1,79 +1,7 @@ -open Common_ +type t = Client.Config.t -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; -} +module Env = Client.Config.Env () -let pp out self : 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; - url_traces; - url_metrics; - url_logs; - headers; - batch_traces; - batch_metrics; - batch_logs; - batch_timeout_ms; - } = - self - in - Format.fprintf out - "{@[ debug=%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 url_traces url_metrics url_logs ppheaders headers ppiopt batch_traces - ppiopt batch_metrics ppiopt batch_logs batch_timeout_ms +let pp = Client.Config.pp -let make ?(debug = !debug_) ?url ?url_traces ?url_metrics ?url_logs - ?(headers = get_headers ()) ?(batch_traces = Some 400) - ?(batch_metrics = Some 20) ?(batch_logs = Some 400) - ?(batch_timeout_ms = 500) () : t = - 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 - { - debug; - url_traces; - url_metrics; - url_logs; - headers; - batch_traces; - batch_metrics; - batch_timeout_ms; - batch_logs; - } +let make = Env.make (fun common () -> common) diff --git a/src/client-cohttp-lwt/config.mli b/src/client-cohttp-lwt/config.mli index 6312ae87..b7e324bc 100644 --- a/src/client-cohttp-lwt/config.mli +++ b/src/client-cohttp-lwt/config.mli @@ -1,78 +1,12 @@ -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. Default 500. *) -} +type t = Client.Config.t (** Configuration. To build one, use {!make} below. This might be extended with more fields in the future. *) -val make : - ?debug:bool -> - ?url:string -> - ?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 -> - unit -> - t -(** Make a configuration. - - @param thread - if true and [bg_threads] is not provided, we will pick a number of bg - threads. Otherwise the number of [bg_threads] superseeds this option. - - @param url - base url used to construct per-signal urls. Per-signal url options take - precedence over this base url. Default is "http://localhost:4318", or - "OTEL_EXPORTER_OTLP_ENDPOINT" if set. - - 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. *) - val pp : Format.formatter -> t -> unit + +val make : (unit -> t) Client.Config.make +(** Make a configuration {!t}. *) + +module Env : Client.Config.Env diff --git a/src/client-cohttp-lwt/dune b/src/client-cohttp-lwt/dune index 45cc6cfe..480fb4a8 100644 --- a/src/client-cohttp-lwt/dune +++ b/src/client-cohttp-lwt/dune @@ -6,6 +6,7 @@ (pps lwt_ppx)) (libraries opentelemetry + opentelemetry.client lwt cohttp-lwt cohttp-lwt-unix diff --git a/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml b/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml index bd78c983..3ea9c317 100644 --- a/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml +++ b/src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml @@ -6,7 +6,11 @@ module OT = Opentelemetry module Config = Config open Opentelemetry -include Common_ +open Common_ + +let set_headers = Config.Env.set_headers + +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 @@ -98,7 +102,7 @@ end = struct let uri = Uri.of_string url in let open Cohttp in - let headers = Header.(add_list (init ()) !headers) in + let headers = Header.(add_list (init ()) (Config.Env.get_headers ())) in let headers = Header.(add headers "Content-Type" "application/x-protobuf") in @@ -312,7 +316,7 @@ let mk_emitter ~stop ~(config : Config.t) () : (module EMITTER) = Metrics_service.default_export_metrics_service_request ~resource_metrics:l () in - let url = config.Config.url_metrics in + let url = config.url_metrics in send_http_ curl encoder ~url ~encode:Metrics_service.encode_pb_export_metrics_service_request x @@ -321,7 +325,7 @@ let mk_emitter ~stop ~(config : Config.t) () : (module EMITTER) = let x = Trace_service.default_export_trace_service_request ~resource_spans:l () in - let url = config.Config.url_traces in + let url = config.url_traces in send_http_ curl encoder ~url ~encode:Trace_service.encode_pb_export_trace_service_request x @@ -330,7 +334,7 @@ let mk_emitter ~stop ~(config : Config.t) () : (module EMITTER) = let x = Logs_service.default_export_logs_service_request ~resource_logs:l () in - let url = config.Config.url_logs in + let url = config.url_logs in send_http_ curl encoder ~url ~encode:Logs_service.encode_pb_export_logs_service_request x @@ -374,7 +378,8 @@ let mk_emitter ~stop ~(config : Config.t) () : (module EMITTER) = () let tick_common_ () = - if !debug_ then Printf.eprintf "tick (from %d)\n%!" (tid ()); + if Config.Env.get_debug () then + Printf.eprintf "tick (from %d)\n%!" (tid ()); sample_gc_metrics_if_needed (); List.iter (fun f -> @@ -449,7 +454,8 @@ let mk_emitter ~stop ~(config : Config.t) () : (module EMITTER) = let tick () = Lwt.async tick_ let cleanup ~on_done () = - if !debug_ then Printf.eprintf "opentelemetry: exiting…\n%!"; + if Config.Env.get_debug () then + Printf.eprintf "opentelemetry: exiting…\n%!"; Lwt.async (fun () -> let* () = emit_all_force httpc encoder in Httpc.cleanup httpc; @@ -474,7 +480,7 @@ module Backend { send = (fun l ~ret -> - (if !debug_ then + (if Config.Env.get_debug () then let@ () = Lock.with_lock in Format.eprintf "send spans %a@." (Format.pp_print_list Trace.pp_resource_spans) @@ -489,7 +495,7 @@ module Backend (* send metrics from time to time *) let signal_emit_gc_metrics () = - if !debug_ then + if Config.Env.get_debug () then Printf.eprintf "opentelemetry: emit GC metrics requested\n%!"; Atomic.set needs_gc_metrics true @@ -531,7 +537,7 @@ module Backend { send = (fun m ~ret -> - (if !debug_ then + (if Config.Env.get_debug () then let@ () = Lock.with_lock in Format.eprintf "send metrics %a@." (Format.pp_print_list Metrics.pp_resource_metrics) @@ -546,7 +552,7 @@ module Backend { send = (fun m ~ret -> - (if !debug_ then + (if Config.Env.get_debug () then let@ () = Lock.with_lock in Format.eprintf "send logs %a@." (Format.pp_print_list Logs.pp_resource_logs) @@ -558,8 +564,6 @@ module Backend end let create_backend ?(stop = Atomic.make false) ?(config = Config.make ()) () = - debug_ := config.debug; - let module B = Backend (struct diff --git a/src/client-ocurl/common_.ml b/src/client-ocurl/common_.ml index 9388497b..10df0c1d 100644 --- a/src/client-ocurl/common_.ml +++ b/src/client-ocurl/common_.ml @@ -6,55 +6,3 @@ let spf = Printf.sprintf let ( let@ ) = ( @@ ) let tid () = Thread.id @@ Thread.self () - -let debug_ = - ref - (match Sys.getenv_opt "OTEL_OCAML_DEBUG" with - | Some ("1" | "true") -> true - | _ -> false) - -let default_url = "http://localhost:4318" - -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 diff --git a/src/client-ocurl/config.ml b/src/client-ocurl/config.ml index 33767cf2..a2f9fb6b 100644 --- a/src/client-ocurl/config.ml +++ b/src/client-ocurl/config.ml @@ -1,83 +1,30 @@ -open Common_ - type t = { - debug: bool; - url_traces: string; - url_metrics: string; - url_logs: string; - headers: (string * string) list; - batch_timeout_ms: int; bg_threads: int; + (** Are there background threads, and how many? Default [4]. This will be + adjusted to be at least [1] and at most [32]. *) ticker_thread: bool; + (** If true, start a thread that regularly checks if signals should be + sent to the collector. Default [true] *) ticker_interval_ms: int; - self_trace: bool; + (** Interval for ticker thread, in milliseconds. This is only useful if + [ticker_thread] is [true]. This will be clamped between [2 ms] and + some longer interval (maximum [60s] currently). Default 500. + @since 0.7 *) + common: Client.Config.t; + (** Common configuration options + @since 0.12*) } -let pp out self = - 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; - url_traces; - url_metrics; - url_logs; - headers; - batch_timeout_ms; - bg_threads; - ticker_thread; - ticker_interval_ms; - self_trace; - } = - self - in - Format.fprintf out - "{@[ debug=%B;@ url_traces=%S;@ url_metrics=%S;@ url_logs=%S;@ \ - headers=%a;@ batch_timeout_ms=%d; bg_threads=%d;@ ticker_thread=%B;@ \ - ticker_interval_ms=%d;@ self_trace=%B @]}" - debug url_traces url_metrics url_logs ppheaders headers batch_timeout_ms - bg_threads ticker_thread ticker_interval_ms self_trace +let pp fmt _ = Format.pp_print_string fmt "TODO" -let make ?(debug = !debug_) ?url ?url_traces ?url_metrics ?url_logs - ?(headers = get_headers ()) ?(batch_timeout_ms = 2_000) ?(bg_threads = 4) - ?(ticker_thread = true) ?(ticker_interval_ms = 500) ?(self_trace = false) () - : t = - let bg_threads = max 1 (min bg_threads 32) in +module Env = Client.Config.Env () - 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 - { - debug; - url_traces; - url_metrics; - url_logs; - headers; - batch_timeout_ms; - bg_threads; - ticker_thread; - ticker_interval_ms; - self_trace; - } +let make = + Env.make + (fun + common + ?(bg_threads = 4) + ?(ticker_thread = true) + ?(ticker_interval_ms = 500) + () + -> { bg_threads; ticker_thread; ticker_interval_ms; common }) diff --git a/src/client-ocurl/config.mli b/src/client-ocurl/config.mli index dda875b1..a54a8f3d 100644 --- a/src/client-ocurl/config.mli +++ b/src/client-ocurl/config.mli @@ -1,18 +1,6 @@ (** Configuration for the ocurl backend *) -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_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. *) +type t = { bg_threads: int; (** Are there background threads, and how many? Default [4]. This will be adjusted to be at least [1] and at most [32]. *) @@ -24,56 +12,24 @@ type t = private { [ticker_thread] is [true]. This will be clamped between [2 ms] and some longer interval (maximum [60s] currently). Default 500. @since 0.7 *) - self_trace: bool; - (** If true, the OTEL library will also emit its own spans. Default - [false]. - @since 0.7 *) + common: Client.Config.t; + (** Common configuration options + @since NEXT_RELEASE*) } (** 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 : - ?debug:bool -> - ?url:string -> - ?url_traces:string -> - ?url_metrics:string -> - ?url_logs:string -> - ?headers:(string * string) list -> - ?batch_timeout_ms:int -> - ?bg_threads:int -> + (?bg_threads:int -> ?ticker_thread:bool -> ?ticker_interval_ms:int -> - ?self_trace:bool -> unit -> - t -(** Make a configuration. + t) + Client.Config.make +(** Make a configuration {!t}. *) - @param url - base url used to construct per-signal urls. Per-signal url options take - precedence over this base url. Default is "http://localhost:4318", or - "OTEL_EXPORTER_OTLP_ENDPOINT" if set. - - 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. *) - -val pp : Format.formatter -> t -> unit +module Env : Client.Config.Env diff --git a/src/client-ocurl/dune b/src/client-ocurl/dune index 112c19da..9823b5bc 100644 --- a/src/client-ocurl/dune +++ b/src/client-ocurl/dune @@ -4,6 +4,7 @@ (libraries opentelemetry opentelemetry.atomic + opentelemetry.client curl pbrt threads diff --git a/src/client-ocurl/opentelemetry_client_ocurl.ml b/src/client-ocurl/opentelemetry_client_ocurl.ml index 5502388b..1c4e400e 100644 --- a/src/client-ocurl/opentelemetry_client_ocurl.ml +++ b/src/client-ocurl/opentelemetry_client_ocurl.ml @@ -8,6 +8,10 @@ module Config = Config open Opentelemetry include Common_ +let get_headers = Config.Env.get_headers + +let set_headers = Config.Env.set_headers + let needs_gc_metrics = Atomic.make false let last_gc_metrics = Atomic.make (Mtime_clock.now ()) @@ -147,7 +151,8 @@ end = struct mutable send_threads: Thread.t array; (** Threads that send data via http *) } - let send_http_ ~stop ~config (client : Curl.t) encoder ~url ~encode x : unit = + let send_http_ ~stop ~(config : Config.t) (client : Curl.t) encoder ~url + ~encode x : unit = let@ _sc = Self_trace.with_ ~kind:Span.Span_kind_producer "otel-ocurl.send-http" in @@ -161,11 +166,11 @@ end = struct Pbrt.Encoder.to_string encoder in - if !debug_ || config.Config.debug then + 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.headers + ("Content-Type", "application/x-protobuf") :: config.common.headers in match let@ _sc = @@ -175,14 +180,14 @@ end = struct Ezcurl.post ~headers ~client ~params:[] ~url ~content:(`String data) () with | Ok { code; _ } when code >= 200 && code < 300 -> - if !debug_ || config.debug then + 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 !debug_ || config.debug then ( + if Config.Env.get_debug () then ( let dec = Pbrt.Decoder.of_string body in let body = try @@ -221,7 +226,7 @@ end = struct let x = Logs_service.default_export_logs_service_request ~resource_logs:l () in - send_http_ ~stop ~config client encoder ~url:config.Config.url_logs + send_http_ ~stop ~config client encoder ~url:config.Config.common.url_logs ~encode:Logs_service.encode_pb_export_logs_service_request x let send_metrics_http ~stop ~config curl encoder @@ -236,7 +241,7 @@ end = struct Metrics_service.default_export_metrics_service_request ~resource_metrics:l () in - send_http_ ~stop ~config curl encoder ~url:config.Config.url_metrics + send_http_ ~stop ~config curl encoder ~url:config.Config.common.url_metrics ~encode:Metrics_service.encode_pb_export_metrics_service_request x let send_traces_http ~stop ~config curl encoder @@ -250,7 +255,7 @@ end = struct let x = Trace_service.default_export_trace_service_request ~resource_spans:l () in - send_http_ ~stop ~config curl encoder ~url:config.Config.url_traces + send_http_ ~stop ~config curl encoder ~url:config.Config.common.url_traces ~encode:Trace_service.encode_pb_export_trace_service_request x let[@inline] send_event (self : t) ev : unit = B_queue.push self.q ev @@ -287,7 +292,7 @@ end = struct (Batch.len b > 0 || side != []) && (Batch.len b >= batch_max_size_ || - let timeout = Mtime.Span.(config.Config.batch_timeout_ms * ms) in + 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) @@ -423,7 +428,7 @@ let create_backend ?(stop = Atomic.make false) let timeout_sent_metrics = Mtime.Span.(5 * s) let signal_emit_gc_metrics () = - if !debug_ || config.debug then + if config.common.debug then Printf.eprintf "opentelemetry: emit GC metrics requested\n%!"; Atomic.set needs_gc_metrics true @@ -508,7 +513,7 @@ let setup_ ?(stop = Atomic.make false) ?(config : Config.t = Config.make ()) () let backend = create_backend ~stop ~config () in Opentelemetry.Collector.set_backend backend; - Atomic.set Self_trace.enabled config.self_trace; + Atomic.set Self_trace.enabled config.common.self_trace; if config.ticker_thread then ( (* at most a minute *) diff --git a/src/client/client.ml b/src/client/client.ml new file mode 100644 index 00000000..75b1aae6 --- /dev/null +++ b/src/client/client.ml @@ -0,0 +1,304 @@ +(** Utilities for writing clients + + These are used for implementing e.g., the [opentelemetry-client-cohttp-lwt] + and [opentelemetry-client-ocurl] packages package. *) + +(** Constructing and managing the configuration needed in common by all clients +*) +module Config : sig + 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 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. Default is "http://localhost:4318", or + "OTEL_EXPORTER_OTLP_ENDPOINT" if set. + + 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_confg = + { new_field: string + ; common: t + } + + let make : (?new_field -> unit) 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 +end = struct + 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 + + 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 default_url = "http://localhost:4318" + + 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 +end diff --git a/src/client/dune b/src/client/dune new file mode 100644 index 00000000..e912c8a1 --- /dev/null +++ b/src/client/dune @@ -0,0 +1,4 @@ +(library + (name client) + (public_name opentelemetry.client) + (synopsis "Common types and logic shared between client implementations")) diff --git a/tests/cohttp/test_urls.ml b/tests/cohttp/test_urls.ml index c825539e..0fcd8aca 100644 --- a/tests/cohttp/test_urls.ml +++ b/tests/cohttp/test_urls.ml @@ -1,10 +1,10 @@ open Opentelemetry_client_cohttp_lwt -let test_urls ~name config = +let test_urls ~name (config : Config.t) = Printf.printf "--- %s ---\n" name; - Printf.printf "url_traces = %s\n" config.Config.url_traces; - Printf.printf "url_metrics = %s\n" config.Config.url_metrics; - Printf.printf "url_logs = %s\n" config.Config.url_logs; + Printf.printf "url_traces = %s\n" config.url_traces; + Printf.printf "url_metrics = %s\n" config.url_metrics; + Printf.printf "url_logs = %s\n" config.url_logs; print_endline "------\n" let default_url () = diff --git a/tests/ocurl/test_urls.ml b/tests/ocurl/test_urls.ml index 915a397c..958a8e2a 100644 --- a/tests/ocurl/test_urls.ml +++ b/tests/ocurl/test_urls.ml @@ -2,9 +2,9 @@ open Opentelemetry_client_ocurl let test_urls ~name config = Printf.printf "--- %s ---\n" name; - Printf.printf "url_traces = %s\n" config.Config.url_traces; - Printf.printf "url_metrics = %s\n" config.Config.url_metrics; - Printf.printf "url_logs = %s\n" config.Config.url_logs; + Printf.printf "url_traces = %s\n" config.Config.common.url_traces; + Printf.printf "url_metrics = %s\n" config.Config.common.url_metrics; + Printf.printf "url_logs = %s\n" config.Config.common.url_logs; print_endline "------\n" let default_url () = From 75a8b95176fc3d3583f4e6690080e40a453ea033 Mon Sep 17 00:00:00 2001 From: Shon Feder Date: Tue, 10 Jun 2025 17:45:34 -0400 Subject: [PATCH 2/8] Move Client.Config into its own file --- src/client/client.ml | 300 +----------------------------------------- src/client/config.ml | 171 ++++++++++++++++++++++++ src/client/config.mli | 127 ++++++++++++++++++ 3 files changed, 299 insertions(+), 299 deletions(-) create mode 100644 src/client/config.ml create mode 100644 src/client/config.mli diff --git a/src/client/client.ml b/src/client/client.ml index 75b1aae6..7a911ad0 100644 --- a/src/client/client.ml +++ b/src/client/client.ml @@ -3,302 +3,4 @@ These are used for implementing e.g., the [opentelemetry-client-cohttp-lwt] and [opentelemetry-client-ocurl] packages package. *) -(** Constructing and managing the configuration needed in common by all clients -*) -module Config : sig - 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 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. Default is "http://localhost:4318", or - "OTEL_EXPORTER_OTLP_ENDPOINT" if set. - - 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_confg = - { new_field: string - ; common: t - } - - let make : (?new_field -> unit) 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 -end = struct - 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 - - 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 default_url = "http://localhost:4318" - - 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 -end +module Config = Config diff --git a/src/client/config.ml b/src/client/config.ml new file mode 100644 index 00000000..e8b74065 --- /dev/null +++ b/src/client/config.ml @@ -0,0 +1,171 @@ +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; +} +(** Constructing and managing the configuration needed in common by all clients +*) + +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 + +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 default_url = "http://localhost:4318" + + 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 new file mode 100644 index 00000000..0fece677 --- /dev/null +++ b/src/client/config.mli @@ -0,0 +1,127 @@ +(** 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 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. Default is "http://localhost:4318", or + "OTEL_EXPORTER_OTLP_ENDPOINT" if set. + + 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_confg = + { new_field: string + ; common: t + } + + let make : (?new_field -> unit) 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 From ec0efec6816c18472f95c6343d01601854964704 Mon Sep 17 00:00:00 2001 From: Shon Feder Date: Tue, 10 Jun 2025 17:47:56 -0400 Subject: [PATCH 3/8] Rename Env sig to ENV --- src/client-cohttp-lwt/config.mli | 2 +- src/client-ocurl/config.mli | 2 +- src/client/config.ml | 6 ++---- src/client/config.mli | 4 ++-- 4 files changed, 6 insertions(+), 8 deletions(-) diff --git a/src/client-cohttp-lwt/config.mli b/src/client-cohttp-lwt/config.mli index b7e324bc..69059b08 100644 --- a/src/client-cohttp-lwt/config.mli +++ b/src/client-cohttp-lwt/config.mli @@ -9,4 +9,4 @@ val pp : Format.formatter -> t -> unit val make : (unit -> t) Client.Config.make (** Make a configuration {!t}. *) -module Env : Client.Config.Env +module Env : Client.Config.ENV diff --git a/src/client-ocurl/config.mli b/src/client-ocurl/config.mli index a54a8f3d..13310941 100644 --- a/src/client-ocurl/config.mli +++ b/src/client-ocurl/config.mli @@ -32,4 +32,4 @@ val make : Client.Config.make (** Make a configuration {!t}. *) -module Env : Client.Config.Env +module Env : Client.Config.ENV diff --git a/src/client/config.ml b/src/client/config.ml index e8b74065..2bdb633d 100644 --- a/src/client/config.ml +++ b/src/client/config.ml @@ -10,8 +10,6 @@ type t = { batch_timeout_ms: int; self_trace: bool; } -(** Constructing and managing the configuration needed in common by all clients -*) let pp out (self : t) : unit = let ppiopt = Format.pp_print_option Format.pp_print_int in @@ -52,7 +50,7 @@ type 'k make = ?self_trace:bool -> 'k -module type Env = sig +module type ENV = sig val get_debug : unit -> bool val set_debug : bool -> unit @@ -64,7 +62,7 @@ module type Env = sig val make : (t -> 'a) -> 'a make end -module Env () : Env = struct +module Env () : ENV = struct let debug_ = ref (match Sys.getenv_opt "OTEL_OCAML_DEBUG" with diff --git a/src/client/config.mli b/src/client/config.mli index 0fece677..10b95995 100644 --- a/src/client/config.mli +++ b/src/client/config.mli @@ -85,7 +85,7 @@ type 'k make = (** Construct, inspect, and update {!t} configurations, drawing defaults from the environment and encapsulating state *) -module type Env = sig +module type ENV = sig val get_debug : unit -> bool val set_debug : bool -> unit @@ -124,4 +124,4 @@ 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 +module Env : functor () -> ENV From 90fa0ba3b709c827a35da28f1361b671321093f5 Mon Sep 17 00:00:00 2001 From: Shon Feder Date: Tue, 10 Jun 2025 18:00:04 -0400 Subject: [PATCH 4/8] Add `pp` implemtation for `Client_ocurl.Config` --- src/client-ocurl/config.ml | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/client-ocurl/config.ml b/src/client-ocurl/config.ml index a2f9fb6b..72a772ea 100644 --- a/src/client-ocurl/config.ml +++ b/src/client-ocurl/config.ml @@ -15,7 +15,12 @@ type t = { @since 0.12*) } -let pp fmt _ = Format.pp_print_string fmt "TODO" +let pp out self = + let { bg_threads; ticker_thread; ticker_interval_ms; common } = self in + Format.fprintf out + "{@[ bg_threads=%d;@ ticker_thread=%B;@ ticker_interval_ms=%d;@ common=%a \ + @]}" + bg_threads ticker_thread ticker_interval_ms Client.Config.pp common module Env = Client.Config.Env () From 8511f547d7fa3f912e7f5304e0a2492a1fa5234b Mon Sep 17 00:00:00 2001 From: Shon Feder Date: Tue, 10 Jun 2025 18:11:30 -0400 Subject: [PATCH 5/8] Fix name of library Matches the convention in /src/trace/dune and prevents dependency on the library from polluting the global namespace of a component with the generic `Client` module. --- src/client-cohttp-lwt/config.ml | 6 +++--- src/client-cohttp-lwt/config.mli | 6 +++--- src/client-ocurl/config.ml | 7 ++++--- src/client-ocurl/config.mli | 6 +++--- src/client/dune | 2 +- 5 files changed, 14 insertions(+), 13 deletions(-) diff --git a/src/client-cohttp-lwt/config.ml b/src/client-cohttp-lwt/config.ml index 328b0f46..930881ff 100644 --- a/src/client-cohttp-lwt/config.ml +++ b/src/client-cohttp-lwt/config.ml @@ -1,7 +1,7 @@ -type t = Client.Config.t +type t = Opentelemetry_client.Config.t -module Env = Client.Config.Env () +module Env = Opentelemetry_client.Config.Env () -let pp = Client.Config.pp +let pp = Opentelemetry_client.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 69059b08..100bb696 100644 --- a/src/client-cohttp-lwt/config.mli +++ b/src/client-cohttp-lwt/config.mli @@ -1,4 +1,4 @@ -type t = Client.Config.t +type t = Opentelemetry_client.Config.t (** Configuration. To build one, use {!make} below. This might be extended with more fields in @@ -6,7 +6,7 @@ type t = Client.Config.t val pp : Format.formatter -> t -> unit -val make : (unit -> t) Client.Config.make +val make : (unit -> t) Opentelemetry_client.Config.make (** Make a configuration {!t}. *) -module Env : Client.Config.ENV +module Env : Opentelemetry_client.Config.ENV diff --git a/src/client-ocurl/config.ml b/src/client-ocurl/config.ml index 72a772ea..0954fbe6 100644 --- a/src/client-ocurl/config.ml +++ b/src/client-ocurl/config.ml @@ -10,7 +10,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: Client.Config.t; + common: Opentelemetry_client.Config.t; (** Common configuration options @since 0.12*) } @@ -20,9 +20,10 @@ 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 Client.Config.pp common + bg_threads ticker_thread ticker_interval_ms Opentelemetry_client.Config.pp + common -module Env = Client.Config.Env () +module Env = Opentelemetry_client.Config.Env () let make = Env.make diff --git a/src/client-ocurl/config.mli b/src/client-ocurl/config.mli index 13310941..8519d8c8 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: Client.Config.t; + common: Opentelemetry_client.Config.t; (** Common configuration options @since NEXT_RELEASE*) } @@ -29,7 +29,7 @@ val make : ?ticker_interval_ms:int -> unit -> t) - Client.Config.make + Opentelemetry_client.Config.make (** Make a configuration {!t}. *) -module Env : Client.Config.ENV +module Env : Opentelemetry_client.Config.ENV diff --git a/src/client/dune b/src/client/dune index e912c8a1..2bc4e4a5 100644 --- a/src/client/dune +++ b/src/client/dune @@ -1,4 +1,4 @@ (library - (name client) + (name opentelemetry_client) (public_name opentelemetry.client) (synopsis "Common types and logic shared between client implementations")) From 0b2faca4692285c8804ab94561a101f7bca25272 Mon Sep 17 00:00:00 2001 From: Shon Feder Date: Wed, 11 Jun 2025 00:10:28 -0400 Subject: [PATCH 6/8] Add tests for Opentelemetry.Client.Config --- tests/client/dune | 4 +++ tests/client/test_client_lib.ml | 46 +++++++++++++++++++++++++++++++++ 2 files changed, 50 insertions(+) create mode 100644 tests/client/dune create mode 100644 tests/client/test_client_lib.ml diff --git a/tests/client/dune b/tests/client/dune new file mode 100644 index 00000000..a8c9c961 --- /dev/null +++ b/tests/client/dune @@ -0,0 +1,4 @@ +(tests + (names test_client_lib) + (package opentelemetry) + (libraries alcotest opentelemetry.client)) diff --git a/tests/client/test_client_lib.ml b/tests/client/test_client_lib.ml new file mode 100644 index 00000000..c3f8a360 --- /dev/null +++ b/tests/client/test_client_lib.ml @@ -0,0 +1,46 @@ +open Alcotest +module Config = Opentelemetry_client.Config + +let test_config_printing () = + let module Env = Config.Env () in + let actual = + 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 }|} + 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; + ] + +let () = Alcotest.run "Opentelemetry_client" [ "Config", suite ] From 48926c25e52d69f4da81af91975062911b2f163d Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Jun 2025 09:20:22 -0400 Subject: [PATCH 7/8] Update src/client/config.mli Co-authored-by: Corentin Leruth --- src/client/config.mli | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/client/config.mli b/src/client/config.mli index 10b95995..13bb52d6 100644 --- a/src/client/config.mli +++ b/src/client/config.mli @@ -110,8 +110,8 @@ module type ENV = sig ; common: t } - let make : (?new_field -> unit) make = - Env.make (fun common ?new_field () -> {new_field; common}) + let make : (new_field:string -> unit) make = + Env.make (fun common ~new_field () -> {new_field; common}) let _example : extended_config = make ~new_field:"foo" ~url_traces:"foo/bar" ~debug:true () From 08c6f32efe3e7fe208d1dd15b9f9dd723cc2a8a2 Mon Sep 17 00:00:00 2001 From: Shon Feder Date: Wed, 11 Jun 2025 14:23:06 -0400 Subject: [PATCH 8/8] Fix documentation example --- src/client/config.mli | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/client/config.mli b/src/client/config.mli index 13bb52d6..f3a4e6ec 100644 --- a/src/client/config.mli +++ b/src/client/config.mli @@ -105,13 +105,13 @@ module type ENV = sig more specific field like so: {[ - type extended_confg = - { new_field: string - ; common: t - } + type extended_config = { + new_field: string; + common: t; + } - let make : (new_field:string -> unit) make = - Env.make (fun common ~new_field () -> {new_field; common}) + 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 ()