CP-49677 implement Http.Url using URI

The struture of Http.Url is unfortunate and we currently can't cange it
but we can use a better and more concise implementation using URI.

Signed-off-by: Christian Lindig <[email protected]>

ocaml/libs/http-lib/http.ml

@@ -934,81 +934,42 @@ module Url = struct
     scheme_equal a_scheme b_scheme && data_equal a_data b_data
 
   let of_string url =
-    let sub_before c s = String.sub s 0 (String.index s c) in
-    let sub_after c s =
-      let length = String.length s in
-      let start = String.index s c + 1 in
-      String.sub s start (length - start)
-    in
-    let host x =
-      try x |> sub_after '[' |> sub_before ']'
-      with Not_found -> (
-        try (* [<ipv6-literal>]... *)
-            x |> sub_before ':'
-        with Not_found -> (* <hostname|ipv4-literal>:... *)
-                          x
-      )
-    in
-    (* <hostname|ipv4-literal> *)
-    let port x =
-      let port_part =
-        try x |> sub_after ']' |> sub_after ':'
-        with Not_found -> (
-          try (* ...]:port *)
-              x |> sub_after ']'
-          with Not_found -> (
-            try (* ...] *)
-                x |> sub_after ':'
-            with Not_found -> (* ...:port *)
-                              ""
-          )
-        )
-      in
-      (* no port *)
-      try Some (int_of_string port_part) with _ -> None
-    in
-    let uname_password_host_port x =
-      match Astring.String.cuts ~sep:"@" x with
-      | [_] ->
-          (None, host x, port x)
-      | [uname_password; host_port] -> (
-        match Astring.String.cuts ~sep:":" uname_password with
-        | [uname; password] ->
-            (Some (Basic (uname, password)), host host_port, port host_port)
+    debug "%s: %s" __FUNCTION__ url ;
+    let fail fmt = Printf.ksprintf failwith fmt in
+    let query = function k, v :: _ -> (k, v) | k, [] -> (k, "") in
+    try
+      let uri = Uri.of_string url in
+      debug "%s: %s" __FUNCTION__ (Uri.to_string uri) ;
+      let auth =
+        match (Uri.user uri, Uri.password uri) with
+        | Some user, Some pw ->
+            Some (Basic (user, pw))
+        | Some user, None ->
+            Some (Basic (user, ""))
         | _ ->
-            failwith
-              (Printf.sprintf "Failed to parse authentication substring: %s"
-                 uname_password
-              )
-      )
+            None
+      in
+      let data =
+        {
+          uri= (match Uri.path uri with "" -> "/" | path -> path)
+        ; query_params= Uri.query uri |> List.map query
+        }
+      in
+      let scheme ~ssl =
+        Http {host= Uri.host uri |> Option.get; auth; port= Uri.port uri; ssl}
+      in
+      match Uri.scheme uri with
+      | Some "http" ->
+          (scheme ~ssl:false, data)
+      | Some "https" ->
+          (scheme ~ssl:true, data)
+      | Some "file" ->
+          let scheme = File {path= Uri.path uri} in
+          (scheme, {data with uri= "/"})
       | _ ->
-          failwith
-            (Printf.sprintf
-               "Failed to parse username password host and port: %s" x
-            )
-    in
-    let reconstruct_uri uri = "/" ^ String.concat "/" uri in
-    let data_of_uri uri =
-      let uri, params = parse_uri (reconstruct_uri uri) in
-      {uri; query_params= params}
-    in
-    let http_or_https ssl x =
-      let uname_password, host, port = uname_password_host_port x in
-      let scheme = Http {host; port; auth= uname_password; ssl} in
-      scheme
-    in
-    match Astring.String.cuts ~sep:"/" url with
-    | "http:" :: "" :: x :: uri ->
-        (http_or_https false x, data_of_uri uri)
-    | "https:" :: "" :: x :: uri ->
-        (http_or_https true x, data_of_uri uri)
-    | "file:" :: uri ->
-        let uri, params = parse_uri (reconstruct_uri uri) in
-        (File {path= uri}, {uri= "/"; query_params= params})
-    | x :: _ ->
-        failwith (Printf.sprintf "Unknown scheme %s" x)
-    | _ ->
-        failwith (Printf.sprintf "Failed to parse URL: %s" url)
+          failwith "unsupported URI scheme"
+    with e ->
+      fail "%s: can't parse '%s': %s" __FUNCTION__ url (Printexc.to_string e)
 
   let data_to_string {uri; query_params= params} =
     let kvpairs x =
@@ -1018,27 +979,31 @@ module Url = struct
     let params = if params = [] then "" else "?" ^ kvpairs params in
     uri ^ params
 
-  let to_string = function
-    | File {path}, data ->
-        (* this should have file:// *)
-        Printf.sprintf "file:%s%s" path (data_to_string data)
-        (* XXX *)
-    | Http h, {uri; query_params= params} ->
-        let auth =
-          match h.auth with
-          | Some (Basic (username, password)) ->
-              Printf.sprintf "%s:%s" username password |> Option.some
-          | _ ->
-              Option.none
-        in
-        Uri.(
-          make
+  let to_string scheme =
+    let query (k, v) = (k, [v]) in
+    let str =
+      match scheme with
+      | File {path}, {query_params= params; _} ->
+          Uri.make ~scheme:"file" ~path ~query:(List.map query params) ()
+          |> Uri.to_string
+      | Http h, {uri; query_params= params} ->
+          let auth =
+            match h.auth with
+            | Some (Basic (username, password)) ->
+                Printf.sprintf "%s:%s" username password
+                |> Uri.pct_encode
+                |> Option.some
+            | _ ->
+                Option.none
+          in
+          Uri.make
             ~scheme:(if h.ssl then "https" else "http")
             ~host:h.host ?port:h.port ?userinfo:auth ~path:uri
-            ~query:(List.map (fun (k, v) -> (k, [v])) params)
-            ()
-          |> to_string
-        )
+            ~query:(List.map query params) ()
+          |> Uri.to_string
+    in
+    debug "%s: %s" __FUNCTION__ str ;
+    str
 
   let get_uri (_scheme, data) = data.uri