r-lib · hadley · Apr 3, 2020 · Sep 18, 2019 · Apr 3, 2020
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,8 @@
 # httr (development version)
 
+* `parse_url()` now refers to RFC3986 for the parsing of the URL's 
+  scheme, with a bit more permissive syntax (@ymarcon, #615).
+
 # httr 1.4.1
 
 * Remove the default `cainfo` option on Windows. Providing a CA bundle is not 

diff --git a/R/url.r b/R/url.r
@@ -1,9 +1,9 @@
 # Good example for testing
 # http://stevenlevithan.com/demo/parseuri/js/
 
-#' Parse and build urls according to RFC1808.
+#' Parse and build urls according to RFC3986.
 #'
-#' See <http://tools.ietf.org/html/rfc1808.html> for details of parsing
+#' See <https://tools.ietf.org/html/rfc3986> for details of parsing
 #' algorithm.
 #'
 #' @param url For `parse_url` a character vector (of length 1) to parse
@@ -24,7 +24,7 @@
 #' parse_url("http://google.com/")
 #' parse_url("http://google.com:80/")
 #' parse_url("http://google.com:80/?a=1&b=2")
-#' 
+#'
 #' url <- parse_url("http://google.com/")
 #' url$scheme <- "https"
 #' url$query <- list(q = "hello")
@@ -45,7 +45,7 @@ parse_url <- function(url) {
   }
 
   fragment <- pull_off("#(.*)$")
-  scheme <- pull_off("^([[:alpha:]+.-]+):")
+  scheme <- pull_off("^([[:alpha:]][[:alpha:][:digit:]+.-]*):")
   netloc <- pull_off("^//([^/?]*)/?")
 
   if (identical(netloc, "")) { # corresponds to ///

diff --git a/man/parse_url.Rd b/man/parse_url.Rd
diff --git a/tests/testthat/test-url.r b/tests/testthat/test-url.r
@@ -85,6 +85,36 @@ test_that("parse_url preserves leading / in path", {
   expect_equal(url$path, "/tmp/foobar")
 })
 
+test_that("scheme starts with alpha", {
+  url <- parse_url("+ab://host/tmp/foobar")
+  expect_equal(url$scheme, NULL)
+})
+
+test_that("scheme can contain digits", {
+  url <- parse_url("ab1://host/tmp/foobar")
+  expect_equal(url$scheme, "ab1")
+})
+
+test_that("scheme can contain plus", {
+  url <- parse_url("a+b://host/tmp/foobar")
+  expect_equal(url$scheme, "a+b")
+})
+
+test_that("scheme can contain period", {
+  url <- parse_url("a.b://host/tmp/foobar")
+  expect_equal(url$scheme, "a.b")
+})
+
+test_that("scheme can contain hyphen", {
+  url <- parse_url("a-b://host/tmp/foobar")
+  expect_equal(url$scheme, "a-b")
+})
+
+test_that("scheme can be a single character", {
+  url <- parse_url("a://host/tmp/foobar")
+  expect_equal(url$scheme, "a")
+})
+
 # compose_query -----------------------------------------------------------
 
 test_that("I() prevents escaping", {