simon/ocaml-opentelemetry
1
0
Fork 0
mirror of https://github.com/ocaml-tracing/ocaml-opentelemetry.git synced 2026-03-07 18:37:56 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

add missing OTEL env variables

Browse source 
- Rename http_config to exporter_config with deprecated alias
- add OTEL_SDK_DISABLED support (sdk_disabled field)
- add OTEL_EXPORTER_OTLP_PROTOCOL support (Http_protobuf | Http_json)
- add OTEL_LOG_LEVEL support (log_level field replacing debug bool)
- add OTEL_EXPORTER_OTLP_TIMEOUT and per-signal timeout variants
- add per-signal headers
(OTEL_EXPORTER_OTLP_{TRACES,METRICS,LOGS}_HEADERS)
- add OTEL_SERVICE_NAME support

also remove some globals and put most config in `exporter_config.ml`,
which is no longer a private record.
This commit is contained in:
Simon Cruanes 2026-02-12 12:34:28 +00:00
parent 9696dfb511
commit 69d1d512e3
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
14 changed files with 556 additions and 369 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
src/client-cohttp-eio/opentelemetry_client_cohttp_eio.ml
View file

@ -9,10 +9,6 @@ open Opentelemetry_client
let spf = Printf.sprintf
let set_headers = Config.Env.set_headers
let get_headers = Config.Env.get_headers
module Make (CTX : sig
val sw : Eio.Switch.t
@ -91,13 +87,13 @@ struct
let cleanup = ignore
(* send the content to the remote endpoint/path *)
let send (client : t) ~url ~decode (body : string) :
let send (client : t) ~url ~headers:user_headers ~decode (body : string) :
('a, Export_error.t) result =
Eio.Switch.run @@ fun sw ->
let uri = Uri.of_string url in
let open Cohttp in
let headers = Header.(add_list (init ()) (Config.Env.get_headers ())) in
let headers = Header.(add_list (init ()) user_headers) in
let headers =
Header.(add headers "Content-Type" "application/x-protobuf")
in

5
src/client-cohttp-eio/opentelemetry_client_cohttp_eio.mli
View file

@ -3,11 +3,6 @@
https://opentelemetry.io/docs/reference/specification/protocol/exporter/
*)
val get_headers : unit -> (string * string) list
val set_headers : (string * string) list -> unit
(** Set http headers that are sent on every http query to the collector. *)
module Config = Config
val create_consumer :

9
src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.ml
View file

@ -8,10 +8,6 @@ open Opentelemetry_client
open Opentelemetry
open Common_
let set_headers = Config.Env.set_headers
let get_headers = Config.Env.get_headers
type error = Export_error.t
open struct
@ -31,11 +27,12 @@ module Httpc : Generic_http_consumer.HTTPC with module IO = IO = struct
let cleanup _self = ()
(* send the content to the remote endpoint/path *)
let send (_self : t) ~url ~decode (bod : string) : ('a, error) result Lwt.t =
let send (_self : t) ~url ~headers:user_headers ~decode (bod : string) :
('a, error) result Lwt.t =
let uri = Uri.of_string url in
let open Cohttp in
let headers = Header.(add_list (init ()) (Config.Env.get_headers ())) in
let headers = Header.(add_list (init ()) user_headers) in
let headers =
Header.(
add_list headers

5
src/client-cohttp-lwt/opentelemetry_client_cohttp_lwt.mli
View file

@ -3,11 +3,6 @@
https://opentelemetry.io/docs/reference/specification/protocol/exporter/
*)
val get_headers : unit -> (string * string) list
val set_headers : (string * string) list -> unit
(** Set http headers that are sent on every http query to the collector. *)
module Config = Config
val create_consumer :

9
src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.ml
View file

@ -8,10 +8,6 @@ open Opentelemetry
open Opentelemetry_client
open Common_
let set_headers = Config.Env.set_headers
let get_headers = Config.Env.get_headers
type error = Export_error.t
open struct
@ -30,12 +26,13 @@ module Httpc : Generic_http_consumer.HTTPC with module IO = IO = struct
let cleanup self = Ezcurl_lwt.delete self
(** send the content to the remote endpoint/path *)
let send (self : t) ~url ~decode (bod : string) : ('a, error) result Lwt.t =
let send (self : t) ~url ~headers:user_headers ~decode (bod : string) :
('a, error) result Lwt.t =
let* r =
let headers =
("Content-Type", "application/x-protobuf")
:: ("Accept", "application/x-protobuf")
:: Config.Env.get_headers ()
:: user_headers
in
Ezcurl_lwt.post ~client:self ~headers ~params:[] ~url
~content:(`String bod) ()

5
src/client-ocurl-lwt/opentelemetry_client_ocurl_lwt.mli
View file

@ -3,11 +3,6 @@
https://opentelemetry.io/docs/reference/specification/protocol/exporter/
*)
val get_headers : unit -> (string * string) list
val set_headers : (string * string) list -> unit
(** Set http headers that are sent on every http query to the collector. *)
module Config = Config
val create_consumer :

9
src/client-ocurl/opentelemetry_client_ocurl.ml
View file

@ -8,10 +8,6 @@ module OTELC = Opentelemetry_client
module OTEL = Opentelemetry
open Common_
let get_headers = Config.Env.get_headers
let set_headers = Config.Env.set_headers
let n_bytes_sent : int Atomic.t = Atomic.make 0
type error = OTELC.Export_error.t
@ -30,12 +26,13 @@ module Httpc : OTELC.Generic_http_consumer.HTTPC with module IO = IO = struct
let cleanup = Ezcurl.delete
let send (self : t) ~url ~decode (bod : string) : ('a, error) result =
let send (self : t) ~url ~headers:user_headers ~decode (bod : string) :
('a, error) result =
let r =
let headers =
("Content-Type", "application/x-protobuf")
:: ("Accept", "application/x-protobuf")
:: Config.Env.get_headers ()
:: user_headers
in
Ezcurl.post ~client:self ~headers ~params:[] ~url ~content:(`String bod)
()

5
src/client-ocurl/opentelemetry_client_ocurl.mli
View file

@ -3,11 +3,6 @@
https://opentelemetry.io/docs/reference/specification/protocol/exporter/
*)
val get_headers : unit -> (string * string) list
val set_headers : (string * string) list -> unit
(** Set http headers that are sent on every http query to the collector. *)
module Config = Config
val n_bytes_sent : unit -> int

332
src/client/exporter_config.ml Normal file
View file

@ -0,0 +1,332 @@
type protocol =
| Http_protobuf
| Http_json
type log_level =
| Log_level_none
| Log_level_error
| Log_level_warn
| Log_level_info
| Log_level_debug
type rest = unit
type t = {
debug: bool; [@alert deprecated "Use log_level instead"]
log_level: log_level;
sdk_disabled: bool;
url_traces: string;
url_metrics: string;
url_logs: string;
headers: (string * string) list;
headers_traces: (string * string) list;
headers_metrics: (string * string) list;
headers_logs: (string * string) list;
protocol: protocol;
timeout_ms: int;
timeout_traces_ms: int;
timeout_metrics_ms: int;
timeout_logs_ms: int;
batch_traces: int option;
batch_metrics: int option;
batch_logs: int option;
batch_timeout_ms: int;
self_trace: bool;
http_concurrency_level: int option;
_rest: rest;
}
let pp out (self : t) : unit =
let ppiopt out i =
match i with
| None -> Format.fprintf out "None"
| Some i -> Format.fprintf out "%d" i
in
let pp_header ppf (a, b) = Format.fprintf ppf "@[%s: @,%s@]@." a b in
let ppheaders out l =
Format.fprintf out "[@[%a@]]" (Format.pp_print_list pp_header) l
in
let pp_protocol out = function
| Http_protobuf -> Format.fprintf out "http/protobuf"
| Http_json -> Format.fprintf out "http/json"
in
let pp_log_level out = function
| Log_level_none -> Format.fprintf out "none"
| Log_level_error -> Format.fprintf out "error"
| Log_level_warn -> Format.fprintf out "warn"
| Log_level_info -> Format.fprintf out "info"
| Log_level_debug -> Format.fprintf out "debug"
in
let {
debug;
log_level;
sdk_disabled;
self_trace;
url_traces;
url_metrics;
url_logs;
headers;
headers_traces;
headers_metrics;
headers_logs;
protocol;
timeout_ms;
timeout_traces_ms;
timeout_metrics_ms;
timeout_logs_ms;
batch_traces;
batch_metrics;
batch_logs;
batch_timeout_ms;
http_concurrency_level;
_rest = _;
} =
self
in
Format.fprintf out
"{@[ debug=%B;@ log_level=%a;@ sdk_disabled=%B;@ self_trace=%B;@ \
url_traces=%S;@ url_metrics=%S;@ url_logs=%S;@ @[<2>headers=@,\
%a@];@ @[<2>headers_traces=@,\
%a@];@ @[<2>headers_metrics=@,\
%a@];@ @[<2>headers_logs=@,\
%a@];@ protocol=%a;@ timeout_ms=%d;@ timeout_traces_ms=%d;@ \
timeout_metrics_ms=%d;@ timeout_logs_ms=%d;@ batch_traces=%a;@ \
batch_metrics=%a;@ batch_logs=%a;@ batch_timeout_ms=%d;@ \
http_concurrency_level=%a @]}"
debug pp_log_level log_level sdk_disabled self_trace url_traces url_metrics
url_logs ppheaders headers ppheaders headers_traces ppheaders
headers_metrics ppheaders headers_logs pp_protocol protocol timeout_ms
timeout_traces_ms timeout_metrics_ms timeout_logs_ms ppiopt batch_traces
ppiopt batch_metrics ppiopt batch_logs batch_timeout_ms ppiopt
http_concurrency_level
let default_url = "http://localhost:4318"
type 'k make =
?debug:bool ->
?log_level:log_level ->
?sdk_disabled:bool ->
?url:string ->
?url_traces:string ->
?url_metrics:string ->
?url_logs:string ->
?batch_traces:int option ->
?batch_metrics:int option ->
?batch_logs:int option ->
?headers:(string * string) list ->
?headers_traces:(string * string) list ->
?headers_metrics:(string * string) list ->
?headers_logs:(string * string) list ->
?protocol:protocol ->
?timeout_ms:int ->
?timeout_traces_ms:int ->
?timeout_metrics_ms:int ->
?timeout_logs_ms:int ->
?batch_timeout_ms:int ->
?self_trace:bool ->
?http_concurrency_level:int ->
'k
module type ENV = sig
val make : (t -> 'a) -> 'a make
end
module Env () : ENV = struct
let get_debug_from_env () =
match Sys.getenv_opt "OTEL_OCAML_DEBUG" with
| Some ("1" | "true") -> true
| _ -> false
let get_log_level_from_env () =
match Sys.getenv_opt "OTEL_LOG_LEVEL" with
| Some "none" -> Log_level_none
| Some "error" -> Log_level_error
| Some "warn" -> Log_level_warn
| Some "info" -> Log_level_info
| Some "debug" -> Log_level_debug
| Some s ->
Printf.eprintf "warning: unknown log level %S\n%!" s;
Log_level_none
| None ->
if get_debug_from_env () then
Log_level_debug
else
Log_level_none
let get_sdk_disabled_from_env () =
match Sys.getenv_opt "OTEL_SDK_DISABLED" with
| Some ("true" | "1") -> true
| _ -> false
let get_protocol_from_env env_name =
match Sys.getenv_opt env_name with
| Some "http/protobuf" -> Http_protobuf
| Some "http/json" -> Http_json
| _ -> Http_protobuf
let get_timeout_from_env env_name default =
match Sys.getenv_opt env_name with
| Some s -> (try int_of_string s with _ -> default)
| None -> default
let make_get_from_env env_name =
let value = ref None in
fun () ->
match !value with
| None ->
value := Sys.getenv_opt env_name;
!value
| Some value -> Some value
let get_url_from_env = make_get_from_env "OTEL_EXPORTER_OTLP_ENDPOINT"
let get_url_traces_from_env =
make_get_from_env "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT"
let get_url_metrics_from_env =
make_get_from_env "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT"
let get_url_logs_from_env =
make_get_from_env "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT"
let remove_trailing_slash url =
if url <> "" && String.get url (String.length url - 1) = '/' then
String.sub url 0 (String.length url - 1)
else
url
let parse_headers s =
let parse_header s =
match String.split_on_char '=' s with
| [ key; value ] -> key, value
| _ -> failwith "Unexpected format for header"
in
String.split_on_char ',' s |> List.map parse_header
let get_headers_from_env env_name =
try parse_headers (Sys.getenv env_name) with _ -> []
let get_general_headers_from_env () =
try parse_headers (Sys.getenv "OTEL_EXPORTER_OTLP_HEADERS") with _ -> []
let merge_headers base specific =
(* Signal-specific headers override generic ones *)
let specific_keys = List.map fst specific in
let filtered_base =
List.filter (fun (k, _) -> not (List.mem k specific_keys)) base
in
List.rev_append specific filtered_base
let make k ?(debug = get_debug_from_env ())
?(log_level = get_log_level_from_env ())
?(sdk_disabled = get_sdk_disabled_from_env ()) ?url ?url_traces
?url_metrics ?url_logs ?(batch_traces = Some 400)
?(batch_metrics = Some 200) ?(batch_logs = Some 400)
?(headers = get_general_headers_from_env ()) ?headers_traces
?headers_metrics ?headers_logs
?(protocol = get_protocol_from_env "OTEL_EXPORTER_OTLP_PROTOCOL")
?(timeout_ms = get_timeout_from_env "OTEL_EXPORTER_OTLP_TIMEOUT" 10_000)
?timeout_traces_ms ?timeout_metrics_ms ?timeout_logs_ms
?(batch_timeout_ms = 2_000) ?(self_trace = false) ?http_concurrency_level
=
let url_traces, url_metrics, url_logs =
let base_url =
let base_url =
match get_url_from_env () with
| None -> Option.value url ~default:default_url
| Some url -> remove_trailing_slash url
in
remove_trailing_slash base_url
in
let url_traces =
match get_url_traces_from_env () with
| None -> Option.value url_traces ~default:(base_url ^ "/v1/traces")
| Some url -> url
in
let url_metrics =
match get_url_metrics_from_env () with
| None -> Option.value url_metrics ~default:(base_url ^ "/v1/metrics")
| Some url -> url
in
let url_logs =
match get_url_logs_from_env () with
| None -> Option.value url_logs ~default:(base_url ^ "/v1/logs")
| Some url -> url
in
url_traces, url_metrics, url_logs
in
(* Get per-signal headers from env vars *)
let env_headers_traces =
get_headers_from_env "OTEL_EXPORTER_OTLP_TRACES_HEADERS"
in
let env_headers_metrics =
get_headers_from_env "OTEL_EXPORTER_OTLP_METRICS_HEADERS"
in
let env_headers_logs =
get_headers_from_env "OTEL_EXPORTER_OTLP_LOGS_HEADERS"
in
(* Merge with provided headers, env-specific takes precedence *)
let headers_traces =
match headers_traces with
| Some h -> h
| None -> merge_headers headers env_headers_traces
in
let headers_metrics =
match headers_metrics with
| Some h -> h
| None -> merge_headers headers env_headers_metrics
in
let headers_logs =
match headers_logs with
| Some h -> h
| None -> merge_headers headers env_headers_logs
in
(* Get per-signal timeouts from env vars with fallback to general timeout *)
let timeout_traces_ms =
match timeout_traces_ms with
| Some t -> t
| None ->
get_timeout_from_env "OTEL_EXPORTER_OTLP_TRACES_TIMEOUT" timeout_ms
in
let timeout_metrics_ms =
match timeout_metrics_ms with
| Some t -> t
| None ->
get_timeout_from_env "OTEL_EXPORTER_OTLP_METRICS_TIMEOUT" timeout_ms
in
let timeout_logs_ms =
match timeout_logs_ms with
| Some t -> t
| None ->
get_timeout_from_env "OTEL_EXPORTER_OTLP_LOGS_TIMEOUT" timeout_ms
in
k
{
debug;
log_level;
sdk_disabled;
url_traces;
url_metrics;
url_logs;
headers;
headers_traces;
headers_metrics;
headers_logs;
protocol;
timeout_ms;
timeout_traces_ms;
timeout_metrics_ms;
timeout_logs_ms;
batch_traces;
batch_metrics;
batch_logs;
batch_timeout_ms;
self_trace;
http_concurrency_level;
_rest = ();
}
end

190
src/client/exporter_config.mli Normal file
View file

@ -0,0 +1,190 @@
(** Constructing and managing the configuration common to many (most?)
HTTP-based clients.
This is extended and reused by concrete client implementations that exports
signals over HTTP, depending on their needs. *)
type protocol =
| Http_protobuf
| Http_json
type log_level =
| Log_level_none
| Log_level_error
| Log_level_warn
| Log_level_info
| Log_level_debug
type rest
(** Opaque type to force using {!make} while allowing record updates *)
type t = {
debug: bool; [@alert deprecated "Use log_level instead"]
(** @deprecated Use {!log_level} instead. Debug the client itself? *)
log_level: log_level;
(** Log level for internal diagnostics. Read from OTEL_LOG_LEVEL or falls
back to OTEL_OCAML_DEBUG for compatibility. *)
sdk_disabled: bool;
(** If true, the SDK is completely disabled and no-ops. Read from
OTEL_SDK_DISABLED. Default false. *)
url_traces: string; (** Url to send traces/spans *)
url_metrics: string; (** Url to send metrics*)
url_logs: string; (** Url to send logs *)
headers: (string * string) list;
(** Global API headers sent to all endpoints. Default is none or
"OTEL_EXPORTER_OTLP_HEADERS" if set. Signal-specific headers can
override these. *)
headers_traces: (string * string) list;
(** Headers for traces endpoint. Merges OTEL_EXPORTER_OTLP_HEADERS with
OTEL_EXPORTER_OTLP_TRACES_HEADERS (signal-specific takes precedence).
*)
headers_metrics: (string * string) list;
(** Headers for metrics endpoint. Merges OTEL_EXPORTER_OTLP_HEADERS with
OTEL_EXPORTER_OTLP_METRICS_HEADERS (signal-specific takes precedence).
*)
headers_logs: (string * string) list;
(** Headers for logs endpoint. Merges OTEL_EXPORTER_OTLP_HEADERS with
OTEL_EXPORTER_OTLP_LOGS_HEADERS (signal-specific takes precedence). *)
protocol: protocol;
(** Wire protocol to use. Read from OTEL_EXPORTER_OTLP_PROTOCOL. Default
Http_protobuf. *)
timeout_ms: int;
(** General timeout in milliseconds for exporter operations. Read from
OTEL_EXPORTER_OTLP_TIMEOUT. Default 10_000. *)
timeout_traces_ms: int;
(** Timeout for trace exports. Read from
OTEL_EXPORTER_OTLP_TRACES_TIMEOUT, falls back to timeout_ms. *)
timeout_metrics_ms: int;
(** Timeout for metric exports. Read from
OTEL_EXPORTER_OTLP_METRICS_TIMEOUT, falls back to timeout_ms. *)
timeout_logs_ms: int;
(** Timeout for log exports. Read from OTEL_EXPORTER_OTLP_LOGS_TIMEOUT,
falls back to timeout_ms. *)
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
[Some 200]. *)
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 perform some self-instrumentation.
Default [false].
@since 0.7 *)
http_concurrency_level: int option;
(** How many HTTP requests can be done simultaneously (at most)? This can
be used to represent the size of a pool of workers where each worker
gets a batch to send, send it, and repeats.
@since NEXT_RELEASE *)
_rest: rest;
}
(** Configuration.
To build one, use {!make} below. This might be extended with more fields in
the future. *)
val default_url : string
(** The default base URL for the config. *)
val pp : Format.formatter -> t -> unit
type 'k make =
?debug:bool ->
?log_level:log_level ->
?sdk_disabled:bool ->
?url:string ->
?url_traces:string ->
?url_metrics:string ->
?url_logs:string ->
?batch_traces:int option ->
?batch_metrics:int option ->
?batch_logs:int option ->
?headers:(string * string) list ->
?headers_traces:(string * string) list ->
?headers_metrics:(string * string) list ->
?headers_logs:(string * string) list ->
?protocol:protocol ->
?timeout_ms:int ->
?timeout_traces_ms:int ->
?timeout_metrics_ms:int ->
?timeout_logs_ms:int ->
?batch_timeout_ms:int ->
?self_trace:bool ->
?http_concurrency_level:int ->
'k
(** A function that gathers all the values needed to construct a {!t}, and
produces a ['k]. ['k] is typically a continuation used to construct a
configuration that includes a {!t}.
@param url
base url used to construct per-signal urls. Per-signal url options take
precedence over this base url. If not provided, this defaults to
"OTEL_EXPORTER_OTLP_ENDPOINT" if set, or if not {!default_url}.
Example of constructed per-signal urls with the base url
http://localhost:4318
- Traces: http://localhost:4318/v1/traces
- Metrics: http://localhost:4318/v1/metrics
- Logs: http://localhost:4318/v1/logs
Use per-signal url options if different urls are needed for each signal
type.
@param url_traces
url to send traces, or "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" if set. The
url is used as-is without any modification.
@param url_metrics
url to send metrics, or "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT" if set. The
url is used as-is without any modification.
@param url_logs
url to send logs, or "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT" if set. The url is
used as-is without any modification. *)
(** Construct, inspect, and update {!t} configurations, drawing defaults from
the environment *)
module type ENV = sig
val make : (t -> 'a) -> 'a make
(** [make f] is a {!type:make} function that will give [f] a safely
constructed {!t}.
Typically this is used to extend the constructor for {!t} with new
optional arguments.
E.g., we can construct a configuration that includes a {!t} alongside a
more specific field like so:
{[
type extended_config = {
new_field: string;
common: t;
}
let make : (new_field:string -> unit -> extended_config) make =
Env.make (fun common ~new_field () -> { new_field; common })
let _example : extended_config =
make ~new_field:"foo" ~url_traces:"foo/bar" ~debug:true ()
]}
As a special case, we can get the simple constructor function for {!t}
with [Env.make (fun common () -> common)] *)
end
(** A generative functor that produces a state-space that can read configuration
values from the environment, provide stateful configuration setting and
accessing operations, and a way to make a new {!t} configuration record *)
module Env : functor () -> ENV

19
src/client/generic_http_consumer.ml
View file

@ -19,6 +19,7 @@ module type HTTPC = sig
val send :
t ->
url:string ->
headers:(string * string) list ->
decode:[ `Dec of Pbrt.Decoder.t -> 'a | `Ret of 'a ] ->
string ->
('a, error) result IO.t
@ -62,14 +63,22 @@ end = struct
let send (self : t) (sigs : OTEL.Any_signal_l.t) : (unit, error) result IO.t
=
let res = Resource_signal.of_signal_l sigs in
let url =
let url, signal_headers =
match res with
| Logs _ -> self.config.url_logs
| Traces _ -> self.config.url_traces
| Metrics _ -> self.config.url_metrics
| Logs _ -> self.config.url_logs, self.config.headers_logs
| Traces _ -> self.config.url_traces, self.config.headers_traces
| Metrics _ -> self.config.url_metrics, self.config.headers_metrics
in
(* Merge general headers with signal-specific ones (signal-specific takes precedence) *)
let signal_keys = List.map fst signal_headers in
let filtered_general =
List.filter
(fun (k, _) -> not (List.mem k signal_keys))
self.config.headers
in
let headers = List.rev_append signal_headers filtered_general in
let data = Resource_signal.Encode.any ~encoder:self.encoder res in
Httpc.send self.http ~url ~decode:(`Ret ()) data
Httpc.send self.http ~url ~headers ~decode:(`Ret ()) data
end
module C = Generic_consumer.Make (IO) (Notifier) (Sender)

183
src/client/http_config.ml
View file

@ -1,182 +1,3 @@
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;
http_concurrency_level: int option;
}
(** @deprecated Use {!Exporter_config} instead *)
let pp out (self : t) : unit =
let ppiopt out i =
match i with
| None -> Format.fprintf out "None"
| Some i -> Format.fprintf out "%d" i
in
let pp_header ppf (a, b) = Format.fprintf ppf "@[%s: @,%s@]@." a b in
let ppheaders out l =
Format.fprintf out "[@[%a@]]" (Format.pp_print_list pp_header) l
in
let {
debug;
self_trace;
url_traces;
url_metrics;
url_logs;
headers;
batch_traces;
batch_metrics;
batch_logs;
batch_timeout_ms;
http_concurrency_level;
} =
self
in
Format.fprintf out
"{@[ debug=%B;@ self_trace=%B; url_traces=%S;@ url_metrics=%S;@ \
url_logs=%S;@ @[<2>headers=@,\
%a@];@ batch_traces=%a;@ batch_metrics=%a;@ batch_logs=%a;@ \
batch_timeout_ms=%d;@ http_concurrency_level=%a @]}"
debug self_trace url_traces url_metrics url_logs ppheaders headers ppiopt
batch_traces ppiopt batch_metrics ppiopt batch_logs batch_timeout_ms ppiopt
http_concurrency_level
let default_url = "http://localhost:4318"
type 'k make =
?debug:bool ->
?url:string ->
?url_traces:string ->
?url_metrics:string ->
?url_logs:string ->
?batch_traces:int option ->
?batch_metrics:int option ->
?batch_logs:int option ->
?headers:(string * string) list ->
?batch_timeout_ms:int ->
?self_trace:bool ->
?http_concurrency_level:int ->
'k
module type ENV = sig
val get_debug : unit -> bool
val set_debug : bool -> unit
val get_headers : unit -> (string * string) list
val set_headers : (string * string) list -> unit
val make : (t -> 'a) -> 'a make
end
module Env () : ENV = struct
let debug_ =
ref
(match Sys.getenv_opt "OTEL_OCAML_DEBUG" with
| Some ("1" | "true") -> true
| _ -> false)
let get_debug () = !debug_
let set_debug b = debug_ := b
let make_get_from_env env_name =
let value = ref None in
fun () ->
match !value with
| None ->
value := Sys.getenv_opt env_name;
!value
| Some value -> Some value
let get_url_from_env = make_get_from_env "OTEL_EXPORTER_OTLP_ENDPOINT"
let get_url_traces_from_env =
make_get_from_env "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT"
let get_url_metrics_from_env =
make_get_from_env "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT"
let get_url_logs_from_env =
make_get_from_env "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT"
let remove_trailing_slash url =
if url <> "" && String.get url (String.length url - 1) = '/' then
String.sub url 0 (String.length url - 1)
else
url
let parse_headers s =
let parse_header s =
match String.split_on_char '=' s with
| [ key; value ] -> key, value
| _ -> failwith "Unexpected format for header"
in
String.split_on_char ',' s |> List.map parse_header
let default_headers = []
let headers =
ref
(try parse_headers (Sys.getenv "OTEL_EXPORTER_OTLP_HEADERS")
with _ -> default_headers)
let get_headers () = !headers
let set_headers s = headers := s
let make k ?(debug = get_debug ()) ?url ?url_traces ?url_metrics ?url_logs
?(batch_traces = Some 400) ?(batch_metrics = Some 200)
?(batch_logs = Some 400) ?(headers = get_headers ())
?(batch_timeout_ms = 2_000) ?(self_trace = false) ?http_concurrency_level
=
(* 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;
http_concurrency_level;
}
end
include Exporter_config

140
src/client/http_config.mli
View file

@ -1,139 +1,3 @@
(** Constructing and managing the configuration common to many (most?)
HTTP-based clients.
(** @deprecated Use {!Exporter_config} instead *)
This is extended and reused by concrete client implementations that exports
signals over HTTP, depending on their needs. *)
type t = private {
debug: bool; (** Debug the client itself? *)
url_traces: string; (** Url to send traces/spans *)
url_metrics: string; (** Url to send metrics*)
url_logs: string; (** Url to send logs *)
headers: (string * string) list;
(** 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
[Some 200]. *)
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 perform some self-instrumentation.
Default [false].
@since 0.7 *)
http_concurrency_level: int option;
(** How many HTTP requests can be done simultaneously (at most)? This can
be used to represent the size of a pool of workers where each worker
gets a batch to send, send it, and repeats.
@since NEXT_RELEASE *)
}
(** Configuration.
To build one, use {!make} below. This might be extended with more fields in
the future. *)
val default_url : string
(** The default base URL for the config. *)
val pp : Format.formatter -> t -> unit
type 'k make =
?debug:bool ->
?url:string ->
?url_traces:string ->
?url_metrics:string ->
?url_logs:string ->
?batch_traces:int option ->
?batch_metrics:int option ->
?batch_logs:int option ->
?headers:(string * string) list ->
?batch_timeout_ms:int ->
?self_trace:bool ->
?http_concurrency_level:int ->
'k
(** A function that gathers all the values needed to construct a {!t}, and
produces a ['k]. ['k] is typically a continuation used to construct a
configuration that includes a {!t}.
@param url
base url used to construct per-signal urls. Per-signal url options take
precedence over this base url. If not provided, this defaults to
"OTEL_EXPORTER_OTLP_ENDPOINT" if set, or if not {!default_url}.
Example of constructed per-signal urls with the base url
http://localhost:4318
- Traces: http://localhost:4318/v1/traces
- Metrics: http://localhost:4318/v1/metrics
- Logs: http://localhost:4318/v1/logs
Use per-signal url options if different urls are needed for each signal
type.
@param url_traces
url to send traces, or "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT" if set. The
url is used as-is without any modification.
@param url_metrics
url to send metrics, or "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT" if set. The
url is used as-is without any modification.
@param url_logs
url to send logs, or "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT" if set. The url is
used as-is without any modification. *)
(** Construct, inspect, and update {!t} configurations, drawing defaults from
the environment and encapsulating state *)
module type ENV = sig
val get_debug : unit -> bool
val set_debug : bool -> unit
val get_headers : unit -> (string * string) list
val set_headers : (string * string) list -> unit
val make : (t -> 'a) -> 'a make
(** [make f] is a {!type:make} function that will give [f] a safely
constructed {!t}.
Typically this is used to extend the constructor for {!t} with new
optional arguments.
E.g., we can construct a configuration that includes a {!t} alongside a
more specific field like so:
{[
type extended_config = {
new_field: string;
common: t;
}
let make : (new_field:string -> unit -> extended_config) make =
Env.make (fun common ~new_field () -> { new_field; common })
let _example : extended_config =
make ~new_field:"foo" ~url_traces:"foo/bar" ~debug:true ()
]}
As a special case, we can get the simple constructor function for {!t}
with [Env.make (fun common () -> common)] *)
end
(** A generative functor that produces a state-space that can read configuration
values from the environment, provide stateful configuration setting and
accessing operations, and a way to make a new {!t} configuration record *)
module Env : functor () -> ENV
include module type of Exporter_config

6
src/lib/globals.ml
View file

@ -4,7 +4,11 @@ open Common_
open Proto.Common
(** Main service name metadata *)
let service_name = ref "unknown_service"
let service_name =
ref
(match Sys.getenv_opt "OTEL_SERVICE_NAME" with
| Some name -> name
| None -> "unknown_service")
(** Namespace for the service *)
let service_namespace = ref None