Handle URLs from GitHub Enterprise managed orgs

NEWS.md

@@ -35,6 +35,11 @@
   `Config/usethis/upkeep` field in DESCRIPTION. If this value exists, it is
   used to filter the checklist when making the issue.
 
+* Some GitHub functionality should now work for GitHub Enterprise Cloud (as
+  opposed to GitHub Enterprise Server). Specifically an HTTPS URL such as
+  `"https://my-cool-org.ghe.com"` should now be recognized as "looks like
+  GitHub" (#2098, @jameslairdsmith).
+
 # usethis 3.0.0
 
 ## Transition to cli package for UI

R/utils-gh.R

@@ -39,11 +39,14 @@ get_hosturl <- function(url) {
 # (almost) the inverse of get_hosturl()
 # https://github.com     --> https://api.github.com
 # https://github.uni.edu --> https://github.uni.edu/api/v3
+# fmt: skip
 get_apiurl <- function(url) {
   host_url <- get_hosturl(url)
   prot_host <- strsplit(host_url, "://", fixed = TRUE)[[1]]
   if (is_github_dot_com(host_url)) {
     paste0(prot_host[[1]], "://api.github.com")
+  } else if (is_github_enterprise(host_url)) {
+    paste0(prot_host[[1]], "://api.", prot_host[[2]])
   } else {
     paste0(host_url, "/api/v3")
   }
@@ -58,3 +61,12 @@ is_github_dot_com <- function(url) {
 default_api_url <- function() {
   Sys.getenv("GITHUB_API_URL", unset = "https://api.github.com")
 }
+
+# handles GitHub Enterprise Cloud, but not GitHub Enterprise Server (which
+# would, I think, require the ability to fully configure this)
+# https://github.com/r-lib/usethis/issues/1897
+is_github_enterprise <- function(url) {
+  url <- get_baseurl(url)
+  url <- normalize_host(url)
+  grepl("^https?://.+ghe.com", url)
+}

R/utils-github.R

@@ -111,8 +111,8 @@ github_url_from_git_remotes <- function(url = NULL) {
 #' filtered for specific remote names. The remote URLs are parsed into parts,
 #' like `host` and `repo_owner`. This is filtered again for rows where the
 #' `host` appears to be a GitHub deployment (currently a crude search for
-#' "github"). Some of these parts are recombined or embellished to get new
-#' columns (`host_url`, `api_url`, `repo_spec`). All operations are entirely
+#' "github" or "ghe"). Some of these parts are recombined or embellished to get
+#' new columns (`host_url`, `api_url`, `repo_spec`). All operations are entirely
 #' mechanical and local.
 #'
 #' @param these Intersect the list of remotes with `these` remote names. To keep
@@ -136,8 +136,8 @@ github_remote_list <- function(these = c("origin", "upstream"), x = NULL) {
   }
 
   parsed <- parse_github_remotes(set_names(x$url, x$name))
-  # TODO: generalize here for GHE hosts that don't include 'github'
-  is_github <- grepl("github", parsed$host)
+  # TODO: presumably more generalization is necessary to truly handle self-hosted GHE
+  is_github <- grepl("github|ghe", parsed$host)
   parsed <- parsed[is_github, ]
 
   parsed$remote <- parsed$name

tests/testthat/test-utils-gh.R

@@ -0,0 +1,10 @@
+test_that("is_github_enterprise() identifies GitHub Enterprise URLs (or not)", {
+  # https://github.com/r-lib/usethis/pull/2098
+  expect_true(is_github_enterprise("https://my-cool-org.ghe.com"))
+
+  # not handled yet: self-hosted GHE server
+  # https://github.com/r-lib/usethis/pull/2098
+  expect_false(is_github_enterprise(
+    "https://ghe-gsk-prod.metworx.com/account/reponame"
+  ))
+})