test_runner.ml

(*
 * Copyright (c) 2012-2014 Anil Madhavapeddy <anil@recoil.org>
 * Copyright (c) 2012-2014 David Sheets <sheets@alum.mit.edu>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *
 *)

open OUnit
open Printf

(* Tuples of decoded and encoded strings. The first element is a number to
   refer to the test, as the pcts_large version duplicates the second field
   to a large size, so it cant be used as the name of the test *)
let pcts = [
  (1, "hello world!", "hello%20world!");
  (2, "[", "%5B");
  (3, "[[[[[", "%5B%5B%5B%5B%5B");
  (4, "1]", "1%5D");
  (5, "%20", "%2520");
  (6, "", "");
  (7, "f", "f");
  (8, "\001", "%01");
  (9, "\n", "%0A");
]

(* Make an artificially large string version of the pct strings *)
let pcts_large =
  List.map (fun (n,a,b) ->
    let num = 100000 in
    let a' = Buffer.create (String.length a * num) in
    let b' = Buffer.create (String.length b * num) in
    for _ = 1 to num do
      Buffer.add_string a' a;
      Buffer.add_string b' b;
    done;
    (n, Buffer.contents a', Buffer.contents b')
  ) pcts

(* Tuple of string URI and the decoded version *)
let uri_encodes = [
  "https://user:pass@foo.com:123/wh/at/ever?foo=1&bar=5#5",
   (Uri.make ~scheme:"https" ~userinfo:"user:pass" ~host:"foo.com"
      ~port:123 ~path:"/wh/at/ever" ~query:["foo",["1"];"bar",["5"]] ~fragment:"5" ());
  "http://foo.com", (Uri.make ~scheme:"http" ~host:"foo.com" ());
  "http://foo-bar.com", (Uri.make ~scheme:"http" ~host:"foo-bar.com" ());
  "http://foo-bar.com:8080/h1", (Uri.make ~scheme:"http" ~host:"foo-bar.com" ~port:8080 ~path:"/h1" ());
  "http://foo%21.com", (Uri.make ~scheme:"http" ~host:"foo!.com" ());
  "/wh/at/ev/er", (Uri.make ~path:"/wh/at/ev/er" ());
  "/wh/at!/ev%20/er", (Uri.make ~path:"/wh/at!/ev /er" ());
  (* IPv6 literal *)
  "http://[dead:beef::dead:0:beaf]",
    (Uri.make ~scheme:"http" ~host:"[dead:beef::dead:0:beaf]" ());
  "http://user:pass@[2001:41d1:fe67:500:227:c6ff:fe5a:efa0]:6789/wh/at/ever?foo=1&bar=5#5",
  (Uri.make ~scheme:"http" ~userinfo:"user:pass" ~host:"[2001:41d1:fe67:500:227:c6ff:fe5a:efa0]"
     ~port:6789 ~path:"/wh/at/ever" ~query:["foo",["1"];"bar",["5"]] ~fragment:"5" ());
  (* IPv6 literal with zone id *)
  "http://user:pass@%5B2001%3A41d1%3Afe67%3A500%3A227%3Ac6ff%3Afe5a%3Aefa0%25wlan0%5D:6789/wh/at/ever?foo=1&bar=5#5",
  (Uri.make ~scheme:"http" ~userinfo:"user:pass" ~host:"[2001:41d1:fe67:500:227:c6ff:fe5a:efa0%wlan0]"
     ~port:6789 ~path:"/wh/at/ever" ~query:["foo",["1"];"bar",["5"]] ~fragment:"5" ());
  "foo+bar:", (Uri.make ~scheme:"foo+bar" ());
  "foo+bar:///", (Uri.make ~scheme:"foo+bar" ~host:"" ~path:"/" ());
  "foo2-bar.baz:///", (Uri.make ~scheme:"foo2-bar.baz" ~host:"" ~path:"/" ());
  "//foobar.com/quux", (Uri.make ~host:"foobar.com" ~path:"quux" ());
  "quux%2F%20", (Uri.make ~path:"quux%2f " ());
  "urn:uuid:f81d4fae-7dec-11d0-a765-00a0c91e6bf6",
  (Uri.make ~scheme:"urn" ~path:"uuid:f81d4fae-7dec-11d0-a765-00a0c91e6bf6" ());
]

let map_pcts_tests size _name test args =
  List.map (fun (n, a,b) ->
    let name = sprintf "pct_%s:%d:%s" size n a in
    let a1, b1 = test a b in
    let test () = assert_equal ~printer:(fun x -> x) a1 b1 in
    name >:: test
  ) args

let test_pct_small =
  (map_pcts_tests "small" "encode" (fun a b -> b, (Uri.pct_encode a)) pcts) @
  (map_pcts_tests "small" "decode" (fun a b -> (Uri.pct_decode b), a) pcts)

let test_pct_large =
  (map_pcts_tests "large" "encode" (fun a b -> (Uri.pct_encode a), b) pcts_large) @
  (map_pcts_tests "large" "decode" (fun a b -> (Uri.pct_decode b), a) pcts_large)

(* Test that a URL encodes to the expected value *)
let test_uri_encode =
  List.map (fun (uri_str, uri) ->
    let name = sprintf "uri:%s" uri_str in
    let test () = assert_equal ~printer:(fun x -> x) uri_str (Uri.to_string uri) in
    name >:: test
   ) uri_encodes

let test_uri_custom_encode =
  let str = "https://google.com?test=@" in
  let uri = Uri.of_string str in
  let pct_encoder = Uri.pct_encoder ~query_value:(`Custom (`Query_value, "", "@")) () in
  assert_equal ~printer:(fun x -> x) "https://google.com?test=%40" (Uri.to_string ~pct_encoder uri)

(* Test that a URI decodes to the expected value *)
let test_uri_decode =
  List.map (fun (uri_str, uri) ->
    let name = sprintf "uribi:%s" uri_str in
    let test () = assert_equal ~printer:(fun x -> x) uri_str (Uri.(to_string (of_string (Uri.to_string uri)))) in
    name >:: test
  ) uri_encodes

(* Test URI query decoding *)
let uri_query = [
  "https://user:pass@foo.com:123/wh/at/ever?foo=1&bar=5#5", ["foo",["1"]; "bar",["5"]];
  "//domain?f+1=bar&+f2=bar%212", ["f 1",["bar"];" f2",["bar!2"]];
  "//domain?foo=&bar=", ["foo",[""];"bar",[""]];
  "//domain?a=b%26c%3Dd", ["a",["b&c=d"]];
  "",[];
  "?",["",[]];
  "?&",["",[];"",[]];
  "?&&",["",[];"",[];"",[]];
  "??&/&",["?",[];"/",[];"",[]];
  "?#?/#",["",[]];
  "?%23",["#",[]];
  "?=&==",["",[""];"",["="]];
  "?==,&=,=",["",["=";""];"",["";"="]];
  "?a=,,%26&,%2C=%2C,",["a",["";"";"&"];",,",[",";""]];
  "?%3D=%3D",["=",["="]];
  "?,",[",",[]];
]

let test_query_decode =
  List.map (fun (uri_str,res) ->
    let uri = Uri.of_string uri_str in
    let test () = assert_equal ~printer:(fun l ->
      String.concat " "
        (List.map
           (fun (k,v) -> sprintf "\"%s\" = \"%s\"" k (String.concat "," v)) l))
      res (Uri.query uri) in
    uri_str >:: test
  ) uri_query

(* Test URI query encoding. No pct encoding as that is done later by Uri.to_string *)
let uri_query_make = [
  [], "";
  ["foo",["bar"]], "foo=bar";
  ["foo1",["bar1"];"foo2",["bar2"]], "foo1=bar1&foo2=bar2";
  ["foo1",["bar1"];"foo2",["bar2"];"foo3",["bar3"]],
  "foo1=bar1&foo2=bar2&foo3=bar3";
  ["semicolon",[";"]],"semicolon=%3B";
  [";",["semicolon"]],"%3B=semicolon";
  ["#",["#";"#"]], "%23=%23,%23";
  ["",[]], "";
  ["",[""]], "=";
  ["",["";""]], "=,";
  ["&",["&"]], "%26=%26";
  ["=",["="]], "%3D==";
  [",",[",";""]], ",=%2C,";
]

let test_query_encode =
  List.map (fun (qs,res) ->
    let test () = assert_equal ~printer:(fun l -> l) res (Uri.encoded_of_query qs) in
    res >:: test
  ) uri_query_make

(* Test relative URI resolution
   from <http://tools.ietf.org/html/rfc3986#section-5.4> *)
let uri_rel_res = [
  (* "normal" *)
  "g:h",     "g:h";
  "g",       "http://a/b/c/g";
  "./g",     "http://a/b/c/g";
  "g/",      "http://a/b/c/g/";
  "/g",      "http://a/g";
  "//g",     "http://g";
  "?y",      "http://a/b/c/d;p?y";
  "g?y",     "http://a/b/c/g?y";
  "#s",      "http://a/b/c/d;p?q#s";
  "g#s",     "http://a/b/c/g#s";
  "g?y#s",   "http://a/b/c/g?y#s";
  ";x",      "http://a/b/c/;x";
  "g;x",     "http://a/b/c/g;x";
  "g;x?y#s", "http://a/b/c/g;x?y#s";
  "",        "http://a/b/c/d;p?q";
  ".",       "http://a/b/c/";
  "./",      "http://a/b/c/";
  "..",      "http://a/b/";
  "../",     "http://a/b/";
  "../g",    "http://a/b/g";
  "../..",   "http://a/";
  "../../",  "http://a/";
  "../../g", "http://a/g";
  (* "abnormal" *)
  "../../../g",    "http://a/g";
  "../../../../g", "http://a/g";
  "/./g",          "http://a/g";
  "/../g",         "http://a/g";
  "g.",            "http://a/b/c/g.";
  ".g",            "http://a/b/c/.g";
  "g..",           "http://a/b/c/g..";
  "..g",           "http://a/b/c/..g";
  "./../g",        "http://a/b/g";
  "./g/.",         "http://a/b/c/g/";
  "g/./h",         "http://a/b/c/g/h";
  "g/../h",        "http://a/b/c/h";
  "g;x=1/./y",     "http://a/b/c/g;x=1/y";
  "g;x=1/../y",    "http://a/b/c/y";
  "g?y/./x",       "http://a/b/c/g?y/./x";
  "g?y/../x",      "http://a/b/c/g?y/../x";
  "g#s/./x",       "http://a/b/c/g#s/./x";
  "g#s/../x",      "http://a/b/c/g#s/../x";
  "http:g",        "http:g";
  (* extra *)
  (* From <http://lists.w3.org/Archives/Public/uri/2014Jun/0000.html> *)
  ".%2E",          "http://a/b/";
]

let test_rel_res =
  let base = Uri.of_string "http://a/b/c/d;p?q" in
  List.map (fun (rel,abs) ->
    let test () = assert_equal ~printer:(fun l -> l)
      abs (Uri.to_string (Uri.resolve "http" base (Uri.of_string rel))) in
    rel >:: test
  ) uri_rel_res

let file_uri_rel_res = [ (* http://tools.ietf.org/html/rfc1738#section-3.10 *)
  "/foo/bar/baz", "/foo/bar/baz";
  "//localhost/foo", "///foo";
]

let test_file_rel_res =
  List.map (fun (rel,abs) ->
    let test () = assert_equal ~printer:(fun l -> l)
      abs (Uri.to_string (Uri.resolve "file" Uri.empty (Uri.of_string rel))) in
    rel >:: test
  ) file_uri_rel_res

let uri_rel_rel_res = [ (* relative-relative resolution *)
  "a", "b", "a";
  "a", "/", "/a";
  "a", "b/", "b/a";
  "a", "//b", "//b/a";
  "a", "//b/","//b/a";
  "a", "///", "///a";
  "?a", "b", "b?a";
  "?a", "/", "/?a";
  "?a", "//b", "//b?a";
  "?a", "///", "///?a";
  "#a", "b", "b#a";
  "#a", "/", "/#a";
  "#a", "//b", "//b#a";
  "#a", "///", "///#a";
  "../a", "b", "../a";
  "../a", "b/", "a";
  "../a", "b/./", "a";
  "../a", "../b", "../../a";
  "../a", "../b/", "../a";
  "../a", "../b/./", "../a";
  "../a", "../b/c/", "../b/a";
  "../a", "../../b", "../../../a";
  "../a", "../b/../", "../../a";
  "../a", "../b/./", "../a";
  "../a/..", "../", "../../";
  "../a/../", "../", "../../";
  "..", "b/c/", "b/";
  "", "b", "b";
  "a", "", "a";
  (* TODO: relative username, ... *)
]

let rel_empty_path_res = [
  "/foo/bar/..", "/foo/";
  "/foo/bar//..", "/foo/bar/";
  "/foo/bar///..", "/foo/bar//";
  "/foo/bar//../baz", "/foo/bar/baz"
]

let test_rel_empty_path_res =
  List.map (fun (rel, res) ->
      let test () = assert_equal ~printer:(fun l -> l)
          res Uri.(to_string (resolve "" empty (of_string rel))) in
      rel >:: test
    ) rel_empty_path_res

let test_rel_rel_res =
  List.map (fun (rel,base,res) ->
    let rel = Uri.of_string rel in
    let base = Uri.of_string base in
    let test () = assert_equal ~printer:(fun l -> l)
      res (Uri.to_string (Uri.resolve "" base rel)) in
    res >:: test
  ) uri_rel_rel_res

let userinfo_res = [
    "http://user:pwd@bar.com/foo",
      ["bar", "http://user:pwd@bar.com/bar";
       "/", "http://user:pwd@bar.com/";
      "http://boo:bar@bar.com/foo", "http://boo:bar@bar.com/foo";
      ]
]

let test_userinfo_res =
  userinfo_res |> List.map (fun (base,tests) ->
        let base = Uri.of_string base in
        List.map (fun (uri,res) ->
            let uri = Uri.of_string uri in
            let test () = assert_equal ~printer:(fun l -> l)
                res (Uri.to_string (Uri.resolve "" base uri)) in
            res >::test
        ) tests
  ) |> List.fold_left List.rev_append []

let generic_uri_norm = [
  "HTTP://example.com/", "http://example.com/";
  "http://example.com/%3a%3f", "http://example.com/:%3F";
  "http://Example.Com/", "http://example.com/";
  "http://example.com/%68%65%6c%6c%6f", "http://example.com/hello";
  "http://example.com/../", "http://example.com/";
  "http://example.com/./././", "http://example.com/";
  "%", "%25";
  "%3", "%253";
  "%3g", "%253g";
  "%3:", "%253:";
  "%3@", "%253@";
  "%3/", "%253/";
  "%%25", "%25%25";
  "%2%25", "%252%25";
  "/foo%2fbar/", "/foo%2Fbar/";
  "//colon%3Auser:colon%3Apassword@example.net/",
  "//colon%3Auser:colon%3Apassword@example.net/";
  "//colon%3Auser@example.net/",
  "//colon%3Auser@example.net/";
  "foo+bar%3a", "./foo+bar:";
  "http://[2001:DB8:1234:5678:90ab:cdef::0123]/%68%65%6c%6c%6f", "http://[2001:db8:1234:5678:90ab:cdef::0123]/hello";
  (let p_q = "/foo%20bar/" in
   p_q, Uri.(path_and_query (of_string p_q)));
]

let test_generic_uri_norm =
  List.map (fun (o,n) ->
    let test () = assert_equal ~printer:(fun l -> l)
      n (Uri.to_string (Uri.resolve "http" Uri.empty (Uri.of_string o))) in
    o >:: test
  ) generic_uri_norm

let rel_id = [
  "a/path/fragment";
  "/an/absolute/path";
  "?a&b&c";
  "?a=&b=&c=";
  "?a=b&b=c&c=a";
  "foo+bar:///";
]

let test_rel_id =
  List.map (fun id ->
    let test () = assert_equal ~printer:(fun l -> l)
      id (Uri.to_string (Uri.of_string id)) in
    id >:: test
  ) rel_id

let default_scheme = "ftp"
let tcp_port_of_uri = [
  "a/relative/path",
  List.hd (Uri_services.tcp_port_of_service default_scheme);
  "https://foo.bar/", 443;
  "ssh://user@host.tld/", 22;
  "http://foo.bar/", 80;
  "http://foo.bar:8000/", 8000;
]

let test_tcp_port_of_uri =
  let string_of_int_option = function None -> "None"
    | Some i -> sprintf "Some %d" i
  in List.map (fun (uri,pn) ->
    let test () = assert_equal ~printer:string_of_int_option
      (Some pn)
      (Uri_services.tcp_port_of_uri ~default:default_scheme
         (Uri.of_string uri))
    in uri >:: test
  ) tcp_port_of_uri

let query_key_add_remove =
  let test () =
  let uri = Uri.of_string "http://foo.com/?k1=1&k2=2" in
  let printer x = Uri.(to_string (with_query uri x)) in
  assert_equal ~printer (Uri.query uri) [("k1",["1"]);("k2",["2"])];
  let uri = Uri.add_query_param uri ("k3",["3"]) in
  assert_equal ~printer (Uri.query uri) [("k3",["3"]);("k1",["1"]);("k2",["2"])];
  assert_equal (Uri.get_query_param' uri "k3") (Some ["3"]);
  assert_equal (Uri.get_query_param uri "k3") (Some "3");
  let uri = Uri.remove_query_param uri "k1" in
  assert_equal ~printer (Uri.query uri) [("k3",["3"]);("k2",["2"])];
  let uri = Uri.remove_query_param uri "k2" in
  let uri = Uri.remove_query_param uri "k3" in
  assert_equal ~printer (Uri.query uri) []
  in ["query_key_add_remove" >:: test]

let test_with_change = [
  "test_with_scheme" >:: (fun () ->
    let printer = Uri.to_string in
    let uri = Uri.of_string "https://foo.bar/a/b/c" in
    let uri2 = Uri.with_scheme uri (Some "https") in
    let uri3 = Uri.with_scheme uri (Some "f o o") in
    assert_equal ~printer uri uri2;
    let exp = "f%20o%20o://foo.bar/a/b/c" in
    let msg = sprintf "%s <> %s" (Uri.to_string uri3) exp in
    assert_equal ~msg (Uri.to_string uri3) exp;

    let uri = Uri.with_scheme Uri.empty (Some "http") in
    let uri_s = Uri.to_string uri in
    let uri_exp = "http:" in
    let msg = sprintf "with_scheme empty (%s <> %s).string" uri_s uri_exp in
    assert_equal ~msg uri_s uri_exp;

    let urn = Uri.of_string "urn:uuid:f81d4fae-7dec-11d0-a765-00a0c91e6bf6" in
    let urn2= Uri.with_scheme urn (Some "urn") in
    assert_equal ~printer urn urn2;

    let urn_path =
      Uri.with_path Uri.empty "uuid:f81d4fae-7dec-11d0-a765-00a0c91e6bf6"
    in
    let urn2 = Uri.with_scheme urn_path (Some "urn") in
    assert_equal ~printer urn urn2
  );

  "test_with_userinfo" >:: (fun () ->
    let uri = Uri.of_string "https://foo.bar/a/b/c" in
    let uri2 = Uri.with_userinfo uri (Some "avsm:pa:sswo%20rd") in
    let uri3 = Uri.with_userinfo uri (Some "avsm:pa%3Asswo rd") in
    let exp = "https://avsm:pa%3Asswo%20rd@foo.bar/a/b/c" in
    let msg t = sprintf "%s %s <> %s" t (Uri.to_string uri2) exp in
    assert_equal ~msg:(msg "string") (Uri.to_string uri2) exp;
    assert_equal ~msg:(msg "rep") uri2 (Uri.of_string exp);
    let msg t = sprintf "%s %s <> %s" t (Uri.to_string uri3) exp in
    assert_equal ~msg:(msg "string") (Uri.to_string uri3) exp;
    assert_equal ~msg:(msg "rep") uri3 (Uri.of_string exp);
    let uri_some = Uri.with_userinfo Uri.empty (Some "avsm") in
    let exp = "//avsm@" in
    let msg t = sprintf "%s %s <> %s" t (Uri.to_string uri_some) exp in
    assert_equal ~msg:(msg "string") (Uri.to_string uri_some) exp;
    assert_equal ~msg:(msg "rep") uri_some (Uri.of_string exp)
  );

  "test_with_password" >:: (fun () ->
    let uri = Uri.of_string "/" in
    let uri_wp = Uri.with_password uri None in
    assert_equal "/" (Uri.to_string uri_wp);
    let uri_wp = Uri.with_password uri (Some "") in
    assert_equal "//:@/" (Uri.to_string uri_wp);
    let uri_wp = Uri.with_password uri (Some ":") in
    assert_equal "//:%3A@/" (Uri.to_string uri_wp);
    let uri = Uri.of_string "//user:pass@foo" in
    let uri_wp = Uri.with_password uri None in
    assert_equal "//user@foo" (Uri.to_string uri_wp);
    let uri_wp = Uri.with_password uri (Some "") in
    assert_equal "//user:@foo" (Uri.to_string uri_wp);
    let uri_wp = Uri.with_password uri (Some ":") in
    assert_equal "//user:%3A@foo" (Uri.to_string uri_wp)
  );

  "test_with_host" >:: (fun () ->
    let uri      = Uri.of_string "//www.meow.com" in
    let uri_none = Uri.with_host uri None in
    let uri_exp  = "" in
    let msg = sprintf "host removal with None (%s <> %s)"
      uri_exp (Uri.to_string uri_none) in
    assert_equal ~msg (Uri.of_string uri_exp) uri_none;
    let uri_exp  = "//" in
    let uri_some_empty = Uri.with_host uri (Some "") in
    let msg = sprintf "host removal with empty (%s <> %s)"
      uri_exp (Uri.to_string uri_some_empty) in
    assert_equal ~msg (Uri.of_string uri_exp) uri_some_empty;
    let uri_some = Uri.with_host uri (Some "www.woof.com") in
    let uri_woof = Uri.of_string "//www.woof.com" in
    assert_equal ~msg:"host change" uri_woof uri_some;
    let uri_some = Uri.with_host Uri.empty (Some "www.woof.com") in
    assert_equal ~msg:"create host" uri_woof uri_some
  );

  "test_with_port" >:: (fun () ->
    let uri_port = Uri.with_port Uri.empty (Some 80) in
    let uri_exp = "//:80" in
    let msg = sprintf "add port to empty (%s <> %s)"
      uri_exp (Uri.to_string uri_port) in
    assert_equal ~msg (Uri.of_string uri_exp) uri_port;
    let uri = Uri.of_string "//foo.com" in
    let uri_port = Uri.with_port uri (Some 80) in
    assert_equal (Uri.of_string "//foo.com:80") uri_port;
    let foo = Uri.of_string "http://foo.com" in
    let foo_port = Uri.with_port foo (Some 80) in
    assert_equal (Uri.of_string "http://foo.com:80") foo_port;
    let uri_no_port = Uri.with_port foo_port None in
    assert_equal foo uri_no_port;
    assert_equal (Uri.of_string "/") (Uri.with_port (Uri.of_string "/") None)
  );

  "test_with_path" >:: (fun () ->
    let uri_empty = Uri.with_path Uri.empty "" in
    assert_equal ~msg:"empty host empty path" Uri.empty uri_empty;
    let uri_pct = Uri.with_path Uri.empty "a%2F" in
    let msg = sprintf "empty host percent / path (%s <> %s)"
      (Uri.to_string uri_pct) "a%2F" in
    assert_equal ~msg (Uri.to_string uri_pct) "a%2F";
    let uri_some = Uri.with_path Uri.empty "a" in
    assert_equal ~msg:"empty host some path" (Uri.of_string "a") uri_some;
    let uri = Uri.of_string "//" in
    let uri_empty = Uri.with_path uri "" in
    let msg = sprintf "some host empty path (%s <> %s)"
      (Uri.to_string uri) (Uri.to_string uri_empty) in
    assert_equal ~msg uri uri_empty;
    let uri_some = Uri.with_path uri "a" in
    let uri_exp_s = "///a" in
    let uri_exp = Uri.of_string uri_exp_s in
    let uri_exp_str = Uri.to_string uri_exp in
    let uri_some_str = Uri.to_string uri_some in
    let msg = sprintf "path relative host (%S <> %S)"
      uri_exp_str uri_some_str in
    assert_equal ~msg uri_exp uri_some
  );

  "test_with_query" >:: (fun () ->
    let cmp = Uri.equal in
    let test_with_query prefix =
      let uri = Uri.of_string prefix in
      let uri_empty = Uri.with_query uri [] in
      let msg = prefix ^ " empty" in
      assert_equal ~cmp ~msg (Uri.of_string prefix) uri_empty;
      let uri_quest = Uri.with_query uri ["",[]] in
      let uri_exp_s = prefix ^ "?" in
      let uri_exp   = Uri.of_string uri_exp_s in
      let uri_exp_str = Uri.to_string uri_exp in
      let uri_quest_str = Uri.to_string uri_quest in
      let msg = sprintf "'%s' quest (%S <> %S)"
        prefix uri_exp_str uri_quest_str in
      assert_equal ~cmp ~msg uri_exp uri_quest;
      let uri_equal = Uri.with_query uri ["",[""]] in
      let msg = prefix ^ " equal" in
      assert_equal ~cmp ~msg (Uri.of_string (prefix^"?=")) uri_equal;
      let uri_comma = Uri.with_query uri ["",["";""]] in
      let msg = prefix ^ " comma" in
      assert_equal ~cmp ~msg (Uri.of_string (prefix^"?=,")) uri_comma;
      let uri_empty = Uri.with_query' uri [] in
      let msg = prefix ^ " empty'" in
      assert_equal ~cmp ~msg (Uri.of_string prefix) uri_empty;
      let uri_equal = Uri.with_query' uri ["",""] in
      let msg = prefix ^" equal'" in
      assert_equal ~cmp ~msg (Uri.of_string (prefix^"?=")) uri_equal;
    in
    test_with_query "";
    test_with_query "//";
    test_with_query "///";
    let uri = Uri.of_string "//#" in
    let uri_quest = Uri.with_query uri ["",[]] in
    let msg = "?#" in
    assert_equal ~cmp ~msg (Uri.of_string "//?#") uri_quest;
    let uri_equal = Uri.with_query' uri ["",""] in
    let uri_exp_s = "//?=#" in
    let msg = sprintf "%s <> %s" uri_exp_s (Uri.to_string uri_equal) in
    assert_equal ~cmp ~msg (Uri.of_string "//?=#") uri_equal;

    let printer x = x in
    let uri_exp_s = "?name=3+4%20+%3a|" in
    let uri = Uri.of_string uri_exp_s in
    (match Uri.verbatim_query uri with
     | None -> assert_failure "no query string! (1)"
     | Some qs -> assert_equal uri_exp_s ("?"^qs)
    );
    assert_equal ~printer "?name=3%204%20%20:%7C" (Uri.to_string uri);
    let uri_plus = Uri.add_query_param' uri ("time","now") in
    let uri_exp_s = "?time=now&name=3%204%20%20:%7C" in
    (match Uri.verbatim_query uri_plus with
     | None -> assert_failure "no query string! (2)"
     | Some qs -> assert_equal ~printer uri_exp_s ("?"^qs)
    );
  );

  "test_with_fragment" >:: (fun () ->
    let test_with_fragment prefix =
      let uri = Uri.of_string prefix in
      let uri_empty = Uri.with_fragment uri None in
      assert_equal uri uri_empty;
      let uri_some = Uri.with_fragment uri (Some "") in
      assert_equal (Uri.of_string (prefix^"#")) uri_some
    in
    test_with_fragment "";
    test_with_fragment "//";
    let uri = Uri.of_string "//#" in
    let uri_empty = Uri.with_fragment uri None in
    assert_equal (Uri.of_string "//") uri_empty
  );
]

let canonical_map = [
  "http://foo.bar/a/b/c",      "http://foo.bar/a/b/c";
  "http://foo.bar:/a/b/c",     "http://foo.bar/a/b/c";
  "http://foo.bar:80/a/b/c",   "http://foo.bar/a/b/c";
  "http://foo.bar:443/a/b/c",  "http://foo.bar:443/a/b/c";
  "https://foo.bar/a/b/c",     "https://foo.bar/a/b/c";
  "https://foo.bar:/a/b/c",    "https://foo.bar/a/b/c";
  "https://foo.bar:80/a/b/c",  "https://foo.bar:80/a/b/c";
  "https://foo.bar:443/a/b/c", "https://foo.bar/a/b/c";
  "//example.net:80/a",        "//example.net:80/a";
  "http://example.org",        "http://example.org/";
  "https://example.org",       "https://example.org/";
  "ftp://example.org",         "ftp://example.org";
  "ssh://example.org",         "ssh://example.org";
  "git://example.org",         "git://example.org";
  "",                          "";
  "..",                        "../";
  "/..",                       "/";
  "/foo/./bar",                "/foo/bar";
  "/foo/../../",               "/";
  "http://@bar:?#",            "http://@bar/?#";
  (*"mailto:Joe@Example.COM",    "mailto:Joe@example.com";*)
]

let canonical uri_s = Uri.(to_string (canonicalize (of_string uri_s)))

let test_canonicalize =
  List.map (fun (input, output) ->
    input >:: (fun () ->
      assert_equal ~printer:(fun l -> l) output (canonical input)
    )
  ) canonical_map

let with_uri =
  let base = Uri.of_string "scheme://user:pass@host:0/path?query=arg#fragment" in
  [Uri.with_uri base,                              Uri.to_string base;
   Uri.with_uri ~scheme:None base,                 "//user:pass@host:0/path?query=arg#fragment";
   Uri.with_uri ~scheme:(Some "new") base,         "new://user:pass@host:0/path?query=arg#fragment";
   Uri.with_uri ~userinfo:None base,               "scheme://host:0/path?query=arg#fragment";
   Uri.with_uri ~userinfo:(Some "new") base,       "scheme://new@host:0/path?query=arg#fragment";
   Uri.with_uri ~host:None base,                   "scheme://user:pass@:0/path?query=arg#fragment";
   Uri.with_uri ~host:(Some "new") base,           "scheme://user:pass@new:0/path?query=arg#fragment";
   Uri.with_uri ~port:None base,                   "scheme://user:pass@host/path?query=arg#fragment";
   Uri.with_uri ~port:(Some 1) base,               "scheme://user:pass@host:1/path?query=arg#fragment";
   Uri.with_uri ~path:None base,                   "scheme://user:pass@host:0?query=arg#fragment";
   Uri.with_uri ~path:(Some "new") base,           "scheme://user:pass@host:0/new?query=arg#fragment";
   Uri.with_uri ~query:None base,                  "scheme://user:pass@host:0/path#fragment";
   Uri.with_uri ~query:(Some ["new", ["a"]]) base, "scheme://user:pass@host:0/path?new=a#fragment";
   Uri.with_uri ~fragment:None base,               "scheme://user:pass@host:0/path?query=arg";
   Uri.with_uri ~fragment:(Some "new") base,       "scheme://user:pass@host:0/path?query=arg#new";
   Uri.with_uri ~host:(Some "2001:DB8:1234:5678:90ab:cdef::0123") base,
     "scheme://user:pass@[2001:DB8:1234:5678:90ab:cdef::0123]:0/path?query=arg#fragment"
   ]

let test_with_uri =
  List.map (fun (input, output) ->
    input >:: (fun () ->
          assert_equal ~printer:(fun l -> l) output input
    )
  ) (List.map (fun (i, o) -> Uri.to_string i, o) with_uri)

let ipv6_addresses =
  ["::", "::"
  ; "::1", "::1"
  ;"fe02::1","fe02::1"
  ;"::ffff:192.0.2.1", "::ffff:192.0.2.1"
  ;"2001:DB8::42","2001:DB8::42"
  ;"2001:DB8:1234:5678:90ab:cdef:0123:4567","2001:DB8:1234:5678:90ab:cdef:0123:4567"
  ;"2001:DB8:1234:5678:90ab:cdef:0123::","2001:DB8:1234:5678:90ab:cdef:0123::"
  ;"2001:DB8:1234:5678:90ab:cdef::0123","2001:DB8:1234:5678:90ab:cdef::0123"
  ;"2001:DB8:1234:5678:90ab:cdef:192.0.2.1","2001:DB8:1234:5678:90ab:cdef:192.0.2.1"
  ;"2001:DB8:1234:5678:90ab:cdef:192.0.2.1","2001:DB8:1234:5678:90ab:cdef:192.0.2.1"
  ]

let test_ipv6_parsing =
  List.map (fun (input, expected) ->
    let name = sprintf "ipv6:%s" input in
    let test () =
      match Angstrom.parse_string ~consume:All Uri.Parser.ipv6 input with
      | Ok parsed ->
        assert_equal ~printer:(fun x -> x) expected parsed
      | Error msg -> assert_failure msg
    in
    name >:: test
  ) ipv6_addresses

let compat_uris =
  [ "http://\nhost"
  ; "http://host\n/path"
  ; "http://host/path\n?query=1"
  ; "http://host/path?query=1&other\n=2"
  ; "http://user\n:password@host/path"
  ; "http://user:password@\nhost/path"
  ]

let http_uris =
  [ "http://foo.bar/a/b/c"
  ; "http://foo.bar:443/a/b/c"
  ; "https://foo.bar/a/b/c"
  ; "https://foo.bar:80/a/b/c"
  ; "http://example.org/path?query=foo"
  ]

let non_http_uris =
  [ "//example.net:80/a"
  ; "ftp://example.org"
  ; "ssh://example.org"
  ; "git://example.org"
  ; ""
  ; ".."
  ; "/.."
  ; "/foo/./bar"
  ; "/foo/../../"
  ]

let eval_rfc9110_uris tests ~f =
  List.map (fun input ->
    let name = sprintf "http_uri:%s" input in
    let test () =
      Uri.of_string input |> Uri.Absolute_http.of_uri |> f ~input in
    name >:: test
  ) tests

let test_parseable_rfc9110_uris =
  let eval ~input = function
    | Ok http_uri ->
      assert_equal (Uri.Absolute_http.to_string http_uri) input
    | Error (`Msg msg) -> assert_failure msg
  in
  eval_rfc9110_uris http_uris ~f:eval

let test_unparseable_rfc9110_uris =
  let eval ~input = function
    | Ok _ -> assert_failure (sprintf "unexpected conversion of non-rfc9110 uri: %s" input)
    | Error _ -> ()
  in
  eval_rfc9110_uris non_http_uris ~f:eval

(* Returns true if the result list contains successes only.
   Copied from oUnit source as it isnt exposed by the mli *)
let rec was_successful =
  function
    | [] -> true
    | RSuccess _::t
    | RSkip _::t ->
        was_successful t
    | RFailure _::_
    | RError _::_
    | RTodo _::_ ->
        false

let _ =
  let suite = "URI" >::: (
    test_pct_small
    @ test_pct_large
    @ test_uri_encode
    @ test_uri_decode
    @ test_query_decode
    @ test_query_encode
    @ test_rel_res
    @ test_file_rel_res
    @ test_rel_rel_res
    @ test_userinfo_res
    @ test_rel_empty_path_res
    @ test_generic_uri_norm
    @ test_rel_id
    @ test_tcp_port_of_uri
    @ query_key_add_remove
    @ test_with_change
    @ test_canonicalize
    @ test_with_uri
    @ test_ipv6_parsing
    @ test_parseable_rfc9110_uris
    @ test_unparseable_rfc9110_uris
  ) in
  let verbose = ref false in
  let set_verbose _ = verbose := true in
  Arg.parse
    [("-verbose", Arg.Unit set_verbose, "Run the test in verbose mode.");]
    (fun x -> raise (Arg.Bad ("Bad argument : " ^ x)))
    ("Usage: " ^ Sys.argv.(0) ^ " [-verbose]");
  if not (was_successful (run_test_tt ~verbose:!verbose suite)) then
  exit 1