Merge pull request #20 from psafont/hackathon-2022-05-03

feat: Allow setting API headers

src/client/common_.ml

@@ -20,7 +20,16 @@ let[@inline] with_mutex_ m f =
   Mutex.lock m;
   Fun.protect ~finally:(fun () -> Mutex.unlock m) f
 
+let parse_headers s =
+  let parse_header s = Scanf.sscanf s "%s@=%s" (fun key value -> key, value) in
+  String.split_on_char ',' s |> List.map parse_header
+
 let default_url = "http://localhost:4318"
+let default_headers = []
 let url = ref (try Sys.getenv "OTEL_EXPORTER_OTLP_ENDPOINT" with _ -> default_url)
+let headers = ref (try parse_headers (Sys.getenv "OTEL_EXPORTER_OTLP_HEADERS") with _ -> default_headers)
 let get_url () = !url
 let set_url s = url := s
+
+let get_headers () = !headers
+let set_headers s = headers := s

src/client/config.ml

@@ -4,6 +4,7 @@ open Common_
 type t = {
   debug: bool;
   url: string;
+  headers: (string * string) list;
   batch_traces: int option;
   batch_metrics: int option;
   batch_timeout_ms: int;
@@ -13,23 +14,28 @@ type t = {
 
 let pp out self =
   let ppiopt = Format.pp_print_option Format.pp_print_int in
-  let {debug; url; batch_traces; batch_metrics;
+  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; headers; batch_traces; batch_metrics;
        batch_timeout_ms; thread; ticker_thread} = self in
   Format.fprintf out
-    "{@[ debug=%B;@ url=%S;@ \
+    "{@[ debug=%B;@ url=%S;@ headers=%a;@ \
      batch_traces=%a;@ batch_metrics=%a;@ \
      batch_timeout_ms=%d; thread=%B;@ ticker_thread=%B @]}"
-    debug url ppiopt batch_traces ppiopt batch_metrics
+    debug url ppheaders headers ppiopt batch_traces ppiopt batch_metrics
     batch_timeout_ms thread ticker_thread
 
 let make
     ?(debug= !debug_)
     ?(url= get_url())
+    ?(headers= get_headers ())
     ?(batch_traces=Some 400)
     ?(batch_metrics=None)
     ?(batch_timeout_ms=500)
     ?(thread=true)
     ?(ticker_thread=true)
     () : t =
-  { debug; url; batch_traces; batch_metrics; batch_timeout_ms;
+  { debug; url; headers; batch_traces; batch_metrics; batch_timeout_ms;
     thread; ticker_thread; }

src/client/config.mli

@@ -6,6 +6,10 @@ type t = {
   (** Url of the endpoint. Default is "http://localhost:4318",
       or "OTEL_EXPORTER_OTLP_ENDPOINT" if set. *)
 
+  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.
@@ -40,6 +44,7 @@ type t = {
 
 val make :
   ?debug:bool -> ?url:string ->
+  ?headers:(string * string) list ->
   ?batch_traces:int option ->
   ?batch_metrics:int option ->
   ?batch_timeout_ms:int ->

src/client/opentelemetry_client_ocurl.ml

@@ -70,7 +70,9 @@ module Curl() : CURL = struct
     if !debug_ then Curl.set_verbose curl true;
     Curl.set_url curl (!url ^ path);
     Curl.set_httppost curl [];
-    Curl.set_httpheader curl ["Content-Type: application/x-protobuf"];
+    let to_http_header (k, v) = Printf.sprintf "%s: %s" k v in
+    let http_headers = List.map to_http_header !headers in
+    Curl.set_httpheader curl ("Content-Type: application/x-protobuf" :: http_headers);
     (* write body *)
     Curl.set_post curl true;
     Curl.set_postfieldsize curl (String.length bod);

src/client/opentelemetry_client_ocurl.mli

@@ -10,6 +10,11 @@ val set_url : string -> unit
 (** Url of the endpoint. Default is "http://localhost:4318",
     or "OTEL_EXPORTER_OTLP_ENDPOINT" if set. *)
 
+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. *)
+
 val set_mutex : lock:(unit -> unit) -> unlock:(unit -> unit) -> unit
 (** Set a lock/unlock pair to protect the critical sections
     of {!Opentelemetry.Collector.BACKEND} *)