Where possible, use existing github config to determine default branch (#2062)

Fixes #2021

Author: hadley

R/git-default-branch.R

@@ -93,39 +93,18 @@ NULL
 #' git_default_branch()
 #' }
 git_default_branch <- function() {
-  repo <- git_repo()
+  git_default_branch_(github_remote_config())
+}
 
-  # TODO: often when we call git_default_branch(), we already have a GitHub
-  # configuration or target repo, as produced by github_remote_config() or
-  # target_repo(). In that case, we don't need to start from scratch as we do
-  # here. But I'm not sure it's worth adding complexity to allow passing this
-  # data in.
-
-  # TODO: this critique feels somewhat mis-placed, i.e. it brings up a general
-  # concern about a repo's config (or the user's permissions and creds)
-  # related to whether github_remotes() should be as silent as it is about
-  # 404s
-  critique_remote <- function(remote) {
-    if (remote$is_configured && is.na(remote$default_branch)) {
-      ui_bullets(c(
-        "x" = "The {.val {remote$name}} remote is configured, but we can't
-               determine its default branch.",
-        " " = "Possible reasons:",
-        "*" = "The remote repo no longer exists, suggesting the local remote
-               should be deleted.",
-        "*" = "We are offline or that specific Git server is down.",
-        "*" = "You don't have the necessary permission or something is wrong
-               with your credentials."
-      ))
-    }
-  }
+# If config is available, we can use it to avoid an additional lookup
+# on the GitHub API
+git_default_branch_ <- function(cfg) {
+  repo <- git_repo()
 
-  upstream <- git_default_branch_remote("upstream")
+  upstream <- git_default_branch_remote(cfg, "upstream")
   if (is.na(upstream$default_branch)) {
-    critique_remote(upstream)
-    origin <- git_default_branch_remote("origin")
+    origin <- git_default_branch_remote(cfg, "origin")
     if (is.na(origin$default_branch)) {
-      critique_remote(origin)
       db_source <- list()
     } else {
       db_source <- origin
@@ -186,7 +165,7 @@ git_default_branch <- function() {
 
 # returns a whole data structure, because the caller needs the surrounding
 # context to produce a helpful error message
-git_default_branch_remote <- function(remote = "origin") {
+git_default_branch_remote <- function(cfg, remote = "origin") {
   repo <- git_repo()
   out <- list(
     name = remote,
@@ -196,25 +175,22 @@ git_default_branch_remote <- function(remote = "origin") {
     default_branch = NA_character_
   )
 
-  url <- git_remotes()[[remote]]
-  if (length(url) == 0) {
+  cfg_remote <- cfg[[remote]]
+  if (!cfg_remote$is_configured) {
     out$is_configured <- FALSE
     return(out)
   }
+
   out$is_configured <- TRUE
-  out$url <- url
-
-  # TODO: generalize here for GHE hosts that don't include 'github'
-  parsed <- parse_github_remotes(url)
-  # if the protocol is ssh, I suppose we can't assume a PAT, i.e. it's better
-  # to use the Git approach vs. the GitHub API approach
-  if (grepl("github", parsed$host) && parsed$protocol == "https") {
-    remote_dat <- github_remotes(remote, github_get = NA)
-    out$repo_spec <- remote_dat$repo_spec
-    out$default_branch <- remote_dat$default_branch
+  out$url <- cfg_remote$url
+
+  if (!is.na(cfg_remote$default_branch)) {
+    out$repo_spec <- cfg_remote$repo_spec
+    out$default_branch <- cfg_remote$default_branch
     return(out)
   }
 
+  # Fall back to pure git based approach
   out$default_branch <- tryCatch(
     {
       gert::git_fetch(remote = remote, repo = repo, verbose = FALSE)

R/github.R

@@ -61,7 +61,7 @@ use_github <- function(organisation = NULL,
   visibility <- match.arg(visibility)
   check_protocol(protocol)
   check_uses_git()
-  default_branch <- git_default_branch()
+  default_branch <- guess_local_default_branch()
   check_current_branch(
     is = default_branch,
     # glue-ing happens inside check_current_branch(), where `gb` gives the

R/pr.R

@@ -184,7 +184,7 @@ pr_init <- function(branch) {
     }
   }
 
-  default_branch <- git_default_branch()
+  default_branch <- git_default_branch_(cfg)
   challenge_non_default_branch(
     "Are you sure you want to create a PR branch based on a non-default branch?",
     default_branch = default_branch
@@ -237,7 +237,7 @@ pr_resume <- function(branch = NULL) {
     ui_bullets(c(
       "i" = "No branch specified ... looking up local branches and associated PRs."
     ))
-    default_branch <- git_default_branch()
+    default_branch <- guess_local_default_branch()
     branch <- choose_branch(exclude = default_branch)
     if (is.null(branch)) {
       ui_bullets(c("x" = "Repo doesn't seem to have any non-default branches."))
@@ -375,7 +375,7 @@ pr_push <- function() {
   repo <- git_repo()
   cfg <- github_remote_config(github_get = TRUE)
   check_for_config(cfg, ok_configs = c("ours", "fork"))
-  default_branch <- git_default_branch()
+  default_branch <- git_default_branch_(cfg)
   check_pr_branch(default_branch)
   challenge_uncommitted_changes()
 
@@ -423,7 +423,7 @@ pr_push <- function() {
 pr_pull <- function() {
   cfg <- github_remote_config(github_get = TRUE)
   check_for_config(cfg)
-  default_branch <- git_default_branch()
+  default_branch <- git_default_branch_(cfg)
   check_pr_branch(default_branch)
   challenge_uncommitted_changes()
 
@@ -449,11 +449,12 @@ pr_merge_main <- function() {
 #' @export
 #' @rdname pull-requests
 pr_view <- function(number = NULL, target = c("source", "primary")) {
-  tr <- target_repo(github_get = NA, role = target, ask = FALSE)
+  cfg <- github_remote_config(github_get = NA)
+  tr <- target_repo(cfg, github_get = NA, role = target, ask = FALSE)
   url <- NULL
   if (is.null(number)) {
     branch <- git_branch()
-    default_branch <- git_default_branch()
+    default_branch <- git_default_branch_(cfg)
     if (branch != default_branch) {
       url <- pr_url(branch = branch, tr = tr)
       if (is.null(url)) {
@@ -491,11 +492,11 @@ pr_view <- function(number = NULL, target = c("source", "primary")) {
 #' @export
 #' @rdname pull-requests
 pr_pause <- function() {
-  # intentionally naive selection of target repo
-  tr <- target_repo(github_get = FALSE, ask = FALSE)
+  cfg <- github_remote_config(github_get = NA)
+  tr <- target_repo(cfg, github_get = NA, ask = FALSE)
 
   ui_bullets(c("v" = "Switching back to the default branch."))
-  default_branch <- git_default_branch()
+  default_branch <- git_default_branch_(cfg)
   if (git_branch() == default_branch) {
     ui_bullets(c(
       "!" = "Already on this repo's default branch ({.val {default_branch}}),
@@ -535,8 +536,10 @@ pr_clean <- function(number = NULL,
   withr::defer(rstudio_git_tickle())
   mode <- match.arg(mode)
   repo <- git_repo()
-  tr <- target_repo(github_get = NA, role = target, ask = FALSE)
-  default_branch <- git_default_branch()
+
+  cfg <- github_remote_config(github_get = NA)
+  tr <- target_repo(cfg, github_get = NA, role = target, ask = FALSE)
+  default_branch <- git_default_branch_(cfg)
 
   if (is.null(number)) {
     check_pr_branch(default_branch)
@@ -629,14 +632,10 @@ pr_clean <- function(number = NULL,
 # we're in DEFAULT branch of a fork. I wish everyone set up DEFAULT to track the
 # DEFAULT branch in the source repo, but this protects us against sub-optimal
 # setup.
-pr_pull_source_override <- function(tr = NULL, default_branch = NULL) {
-  # naive selection of target repo; calling function should analyse the config
-  tr <- tr %||% target_repo(github_get = FALSE, ask = FALSE)
-
+pr_pull_source_override <- function(tr, default_branch) {
   # TODO: why does this not use a check_*() function, i.e. shared helper?
   # I guess to issue a specific error message?
   current_branch <- git_branch()
-  default_branch <- default_branch %||% git_default_branch()
   if (current_branch != default_branch) {
     ui_abort("
       Internal error: {.fun pr_pull_source_override} should only be used when on
@@ -994,7 +993,7 @@ pr_branch_delete <- function(pr) {
   invisible(TRUE)
 }
 
-check_pr_branch <- function(default_branch = git_default_branch()) {
+check_pr_branch <- function(default_branch) {
   # the glue-ing happens inside check_current_branch(), where `gb` gives the
   # current git branch
   check_current_branch(

tests/testthat/helper-mocks.R

@@ -28,7 +28,7 @@ local_ui_yep <- function(.env = caller_env()) {
 
 local_git_default_branch_remote <- function(.env = caller_env()) {
   local_mocked_bindings(
-    git_default_branch_remote = function(remote) {
+    git_default_branch_remote = function(cfg, remote) {
       list(
         name = remote,
         is_configured = TRUE,