robur/http-mirage-client
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve the API to be more user-friendly (@pitag-ha)

Browse source
This commit is contained in:
Romain Calascibetta 2022-10-17 14:36:15 +02:00
parent a4a7358c4d
commit 809fa5cd33
2 changed files with 35 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

52
src/http_mirage_client.ml
View file

@ -5,16 +5,23 @@ let tls_config = Mimic.make ~name:"tls-config"
open Lwt.Infix
type t =
{ ctx : Mimic.ctx
; alpn_protocol : Mimic.flow -> string option
; authenticator : (X509.Authenticator.t, [ `Msg of string ]) result }
module type S = sig
val connect : Mimic.ctx -> Mimic.ctx Lwt.t
val alpn_protocol : Mimic.flow -> string option
val authenticator : (X509.Authenticator.t, [> `Msg of string ]) result
type nonrec t = t
val connect : Mimic.ctx -> t Lwt.t
end
module Make
(Pclock : Mirage_clock.PCLOCK)
(TCP : Tcpip.Tcp.S)
(Happy_eyeballs : Mimic_happy_eyeballs.S with type flow = TCP.flow) : S = struct
type nonrec t = t
module TCP = struct
include TCP
type endpoint = Happy_eyeballs.t * string * int
@ -60,23 +67,6 @@ module Make
let tls_edn, tls_protocol =
Mimic.register ~name:"tls" (module TLS)
let connect ctx =
let k0 happy_eyeballs http_scheme http_hostname http_port = match http_scheme with
| "http" -> Lwt.return_some (happy_eyeballs, http_hostname, http_port)
| _ -> Lwt.return_none in
let k1 happy_eyeballs http_scheme http_hostname http_port tls_config = match http_scheme with
| "https" -> Lwt.return_some (happy_eyeballs, tls_config, http_hostname, http_port)
| _ -> Lwt.return_none in
let ctx = Mimic.fold tcp_edn
Mimic.Fun.[ req Happy_eyeballs.happy_eyeballs
; req http_scheme; req http_hostname; dft http_port 80 ]
~k:k0 ctx in
Lwt.return (Mimic.fold tls_edn
Mimic.Fun.[ req Happy_eyeballs.happy_eyeballs
; req http_scheme; req http_hostname; dft http_port 443
; req tls_config ]
~k:k1 ctx)
let alpn_protocol flow =
let module M = (val (Mimic.repr tls_protocol)) in
match flow with
@ -89,6 +79,24 @@ module Make
let authenticator =
let module V = Ca_certs_nss.Make (Pclock) in
V.authenticator ()
let connect ctx =
let k0 happy_eyeballs http_scheme http_hostname http_port = match http_scheme with
| "http" -> Lwt.return_some (happy_eyeballs, http_hostname, http_port)
| _ -> Lwt.return_none in
let k1 happy_eyeballs http_scheme http_hostname http_port tls_config = match http_scheme with
| "https" -> Lwt.return_some (happy_eyeballs, tls_config, http_hostname, http_port)
| _ -> Lwt.return_none in
let ctx = Mimic.fold tcp_edn
Mimic.Fun.[ req Happy_eyeballs.happy_eyeballs
; req http_scheme; req http_hostname; dft http_port 80 ]
~k:k0 ctx in
let ctx = Mimic.fold tls_edn
Mimic.Fun.[ req Happy_eyeballs.happy_eyeballs
; req http_scheme; req http_hostname; dft http_port 443
; req tls_config ]
~k:k1 ctx in
Lwt.return { ctx; alpn_protocol; authenticator; }
end
module Version = Httpaf.Version
@ -310,9 +318,7 @@ let resolve_location ~uri ~location =
let one_request
?config
?tls_config:cfg
~ctx
~alpn_protocol
~authenticator
{ ctx; alpn_protocol; authenticator; }
?(meth= `GET)
?(headers= [])
?body

12
src/http_mirage_client.mli
View file

@ -1,7 +1,9 @@
type t
module type S = sig
val connect : Mimic.ctx -> Mimic.ctx Lwt.t
val alpn_protocol : Mimic.flow -> string option
val authenticator : (X509.Authenticator.t, [> `Msg of string ]) result
type nonrec t = t
val connect : Mimic.ctx -> t Lwt.t
end
module Make
@ -22,9 +24,7 @@ type response =
val one_request :
?config:[ `H2 of H2.Config.t | `HTTP_1_1 of Httpaf.Config.t ] ->
?tls_config:Tls.Config.client ->
ctx:Mimic.ctx ->
alpn_protocol:(Mimic.flow -> string option) ->
authenticator:(X509.Authenticator.t, [> `Msg of string ]) result ->
t ->
?meth:Httpaf.Method.t ->
?headers:(string * string) list ->
?body:string ->