From d62f680fc3bebd26c6815fbe3b0b0197f658aa8d Mon Sep 17 00:00:00 2001 From: Shon Feder Date: Mon, 9 Jun 2025 21:12:44 -0400 Subject: [PATCH] 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 () =