Source file `mimic_happy_eyeballs.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
module type S = sig
  type t
  type flow

  val happy_eyeballs : t Mimic.value

  val resolve :
    t ->
    ?aaaa_timeout:int64 ->
    ?connect_delay:int64 ->
    ?connect_timeout:int64 ->
    ?resolve_timeout:int64 ->
    ?resolve_retries:int ->
    string ->
    int list ->
    ((Ipaddr.t * int) * flow, [> `Msg of string ]) result Lwt.t
end

module Make
    (Stack : Tcpip.Stack.V4V6)
    (Happy_eyeballs : Happy_eyeballs_mirage.S
                        with type flow = Stack.TCP.flow
                         and type stack = Stack.t)
    (_ : Dns_client_mirage.S
           with type happy_eyeballs = Happy_eyeballs.t
            and type Transport.stack = Stack.t * Happy_eyeballs.t) : sig
  include S with type t = Happy_eyeballs.t and type flow = Stack.TCP.flow

  val connect : Happy_eyeballs.t -> Mimic.ctx Lwt.t
end = struct
  type t = Happy_eyeballs.t
  type flow = Stack.TCP.flow

  let happy_eyeballs = Mimic.make ~name:"mimic-happy-eyeballs"
  let resolve = Happy_eyeballs.connect
  let connect he = Lwt.return (Mimic.add happy_eyeballs he Mimic.empty)
end