Only warn for unrecognized token formats

NEWS.md

@@ -1,5 +1,14 @@
 # gh (development version)
 
+* GitHub PAT format validation now issues a warning by default instead of
+  throwing an error, so a PAT in an unrecognized (e.g. newly introduced)
+  format is still used. Set the `gh_validate_tokens` option or the
+  `GH_VALIDATE_TOKENS` environment to `"off"`, `"warn"` or `"error"`
+  to configure this.
+
+* Token validation now recognizes newer GitHub App installation tokens
+  (`ghs_` prefix) (#231, @jharmon-gilead).
+
 * `gh()` no longer returns empty results when httr2's HTTP cache
   revalidates a stored response with `304 Not Modified`.
 

R/gh_token.R

@@ -25,6 +25,17 @@
 #' point on, gh (via [gitcreds::gitcreds_get()]) should be able to find it
 #' without further effort on your part.
 #'
+#' # Token format validation
+#'
+#' gh warns if the PAT it retrieves does not match a known format.
+#' Set `options(gh_validate_tokens = "off")` or the
+#' `GH_VALIDATE_TOKENS=off` environment variable to avoid this warning.
+#' The option takes precedence over the environment variable.
+#'
+#' Set `options(gh_validate_tokens = "error")` or the
+#' `GH_VALIDATE_TOKENS=error` environment variable to make gh throw an
+#' error for an unrecognized PAT format.
+#'
 #' @param api_url GitHub API URL. Defaults to the `GITHUB_API_URL` environment
 #'   variable, if set, and otherwise to <https://api.github.com>.
 #'
@@ -92,6 +103,10 @@ validate_gh_pat <- function(x) {
   if (!inherits(x, "gh_pat")) {
     stop_input_type(x, "a <gh_pat> object")
   }
+  mode <- get_validate_tokens_mode()
+  if (mode == "off") {
+    return(x)
+  }
   if (
     x == "" ||
       # https://github.blog/changelog/2021-03-04-authentication-token-format-updates/
@@ -105,19 +120,61 @@ validate_gh_pat <- function(x) {
       ) ||
       grepl("^[[:xdigit:]]{40}$", x)
   ) {
-    x
+    return(x)
+  }
+  url <- "https://gh.r-lib.org/articles/managing-personal-access-tokens.html"
+  msg <- c(
+    "Invalid GitHub PAT format",
+    "i" = "A GitHub PAT must have one of four forms:",
+    "*" = "40 hexadecimal digits (older PATs)",
+    "*" = "A 'ghp_' prefix followed by 36 to 251 more characters (newer
+           PATs)",
+    "*" = "A `ghs_` prefix followed by about 500 characters (GitHub App
+           installation tokens)",
+    "*" = "A 'github_pat_' prefix followed by 36 to 244 more characters
+           (fine-grained PATs)",
+    "i" = "Read more at {.url {url}}."
+  )
+  sil <- c(
+    "i" = "Set {.code options(gh_validate_tokens = \"off\")} or env var
+           {.envvar GH_VALIDATE_TOKENS=off} to silence this."
+  )
+  if (mode == "warn") {
+    cli::cli_warn(
+      c(msg, sil),
+      .frequency = "regularly",
+      .frequency_id = "gh_invalid_pat"
+    )
+    return(x)
+  }
+  cli::cli_abort(msg)
+}
+
+# Resolve token-validation mode: option > env var > "warn".
+get_validate_tokens_mode <- function() {
+  opt <- getOption("gh_validate_tokens")
+  if (is.null(opt)) {
+    env <- Sys.getenv("GH_VALIDATE_TOKENS", unset = "")
+    mode <- if (nzchar(env)) env else "warn"
   } else {
-    url <- "https://gh.r-lib.org/articles/managing-personal-access-tokens.html"
+    mode <- opt
+  }
+  if (!is.character(mode) || length(mode) != 1L || is.na(mode)) {
+    cli::cli_abort(c(
+      "Invalid token validation setting: must be a single string.",
+      "i" = "Got {.obj_type_friendly {mode}}."
+    ))
+  }
+  mode <- tolower(mode)
+  if (!mode %in% c("off", "warn", "error")) {
     cli::cli_abort(c(
-      "Invalid GitHub PAT format",
-      "i" = "A GitHub PAT must have one of four forms:",
-      "*" = "40 hexadecimal digits (older PATs)",
-      "*" = "A 'ghp_' prefix followed by 36 to 251 more characters (newer PATs)",
-      "*" = "A `ghs_` prefix followed by about 500 characters (GitHub App installation tokens)",
-      "*" = "A 'github_pat_' prefix followed by 36 to 244 more characters (fine-grained PATs)",
-      "i" = "Read more at {.url {url}}."
+      "Invalid token validation mode: {.val {mode}}.",
+      "i" = "Must be one of {.val off}, {.val warn}, or {.val error}.",
+      "i" = "Configure via {.code options(gh_validate_tokens = ...)} or
+             env var {.envvar GH_VALIDATE_TOKENS}."
     ))
   }
+  mode
 }
 
 gh_pat <- function(x) {

README.Rmd

@@ -124,13 +124,18 @@ my_repos2 <- gh("GET /orgs/{org}/repos", org = "r-lib", page = 2)
 vapply(my_repos2, "[[", "", "name")
 ```
 
-## Environment Variables
+## Environment Variables and Options
 
 * The `GITHUB_API_URL` environment variable is used for the default github
   api url.
 * The `GITHUB_PAT` and `GITHUB_TOKEN` environment variables are used, if
   set, in this order, as default token. Consider using the git credential
   store instead, see `?gh::gh_token`.
+* The `GH_VALIDATE_TOKENS` environment variable controls what happens when
+  gh retrieves a PAT in an unrecognized format. Set it to `"off"` to skip
+  validation, `"warn"` (the default) to issue a warning and use the PAT
+  anyway, or `"error"` to abort. The `gh_validate_tokens` R option takes
+  precedence over the environment variable.
 
 ## Code of Conduct
 

README.md

@@ -45,8 +45,8 @@ gitcreds package.
 
 ### API URL
 
--   The `GITHUB_API_URL` environment variable, if set, is used for the
-    default github api url.
+- The `GITHUB_API_URL` environment variable, if set, is used for the
+  default github api url.
 
 ## Usage
 
@@ -138,13 +138,18 @@ vapply(my_repos2, "[[", "", "name")
 #> [26] "liteq"       "keyring"     "sloop"       "styler"      "ansistrings"
 ```
 
-## Environment Variables
-
--   The `GITHUB_API_URL` environment variable is used for the default
-    github api url.
--   The `GITHUB_PAT` and `GITHUB_TOKEN` environment variables are used,
-    if set, in this order, as default token. Consider using the git
-    credential store instead, see `?gh::gh_token`.
+## Environment Variables and Options
+
+- The `GITHUB_API_URL` environment variable is used for the default
+  github api url.
+- The `GITHUB_PAT` and `GITHUB_TOKEN` environment variables are used, if
+  set, in this order, as default token. Consider using the git
+  credential store instead, see `?gh::gh_token`.
+- The `GH_VALIDATE_TOKENS` environment variable controls what happens
+  when gh retrieves a PAT in an unrecognized format. Set it to `"off"`
+  to skip validation, `"warn"` (the default) to issue a warning and use
+  the PAT anyway, or `"error"` to abort. The `gh_validate_tokens` R
+  option takes precedence over the environment variable.
 
 ## Code of Conduct
 

tests/testthat/test-gh_token.R

@@ -56,6 +56,7 @@ test_that("fall back to GITHUB_PAT, then GITHUB_TOKEN", {
 })
 
 test_that("gh_token_exists works as expected", {
+  withr::local_options(gh_validate_tokens = "error")
   withr::local_envvar(GITHUB_API_URL = "https://test.com")
 
   withr::local_envvar(GITHUB_PAT_TEST_COM = NA)
@@ -70,6 +71,8 @@ test_that("gh_token_exists works as expected", {
 
 # gh_pat class ----
 test_that("validate_gh_pat() rejects bad characters, wrong # of characters", {
+  withr::local_options(gh_validate_tokens = "error")
+
   # older PATs
   expect_error(gh_pat(strrep("a", 40)), NA)
   expect_error(
@@ -96,6 +99,42 @@ test_that("validate_gh_pat() rejects bad characters, wrong # of characters", {
   )
 })
 
+test_that("validate_gh_pat() honors gh_validate_tokens option and env var", {
+  bad <- "definitely-not-a-pat"
+
+  # Default is "warn": warns but still returns the value. Reset the
+  # session-wide warning throttle so the expected warning isn't suppressed
+  # by an earlier firing.
+  withr::local_options(gh_validate_tokens = NULL)
+  withr::local_envvar(GH_VALIDATE_TOKENS = NA)
+  rlang::reset_warning_verbosity("gh_invalid_pat")
+  expect_warning(out <- gh_pat(bad), "Invalid GitHub PAT format")
+  expect_s3_class(out, "gh_pat")
+  expect_equal(unclass(out), bad)
+
+  # "off" skips validation, no message of any kind.
+  withr::local_options(gh_validate_tokens = "off")
+  expect_silent(out <- gh_pat(bad))
+  expect_equal(unclass(out), bad)
+
+  # "error" aborts (current pre-default behavior).
+  withr::local_options(gh_validate_tokens = "error")
+  expect_error(gh_pat(bad), "Invalid GitHub PAT format")
+
+  # Env var is honored when option is unset.
+  withr::local_options(gh_validate_tokens = NULL)
+  withr::local_envvar(GH_VALIDATE_TOKENS = "error")
+  expect_error(gh_pat(bad), "Invalid GitHub PAT format")
+
+  # Option takes precedence over env var (env var still "error" from above).
+  withr::local_options(gh_validate_tokens = "off")
+  expect_silent(gh_pat(bad))
+
+  # Unknown mode errors loudly.
+  withr::local_options(gh_validate_tokens = "bogus")
+  expect_error(gh_pat(bad), "Invalid token validation mode")
+})
+
 test_that("format.gh_pat() and str.gh_pat() hide the middle stuff", {
   pat <- paste0(strrep("a", 10), strrep("4", 20), strrep("F", 10))
   expect_match(format(gh_pat(pat)), "[a-zA-Z]+")