~ Result.bind

This commit is contained in:
swrup 2025-11-02 15:42:43 +01:00
parent f899f5a3a8
commit cba8ce5e6d

View file

@ -105,21 +105,24 @@ struct
end
let decode_uri ~ctx uri =
let ( >>= ) = Result.bind in
let ( let* ) = Result.bind in
match String.split_on_char '/' uri with
| proto :: "" :: user_pass_host_port :: _path ->
(if String.equal proto "http:" then
Ok ("http", Mimic.add connect_scheme "http" ctx)
else if String.equal proto "https:" then
Ok ("https", Mimic.add connect_scheme "https" ctx)
else Error (`Msg "Couldn't decode user and password"))
>>= fun (_scheme, ctx) ->
(match String.split_on_char '@' user_pass_host_port with
let* _scheme, ctx =
if String.equal proto "http:" then
Ok ("http", Mimic.add connect_scheme "http" ctx)
else if String.equal proto "https:" then
Ok ("https", Mimic.add connect_scheme "https" ctx)
else Error (`Msg "Couldn't decode user and password")
in
let* _user_pass, host_port =
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"))
>>= fun (_user_pass, host_port) ->
(match String.split_on_char ':' host_port with
| _ -> Error (`Msg "Couldn't decode URI")
in
let* hostname, ctx =
match String.split_on_char ':' host_port with
| [] -> Error (`Msg "Empty host & port")
| [ hostname ] -> Ok (hostname, Mimic.add connect_hostname hostname ctx)
| hd :: tl -> (
@ -133,17 +136,18 @@ let decode_uri ~ctx uri =
( 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)
with Failure _ -> Error (`Msg "Couldn't decode port"))
in
Ok (ctx, hostname)
| _ -> Error (`Msg "Couldn't decode URI on top")
let tls_config ?tls_config authenticator =
let ( let* ) = Result.bind in
lazy
(match tls_config with
| Some cfg -> Ok (`Custom cfg)
| None ->
let alpn_protocols = [ "h2"; "http/1.1" ] in
let ( let* ) = Result.bind in
let* authenticator = authenticator in
let* cfg = Tls.Config.client ~alpn_protocols ~authenticator () in
Ok (`Default cfg))