This commit is contained in:
swrup 2025-10-30 15:51:03 +01:00
parent 2847432240
commit f4d9f8e618
8 changed files with 124 additions and 55 deletions

View file

@ -20,7 +20,10 @@ struct
type endpoint = Happy_eyeballs.t * string * int
type nonrec write_error =
[ `Write of write_error | `Connect of string | `Closed ]
[ `Write of write_error
| `Connect of string
| `Closed
]
let pp_write_error ppf = function
| `Connect err -> Fmt.string ppf err
@ -82,10 +85,8 @@ struct
Mimic.fold tcp_edn
Mimic.Fun.
[
req Happy_eyeballs.happy_eyeballs;
req connect_scheme;
req connect_hostname;
dft connect_port 80;
req Happy_eyeballs.happy_eyeballs; req connect_scheme;
req connect_hostname; dft connect_port 80;
]
~k:k0 ctx
in
@ -93,11 +94,8 @@ struct
Mimic.fold tls_edn
Mimic.Fun.
[
req Happy_eyeballs.happy_eyeballs;
req connect_scheme;
req connect_hostname;
dft connect_port 443;
req connect_tls_config;
req Happy_eyeballs.happy_eyeballs; req connect_scheme;
req connect_hostname; dft connect_port 443; req connect_tls_config;
]
~k:k1 ctx
in
@ -117,25 +115,25 @@ let decode_uri ~ctx uri =
else Error (`Msg "Couldn't decode user and password"))
>>= fun (_scheme, ctx) ->
(match String.split_on_char '@' user_pass_host_port with
| [ host_port ] -> Ok (None, host_port)
| [ _user_pass; host_port ] -> Ok (None, host_port)
| _ -> Error (`Msg "Couldn't decode URI"))
| [ host_port ] -> Ok (None, host_port)
| [ _user_pass; host_port ] -> Ok (None, host_port)
| _ -> Error (`Msg "Couldn't decode URI"))
>>= fun (_user_pass, host_port) ->
(match String.split_on_char ':' host_port with
| [] -> Error (`Msg "Empty host & port")
| [ hostname ] -> Ok (hostname, Mimic.add connect_hostname hostname ctx)
| hd :: tl -> (
let port, hostname =
match List.rev (hd :: tl) with
| hd :: tl -> (hd, String.concat ":" (List.rev tl))
| _ -> assert false
in
try
Ok
( hostname,
Mimic.add connect_hostname hostname
(Mimic.add connect_port (int_of_string port) ctx) )
with Failure _ -> Error (`Msg "Couldn't decode port")))
| [] -> Error (`Msg "Empty host & port")
| [ hostname ] -> Ok (hostname, Mimic.add connect_hostname hostname ctx)
| hd :: tl -> (
let port, hostname =
match List.rev (hd :: tl) with
| hd :: tl -> (hd, String.concat ":" (List.rev tl))
| _ -> assert false
in
try
Ok
( hostname,
Mimic.add connect_hostname hostname
(Mimic.add connect_port (int_of_string port) ctx) )
with Failure _ -> Error (`Msg "Couldn't decode port")))
>>= fun (hostname, ctx) -> Ok (ctx, hostname)
| _ -> Error (`Msg "Couldn't decode URI on top")