Switch curl for url parsing

DESCRIPTION

@@ -17,7 +17,7 @@ Depends:
     R (>= 4.0)
 Imports:
     cli (>= 3.0.0),
-    curl (>= 5.2.2),
+    curl (>= 6.0.1),
     glue,
     lifecycle,
     magrittr,

NEWS.md

@@ -1,5 +1,6 @@
 # httr2 (development version)
 
+* `url_parse()` now uses `curl::curl_parse_url()` which is much faster and more correct (#577).
 * `req_perform_promise()` upgraded to use event-driven async based on waiting efficiently on curl socket activity (#579).
 * New `req_oauth_token_exchange()` and `oauth_flow_token_exchange()` functions implement the OAuth token exchange protocol from RFC 8693 (@atheriel, #460).
 

R/url.R

@@ -26,44 +26,20 @@
 url_parse <- function(url) {
   check_string(url)
 
-  # https://datatracker.ietf.org/doc/html/rfc3986#appendix-B
-  pieces <- parse_match(url, "^(([^:/?#]+):)?(//([^/?#]*))?([^?#]*)(\\?([^#]*))?(#(.*))?")
-
-  scheme <- pieces[[2]]
-  authority <- pieces[[4]]
-  path <- pieces[[5]]
-  query <- pieces[[7]]
-  if (!is.null(query)) {
-    query <- query_parse(query)
-  }
-  fragment <- pieces[[9]]
-
-  # https://datatracker.ietf.org/doc/html/rfc3986#section-3.2
-  pieces <- parse_match(authority %||% "", "^(([^@]+)@)?([^:]+)?(:([^#]+))?")
-
-  userinfo <- pieces[[2]]
-  if (!is.null(userinfo)) {
-    userinfo <- parse_in_half(userinfo, ":")
-    if (userinfo$right == "") {
-      userinfo$right <- NULL
-    }
-  }
-  hostname <- pieces[[3]]
-  port <- pieces[[5]]
-
-  structure(
-    list(
-      scheme = scheme,
-      hostname = hostname,
-      username = userinfo$left,
-      password = userinfo$right,
-      port = port,
-      path = path,
-      query = query,
-      fragment = fragment
-    ),
-    class = "httr2_url"
+  curl <- curl::curl_parse_url(url)
+
+  parsed <- list(
+    scheme = curl$scheme,
+    hostname = curl$host,
+    username = curl$user,
+    password = curl$password,
+    port = curl$port,
+    path = curl$path,
+    query = if (length(curl$params)) as.list(curl$params),
+    fragment = curl$fragment
   )
+  class(parsed) <- "httr2_url"
+  parsed
 }
 
 url_modify <- function(url, ..., error_call = caller_env()) {

tests/testthat/_snaps/curl.md

@@ -40,48 +40,48 @@
     Code
       curl_translate("curl http://x.com")
     Output
-      request("http://x.com") |> 
+      request("http://x.com/") |> 
         req_perform()
     Code
       curl_translate("curl http://x.com -X DELETE")
     Output
-      request("http://x.com") |> 
+      request("http://x.com/") |> 
         req_method("DELETE") |> 
         req_perform()
     Code
       curl_translate("curl http://x.com -H A:1")
     Output
-      request("http://x.com") |> 
+      request("http://x.com/") |> 
         req_headers(
           A = "1",
         ) |> 
         req_perform()
     Code
       curl_translate("curl http://x.com -H 'A B:1'")
     Output
-      request("http://x.com") |> 
+      request("http://x.com/") |> 
         req_headers(
           `A B` = "1",
         ) |> 
         req_perform()
     Code
       curl_translate("curl http://x.com -u u:p")
     Output
-      request("http://x.com") |> 
+      request("http://x.com/") |> 
         req_auth_basic("u", "p") |> 
         req_perform()
     Code
       curl_translate("curl http://x.com --verbose")
     Output
-      request("http://x.com") |> 
+      request("http://x.com/") |> 
         req_perform(verbosity = 1)
 
 # can translate query
 
     Code
       curl_translate("curl http://x.com?string=abcde&b=2")
     Output
-      request("http://x.com") |> 
+      request("http://x.com/") |> 
         req_url_query(
           string = "abcde",
           b = "2",
@@ -93,14 +93,14 @@
     Code
       curl_translate("curl http://example.com --data abcdef")
     Output
-      request("http://example.com") |> 
+      request("http://example.com/") |> 
         req_body_raw("abcdef", "application/x-www-form-urlencoded") |> 
         req_perform()
     Code
       curl_translate(
         "curl http://example.com --data abcdef -H Content-Type:text/plain")
     Output
-      request("http://example.com") |> 
+      request("http://example.com/") |> 
         req_body_raw("abcdef", "text/plain") |> 
         req_perform()
 
@@ -111,7 +111,7 @@
     Message
       v Copying to clipboard:
     Output
-      request("http://example.com") |> 
+      request("http://example.com/") |> 
         req_headers(
           A = "1",
           B = "2",
@@ -120,16 +120,19 @@
     Code
       clipr::read_clip()
     Output
-      [1] "request(\"http://example.com\") |> " "  req_headers("                     
-      [3] "    A = \"1\","                      "    B = \"2\","                     
-      [5] "  ) |> "                             "  req_perform()"                    
+      [1] "request(\"http://example.com/\") |> "
+      [2] "  req_headers("                      
+      [3] "    A = \"1\","                      
+      [4] "    B = \"2\","                      
+      [5] "  ) |> "                             
+      [6] "  req_perform()"                     
 
 # encode_string2() produces simple strings
 
     Code
       curl_translate(cmd)
     Output
-      request("http://example.com") |> 
+      request("http://example.com/") |> 
         req_method("PATCH") |> 
         req_body_raw('{"data":{"x":1,"y":"a","nested":{"z":[1,2,3]}}}', "application/json") |> 
         req_perform()

tests/testthat/test-oauth-flow-auth-code.R

@@ -75,12 +75,12 @@ test_that("old args are deprecated", {
   expect_snapshot(
     redirect <- normalize_redirect_uri("http://localhost", port = 1234)
   )
-  expect_equal(redirect$uri, "http://localhost:1234")
+  expect_equal(redirect$uri, "http://localhost:1234/")
 
   expect_snapshot(
     redirect <- normalize_redirect_uri("http://x.com", host_name = "y.com")
   )
-  expect_equal(redirect$uri, "http://y.com")
+  expect_equal(redirect$uri, "http://y.com/")
 
   expect_snapshot(
     redirect <- normalize_redirect_uri("http://x.com", host_ip = "y.com")

tests/testthat/test-url.R

@@ -1,21 +1,11 @@
 test_that("can parse special cases", {
-  url <- url_parse("//google.com")
-  expect_equal(url$scheme, NULL)
-  expect_equal(url$hostname, "google.com")
-
   url <- url_parse("file:///tmp")
   expect_equal(url$scheme, "file")
   expect_equal(url$path, "/tmp")
-
-  url <- url_parse("/")
-  expect_equal(url$scheme, NULL)
-  expect_equal(url$path, "/")
 })
 
 test_that("can round trip urls", {
   urls <- list(
-    "/",
-    "//google.com",
     "file:///",
     "http://google.com/",
     "http://google.com/path",