Improve the API to be more user-friendly (@pitag-ha)
This commit is contained in:
parent
a4a7358c4d
commit
809fa5cd33
2 changed files with 35 additions and 29 deletions
|
@ -5,16 +5,23 @@ let tls_config = Mimic.make ~name:"tls-config"
|
||||||
|
|
||||||
open Lwt.Infix
|
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
|
module type S = sig
|
||||||
val connect : Mimic.ctx -> Mimic.ctx Lwt.t
|
type nonrec t = t
|
||||||
val alpn_protocol : Mimic.flow -> string option
|
|
||||||
val authenticator : (X509.Authenticator.t, [> `Msg of string ]) result
|
val connect : Mimic.ctx -> t Lwt.t
|
||||||
end
|
end
|
||||||
|
|
||||||
module Make
|
module Make
|
||||||
(Pclock : Mirage_clock.PCLOCK)
|
(Pclock : Mirage_clock.PCLOCK)
|
||||||
(TCP : Tcpip.Tcp.S)
|
(TCP : Tcpip.Tcp.S)
|
||||||
(Happy_eyeballs : Mimic_happy_eyeballs.S with type flow = TCP.flow) : S = struct
|
(Happy_eyeballs : Mimic_happy_eyeballs.S with type flow = TCP.flow) : S = struct
|
||||||
|
type nonrec t = t
|
||||||
|
|
||||||
module TCP = struct
|
module TCP = struct
|
||||||
include TCP
|
include TCP
|
||||||
type endpoint = Happy_eyeballs.t * string * int
|
type endpoint = Happy_eyeballs.t * string * int
|
||||||
|
@ -60,23 +67,6 @@ module Make
|
||||||
let tls_edn, tls_protocol =
|
let tls_edn, tls_protocol =
|
||||||
Mimic.register ~name:"tls" (module TLS)
|
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 alpn_protocol flow =
|
||||||
let module M = (val (Mimic.repr tls_protocol)) in
|
let module M = (val (Mimic.repr tls_protocol)) in
|
||||||
match flow with
|
match flow with
|
||||||
|
@ -89,6 +79,24 @@ module Make
|
||||||
let authenticator =
|
let authenticator =
|
||||||
let module V = Ca_certs_nss.Make (Pclock) in
|
let module V = Ca_certs_nss.Make (Pclock) in
|
||||||
V.authenticator ()
|
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
|
end
|
||||||
|
|
||||||
module Version = Httpaf.Version
|
module Version = Httpaf.Version
|
||||||
|
@ -310,9 +318,7 @@ let resolve_location ~uri ~location =
|
||||||
let one_request
|
let one_request
|
||||||
?config
|
?config
|
||||||
?tls_config:cfg
|
?tls_config:cfg
|
||||||
~ctx
|
{ ctx; alpn_protocol; authenticator; }
|
||||||
~alpn_protocol
|
|
||||||
~authenticator
|
|
||||||
?(meth= `GET)
|
?(meth= `GET)
|
||||||
?(headers= [])
|
?(headers= [])
|
||||||
?body
|
?body
|
||||||
|
|
|
@ -1,7 +1,9 @@
|
||||||
|
type t
|
||||||
|
|
||||||
module type S = sig
|
module type S = sig
|
||||||
val connect : Mimic.ctx -> Mimic.ctx Lwt.t
|
type nonrec t = t
|
||||||
val alpn_protocol : Mimic.flow -> string option
|
|
||||||
val authenticator : (X509.Authenticator.t, [> `Msg of string ]) result
|
val connect : Mimic.ctx -> t Lwt.t
|
||||||
end
|
end
|
||||||
|
|
||||||
module Make
|
module Make
|
||||||
|
@ -22,9 +24,7 @@ type response =
|
||||||
val one_request :
|
val one_request :
|
||||||
?config:[ `H2 of H2.Config.t | `HTTP_1_1 of Httpaf.Config.t ] ->
|
?config:[ `H2 of H2.Config.t | `HTTP_1_1 of Httpaf.Config.t ] ->
|
||||||
?tls_config:Tls.Config.client ->
|
?tls_config:Tls.Config.client ->
|
||||||
ctx:Mimic.ctx ->
|
t ->
|
||||||
alpn_protocol:(Mimic.flow -> string option) ->
|
|
||||||
authenticator:(X509.Authenticator.t, [> `Msg of string ]) result ->
|
|
||||||
?meth:Httpaf.Method.t ->
|
?meth:Httpaf.Method.t ->
|
||||||
?headers:(string * string) list ->
|
?headers:(string * string) list ->
|
||||||
?body:string ->
|
?body:string ->
|
||||||
|
|
Loading…
Reference in a new issue