From 546a06441c648d10ff1f420f43a46cbab38aa044 Mon Sep 17 00:00:00 2001
From: Romain Calascibetta <romain.calascibetta@gmail.com>
Date: Mon, 17 Oct 2022 15:10:54 +0200
Subject: [PATCH] Be able to specify our own authenticator

---
 src/http_mirage_client.ml  | 10 +++++++---
 src/http_mirage_client.mli |  1 +
 2 files changed, 8 insertions(+), 3 deletions(-)

diff --git a/src/http_mirage_client.ml b/src/http_mirage_client.ml
index 1c14f73..2b0f81d 100644
--- a/src/http_mirage_client.ml
+++ b/src/http_mirage_client.ml
@@ -291,7 +291,7 @@ let single_request ~ctx ~alpn_protocol ?config cfg ~meth ~headers ?body uri =
   Mimic.close flow >|= fun () ->
   r
 
-let tls_config ?tls_config ?config authenticator =
+let tls_config ?tls_config ?config authenticator user's_authenticator =
   lazy ( match tls_config with
   | Some cfg -> Ok (`Custom cfg)
   | None ->
@@ -299,7 +299,10 @@ let tls_config ?tls_config ?config authenticator =
       | None -> [ "h2"; "http/1.1" ]
       | Some (`H2 _) -> [ "h2" ]
       | Some (`HTTP_1_1 _) -> [ "http/1.1" ] in
-    Result.map (fun authenticator -> `Default (Tls.Config.client ~alpn_protocols ~authenticator ())) authenticator )
+    match authenticator, user's_authenticator with
+    | Ok authenticator, None -> Ok (`Default (Tls.Config.client ~alpn_protocols ~authenticator ()))
+    | _, Some authenticator -> Ok (`Default (Tls.Config.client ~alpn_protocols ~authenticator ()))
+    | (Error _ as err), None -> err )
 
 let resolve_location ~uri ~location =
   match String.split_on_char '/' location with
@@ -319,12 +322,13 @@ let one_request
   ?config
   ?tls_config:cfg
   { ctx; alpn_protocol; authenticator; }
+  ?authenticator:user's_authenticator
   ?(meth= `GET)
   ?(headers= [])
   ?body
   ?(max_redirect= 5)
   ?(follow_redirect= true) uri =
-  let tls_config = tls_config ?tls_config:cfg ?config authenticator in
+  let tls_config = tls_config ?tls_config:cfg ?config authenticator user's_authenticator in
   if not follow_redirect
   then single_request ~ctx ~alpn_protocol ?config tls_config ~meth ~headers ?body uri
   else
diff --git a/src/http_mirage_client.mli b/src/http_mirage_client.mli
index 12303c0..2ab7e8c 100644
--- a/src/http_mirage_client.mli
+++ b/src/http_mirage_client.mli
@@ -25,6 +25,7 @@ val one_request :
   ?config:[ `H2 of H2.Config.t | `HTTP_1_1 of Httpaf.Config.t ] ->
   ?tls_config:Tls.Config.client ->
   t ->
+  ?authenticator:X509.Authenticator.t ->
   ?meth:Httpaf.Method.t ->
   ?headers:(string * string) list ->
   ?body:string ->