Source file config.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
type t = {
  debug: bool;
  url_traces: string;
  url_metrics: string;
  url_logs: string;
  headers: (string * string) list;
  batch_traces: int option;
  batch_metrics: int option;
  batch_logs: int option;
  batch_timeout_ms: int;
  self_trace: bool;
}

let pp out (self : t) : unit =
  let ppiopt = Format.pp_print_option Format.pp_print_int in
  let pp_header ppf (a, b) = Format.fprintf ppf "@[%s: @,%s@]@." a b in
  let ppheaders = Format.pp_print_list pp_header in
  let {
    debug;
    self_trace;
    url_traces;
    url_metrics;
    url_logs;
    headers;
    batch_traces;
    batch_metrics;
    batch_logs;
    batch_timeout_ms;
  } =
    self
  in
  Format.fprintf out
    "{@[ debug=%B;@ self_trace=%B; url_traces=%S;@ url_metrics=%S;@ \
     url_logs=%S;@ headers=%a;@ batch_traces=%a;@ batch_metrics=%a;@ \
     batch_logs=%a;@ batch_timeout_ms=%d @]}"
    debug self_trace url_traces url_metrics url_logs ppheaders headers ppiopt
    batch_traces ppiopt batch_metrics ppiopt batch_logs batch_timeout_ms

let default_url = "http://localhost:4318"

type 'k make =
  ?debug:bool ->
  ?url:string ->
  ?url_traces:string ->
  ?url_metrics:string ->
  ?url_logs:string ->
  ?batch_traces:int option ->
  ?batch_metrics:int option ->
  ?batch_logs:int option ->
  ?headers:(string * string) list ->
  ?batch_timeout_ms:int ->
  ?self_trace:bool ->
  'k

module type ENV = sig
  val get_debug : unit -> bool

  val set_debug : bool -> unit

  val get_headers : unit -> (string * string) list

  val set_headers : (string * string) list -> unit

  val make : (t -> 'a) -> 'a make
end

module Env () : ENV = struct
  let debug_ =
    ref
      (match Sys.getenv_opt "OTEL_OCAML_DEBUG" with
      | Some ("1" | "true") -> true
      | _ -> false)

  let get_debug () = !debug_

  let set_debug b = debug_ := b

  let make_get_from_env env_name =
    let value = ref None in
    fun () ->
      match !value with
      | None ->
        value := Sys.getenv_opt env_name;
        !value
      | Some value -> Some value

  let get_url_from_env = make_get_from_env "OTEL_EXPORTER_OTLP_ENDPOINT"

  let get_url_traces_from_env =
    make_get_from_env "OTEL_EXPORTER_OTLP_TRACES_ENDPOINT"

  let get_url_metrics_from_env =
    make_get_from_env "OTEL_EXPORTER_OTLP_METRICS_ENDPOINT"

  let get_url_logs_from_env =
    make_get_from_env "OTEL_EXPORTER_OTLP_LOGS_ENDPOINT"

  let remove_trailing_slash url =
    if url <> "" && String.get url (String.length url - 1) = '/' then
      String.sub url 0 (String.length url - 1)
    else
      url

  let parse_headers s =
    let parse_header s =
      match String.split_on_char '=' s with
      | [ key; value ] -> key, value
      | _ -> failwith "Unexpected format for header"
    in
    String.split_on_char ',' s |> List.map parse_header

  let default_headers = []

  let headers =
    ref
      (try parse_headers (Sys.getenv "OTEL_EXPORTER_OTLP_HEADERS")
       with _ -> default_headers)

  let get_headers () = !headers

  let set_headers s = headers := s

  let make k ?(debug = get_debug ()) ?url ?url_traces ?url_metrics ?url_logs
      ?(batch_traces = Some 400) ?(batch_metrics = Some 20)
      ?(batch_logs = Some 400) ?(headers = get_headers ())
      ?(batch_timeout_ms = 2_000) ?(self_trace = false) =
    (* Ensure the state is synced, in case these values are passed in explicitly *)
    set_debug debug;
    set_headers headers;
    let url_traces, url_metrics, url_logs =
      let base_url =
        let base_url =
          match get_url_from_env () with
          | None -> Option.value url ~default:default_url
          | Some url -> remove_trailing_slash url
        in
        remove_trailing_slash base_url
      in
      let url_traces =
        match get_url_traces_from_env () with
        | None -> Option.value url_traces ~default:(base_url ^ "/v1/traces")
        | Some url -> url
      in
      let url_metrics =
        match get_url_metrics_from_env () with
        | None -> Option.value url_metrics ~default:(base_url ^ "/v1/metrics")
        | Some url -> url
      in
      let url_logs =
        match get_url_logs_from_env () with
        | None -> Option.value url_logs ~default:(base_url ^ "/v1/logs")
        | Some url -> url
      in
      url_traces, url_metrics, url_logs
    in
    k
      {
        debug;
        url_traces;
        url_metrics;
        url_logs;
        headers;
        batch_traces;
        batch_metrics;
        batch_logs;
        batch_timeout_ms;
        self_trace;
      }
end