Develop gm_scopes() further (#179)

* Develop gm_scopes() further

* Word-o

* Prefer slightly longer gmail.* form for scopes

* Cover one more case here

* More test tweaks

* Different form for anonymous function

NEWS.md

@@ -1,5 +1,11 @@
 # gmailr (development version)
 
+* `gm_scopes()` can now take a character vector of scopes, each of which can be
+  an actual scope or a short alias, e.g., `"gmail.readonly"`, which identifies a
+  scope associated with the Gmail API. When called without arguments,
+  `gm_scopes()` still returns a named vector of Gmail API-specific scopes, where
+  the names are the associated short aliases.
+
 * The deprecation process for legacy functions that lack the `gm_` prefix has
   been advanced to the next stage, getting closer to actual removal. More users
   will see deprecation warnings in more contexts.

R/gm-auth.R

@@ -14,35 +14,29 @@ gargle_lookup_table <- list(
   PREFIX      = "gm"
 )
 
-#' @rdname gm_auth
-#' @export
-gm_scopes <- function() {
-  c(labels = "https://www.googleapis.com/auth/gmail.labels",
-    send = "https://www.googleapis.com/auth/gmail.send",
-    readonly = "https://www.googleapis.com/auth/gmail.readonly",
-    compose = "https://www.googleapis.com/auth/gmail.compose",
-    insert = "https://www.googleapis.com/auth/gmail.insert",
-    modify = "https://www.googleapis.com/auth/gmail.modify",
-    metadata = "https://www.googleapis.com/auth/gmail.metadata",
-    settings_basic = "https://www.googleapis.com/auth/gmail.settings.basic",
-    settings_sharing = "https://www.googleapis.com/auth/gmail.settings.sharing",
-    full = "https://mail.google.com/"
-  )
-}
-
 #' Authorize gmailr
 #'
 #' @eval gargle:::PREFIX_auth_description(gargle_lookup_table)
 #' @eval gargle:::PREFIX_auth_details(gargle_lookup_table)
 #' @eval gargle:::PREFIX_auth_params()
 #'
 #' @family auth functions
-#' @param scopes One or more gmail API scope to use, one of 'labels', 'send',
-#'   'readonly', 'compose', 'insert', 'modify', 'metadata', 'settings_basic',
-#'   'settings_sharing' or 'full' (default: 'full'). See
-#'   <https://developers.google.com/gmail/api/auth/scopes> for details on the
-#'   permissions for each scope. and `gm_scopes()` to return a vector of the
-#'   available scopes.
+#' @param scopes One or more API scopes. Each scope can be specified in full or,
+#'   for Gmail API-specific scopes, in an abbreviated form that is recognized by
+#'   [gm_scopes()]:
+#'   * "full" = "https://mail.google.com/" (the default)
+#'   * "gmail.compose" = "https://www.googleapis.com/auth/gmail.compose"
+#'   * "gmail.readonly" = "https://www.googleapis.com/auth/gmail.readonly"
+#'   * "gmail.labels" = "https://www.googleapis.com/auth/gmail.labels"
+#'   * "gmail.send" = "https://www.googleapis.com/auth/gmail.send"
+#'   * "gmail.insert" = "https://www.googleapis.com/auth/gmail.insert"
+#'   * "gmail.modify" = "https://www.googleapis.com/auth/gmail.modify"
+#'   * "gmail.metadata" = "https://www.googleapis.com/auth/gmail.metadata"
+#'   * "gmail.settings_basic" = "https://www.googleapis.com/auth/gmail.settings.basic"
+#'   * "gmail.settings_sharing" = "https://www.googleapis.com/auth/gmail.settings.sharing"
+#'
+#' See <https://developers.google.com/gmail/api/auth/scopes> for details on the
+#' permissions for each scope.
 #' @export
 #'
 #' @examples
@@ -73,7 +67,7 @@ gm_auth <- function(email = gm_default_email(),
                     use_oob = gargle::gargle_oob_default(),
                     token = NULL) {
 
-  scopes <- gm_scopes()[match.arg(scopes, names(gm_scopes()), several.ok = TRUE)]
+  scopes <- gm_scopes(scopes)
 
   app <- gm_oauth_app()
 
@@ -282,3 +276,88 @@ print.gmail_profile <- function(x, ...) {
   )
   invisible(x)
 }
+
+#' Produce scopes specific to the Gmail API
+#'
+#' When called with no arguments, `gm_scopes()` returns a named character vector
+#' of scopes associated with the Gmail API. If `gm_scopes(scopes =)` is given,
+#' an abbreviated entry such as `"gmail.readonly"` is expanded to a full scope
+#' (`"https://www.googleapis.com/auth/gmail.readonly"` in this case).
+#' Unrecognized scopes are passed through unchanged.
+#'
+#' @inheritParams gm_auth
+#'
+#' @seealso <https://developers.google.com/gmail/api/auth/scopes> for details on
+#'   the permissions for each scope.
+#' @returns A character vector of scopes.
+#' @family auth functions
+#' @export
+#' @examples
+#' gm_scopes("full")
+#' gm_scopes("gmail.readonly")
+#' gm_scopes()
+gm_scopes <- function(scopes = NULL) {
+  if (is.null(scopes)) {
+    return(gmail_scopes)
+  }
+
+  # In hindsight, I think it is better for the short form to be slightly less
+  # short. Once you start to think about the full set of APIs and supporting
+  # this in gargle, it seems that "gmail.compose" is better than "compose".
+  # gmailr will continue to accept the original, very short forms for backwards
+  # compatibility, but we catch, warn, and modify them here.
+  scopes <- fixup_gmail_scopes(scopes)
+
+  resolve_scopes(user_scopes = scopes, package_scopes = gmail_scopes)
+}
+
+gmail_scopes <- c(
+  full                   = "https://mail.google.com/",
+  gmail.compose          = "https://www.googleapis.com/auth/gmail.compose",
+  gmail.readonly         = "https://www.googleapis.com/auth/gmail.readonly",
+  gmail.labels           = "https://www.googleapis.com/auth/gmail.labels",
+  gmail.send             = "https://www.googleapis.com/auth/gmail.send",
+  gmail.insert           = "https://www.googleapis.com/auth/gmail.insert",
+  gmail.modify           = "https://www.googleapis.com/auth/gmail.modify",
+  gmail.metadata         = "https://www.googleapis.com/auth/gmail.metadata",
+  gmail.settings_basic   = "https://www.googleapis.com/auth/gmail.settings.basic",
+  gmail.settings_sharing = "https://www.googleapis.com/auth/gmail.settings.sharing"
+)
+
+# TODO: put some version of this in gargle
+resolve_scopes <- function(user_scopes, package_scopes) {
+  m <- match(user_scopes, names(package_scopes))
+  ifelse(is.na(m), user_scopes, package_scopes[m])
+}
+
+# 'readonly' --> 'gmail.readonly'
+# 'whatever' --> 'whatever'
+fixup_gmail_scopes <- function(scopes) {
+  haystack <- grep(
+    "^https://www.googleapis.com/auth/gmail.",
+    gmail_scopes,
+    value = TRUE
+  )
+  haystack <- basename(haystack)
+  haystack <- set_names(haystack, function(x) sub("^gmail[.]", "", x))
+
+  m <- match(scopes, names(haystack))
+
+  if (any(!is.na(m))) {
+    needs_work <- haystack[m]
+    needs_work <- needs_work[!is.na(needs_work)]
+    what <- glue('
+      The use of extremely short scopes \\
+      ({glue::glue_collapse(glue::double_quote(names(needs_work)), sep = ", ")})')
+    with <- glue('
+      the slightly longer form \\
+      ({glue::glue_collapse(glue::double_quote(needs_work), sep = ", ")})')
+    lifecycle::deprecate_warn(
+      when = "2.0.0",
+      what = I(what),
+      with = I(with)
+    )
+  }
+
+  ifelse(is.na(m), scopes, haystack[m])
+}

tests/testthat/_snaps/gm-auth.md

@@ -0,0 +1,36 @@
+# gm_scopes() reveals gmail scopes
+
+    Code
+      gm_scopes()
+    Output
+                                                          full 
+                                    "https://mail.google.com/" 
+                                                 gmail.compose 
+               "https://www.googleapis.com/auth/gmail.compose" 
+                                                gmail.readonly 
+              "https://www.googleapis.com/auth/gmail.readonly" 
+                                                  gmail.labels 
+                "https://www.googleapis.com/auth/gmail.labels" 
+                                                    gmail.send 
+                  "https://www.googleapis.com/auth/gmail.send" 
+                                                  gmail.insert 
+                "https://www.googleapis.com/auth/gmail.insert" 
+                                                  gmail.modify 
+                "https://www.googleapis.com/auth/gmail.modify" 
+                                                gmail.metadata 
+              "https://www.googleapis.com/auth/gmail.metadata" 
+                                          gmail.settings_basic 
+        "https://www.googleapis.com/auth/gmail.settings.basic" 
+                                        gmail.settings_sharing 
+      "https://www.googleapis.com/auth/gmail.settings.sharing" 
+
+# gm_scopes() substitutes actual scope for legacy super-short form
+
+    The use of extremely short scopes ("readonly") was deprecated in gmailr 2.0.0.
+    i Please use the slightly longer form ("gmail.readonly") instead.
+
+---
+
+    The use of extremely short scopes ("readonly", "compose") was deprecated in gmailr 2.0.0.
+    i Please use the slightly longer form ("gmail.readonly", "gmail.compose") instead.
+

tests/testthat/test-gm-auth.R

@@ -8,3 +8,57 @@ test_that("gm_auth_configure() can accept the app via `app`", {
 
   expect_error_free(gm_auth_configure(app = google_app))
 })
+
+test_that("gm_scopes() reveals gmail scopes", {
+  local_edition(3)
+  expect_snapshot(gm_scopes())
+})
+
+test_that("gm_scopes() substitutes actual scope for short form", {
+  expect_equal(
+    gm_scopes(c(
+      "full",
+      "gmail.readonly",
+      "gmail.settings_basic"
+    )),
+    c(
+      "https://mail.google.com/",
+      "https://www.googleapis.com/auth/gmail.readonly",
+      "https://www.googleapis.com/auth/gmail.settings.basic"
+    )
+  )
+})
+
+test_that("gm_scopes() substitutes actual scope for legacy super-short form", {
+  local_edition(3)
+  local_reproducible_output()
+  withr::local_options(lifecycle_verbosity = "warning")
+  expect_snapshot_warning(
+    out <- gm_scopes("readonly")
+  )
+  expect_equal(out, gm_scopes("gmail.readonly"))
+
+  # multiple legacy scopes, plus another one
+  expect_snapshot_warning(
+    out <- gm_scopes(c("readonly", "openid", "compose"))
+  )
+  expect_equal(
+    out,
+    gm_scopes(c("gmail.readonly", "openid", "gmail.compose"))
+  )
+})
+
+test_that("gm_scopes() passes unrecognized scopes through", {
+  expect_equal(
+    gm_scopes(c(
+      "email",
+      "gmail.compose",
+      "https://www.googleapis.com/auth/cloud-platform"
+    )),
+    c(
+      "email",
+      "https://www.googleapis.com/auth/gmail.compose",
+      "https://www.googleapis.com/auth/cloud-platform"
+    )
+  )
+})