R/Gargle-class.R

Defines functions select_pseudo_oob_value encourage_httpuv gargle2.0_token

Documented in gargle2.0_token

#' Generate a gargle token
#'
#' Constructor function for objects of class [Gargle2.0].
#'
#' @param email Optional. If specified, `email` can take several different
#'   forms:
#' * `"jane@gmail.com"`, i.e. an actual email address. This allows the user to
#' target a specific Google identity. If specified, this is used for token
#' lookup, i.e. to determine if a suitable token is already available in the
#' cache. If no such token is found, `email` is used to pre-select the targeted
#' Google identity in the OAuth chooser. (Note, however, that the email
#' associated with a token when it's cached is always determined from the token
#' itself, never from this argument).
#' * `"*@example.com"`, i.e. a domain-only glob pattern. This can be helpful if
#' you need code that "just works" for both `alice@example.com` and
#' `bob@example.com`.
#' * `TRUE` means that you are approving email auto-discovery. If exactly one
#'   matching token is found in the cache, it will be used.
#' * `FALSE` or `NA` mean that you want to ignore the token cache and force a
#' new OAuth dance in the browser.
#'
#' Defaults to the option named `"gargle_oauth_email"`, retrieved by
#' [gargle::gargle_oauth_email()] (unless a wrapper package implements different
#' default behavior).
#' @param client A Google OAuth client, preferably constructed via
#'   [gargle::gargle_oauth_client_from_json()], which returns an instance of
#'   `gargle_oauth_client`. For backwards compatibility, for a limited time,
#'   gargle will still accept an "OAuth app" created with [httr::oauth_app()].
#' @param package Name of the package requesting a token. Used in messages.
#' @param scope A character vector of scopes to request.
#' @param use_oob Whether to use out-of-band authentication (or, perhaps, a
#'   variant implemented by gargle and known as "pseudo-OOB") when first
#'   acquiring the token. Defaults to the value returned by
#'   [gargle::gargle_oob_default()]. Note that (pseudo-)OOB auth only affects
#'   the initial OAuth dance. If we retrieve (and possibly refresh) a
#'   cached token, `use_oob` has no effect.
#'
#'   If the OAuth client is provided implicitly by a wrapper package, its type
#'   probably defaults to the value returned by
#'   [gargle::gargle_oauth_client_type()]. You can take control of the client
#'   type by setting `options(gargle_oauth_client_type = "web")` or
#'   `options(gargle_oauth_client_type = "installed")`.
#' @param cache Specifies the OAuth token cache. Defaults to the option named
#'   `"gargle_oauth_cache"`, retrieved via [gargle::gargle_oauth_cache()].
#' @inheritParams httr::oauth2.0_token
#' @param ... Absorbs arguments intended for use by other credential functions.
#'   Not used.
#' @param app `r lifecycle::badge('deprecated')` Replaced by the `client`
#'   argument.
#' @return An object of class [Gargle2.0], either new or loaded from the cache.
#' @export
#' @examples
#' \dontrun{
#' gargle2.0_token()
#' }
gargle2.0_token <- function(email = gargle_oauth_email(),
                            client = gargle_client(),
                            package = "gargle",
                            ## params start
                            scope = NULL,
                            use_oob = gargle_oob_default(),
                            ## params end
                            credentials = NULL,
                            cache = if (is.null(credentials)) gargle_oauth_cache() else FALSE,
                            ...,
                            app = deprecated()) {
  if (lifecycle::is_present(app)) {
    lifecycle::deprecate_soft(
      "1.5.0",
      "gargle2.0_token(app)",
      "gargle2.0_token(client)"
    )
    client <- app
  }

  params <- list(
    scope = scope,
    use_oob = use_oob,
    as_header = TRUE
  )

  # pseudo-OOB flow
  client_type <- if (inherits(client, "gargle_oauth_client")) client$type else NA
  if (use_oob && identical(client_type, "web")) {
    params$oob_value <- select_pseudo_oob_value(client$redirect_uris)
  }
  # params$oob_value is deliberately left unspecified for conventional OOB,
  # with the intent of falling back to urn:ietf:wg:oauth:2.0:oob

  # this allows pseudo-OOB auth to work on colab, because:
  # 1) gargle's attempts to communicate with the user route through readline()
  #    which is shimmed in Jupyter (and therefore Colab)
  # 2) httr >= 1.4.5 honors the "rlang_interactive" option when deciding whether
  #   it will try the oauth dance
  if (is_google_colab()) {
    withr::local_options(rlang_interactive = TRUE)
  }

  Gargle2.0$new(
    email = email,
    client = client,
    package = package,
    params = params,
    credentials = credentials,
    cache_path = cache
  )
}

#' OAuth2 token objects specific to Google APIs
#'
#' @description
#' `Gargle2.0` is based on the [`Token2.0`][httr::Token-class] class provided in
#' httr. The preferred way to create a `Gargle2.0` token is through the
#' constructor function [gargle2.0_token()]. Key differences with `Token2.0`:
#' * The key for a cached `Token2.0` comes from hashing the endpoint, client,
#' and scopes. For the `Gargle2.0` subclass, the identifier or key is expanded
#' to include the email address associated with the token. This makes it easier
#' to work with Google APIs with multiple identities.
#' * `Gargle2.0` tokens are cached, by default, at the user level, following the
#' XDG spec for storing user-specific data and cache files. In contrast, the
#' default location for `Token2.0` is `./.httr-oauth`, i.e. in current working
#' directory. `Gargle2.0` behaviour makes it easier to reuse tokens across
#' projects and makes it less likely that tokens are accidentally synced to a
#' remote location like GitHub or DropBox.
#' * Each `Gargle2.0` token is cached in its own file. The token cache is a
#' directory of such files. In contrast, `Token2.0` tokens are cached as
#' components of a list, which is typically serialized to `./.httr-oauth`.
#'

#' @param email Optional email address. See [gargle2.0_token()] for full
#'   details.
#' @param client An OAuth consumer application.
#' @param package Name of the package requesting a token. Used in messages.
#' @param credentials Exists largely for testing purposes.
#' @param params A list of parameters for the internal function
#'   `init_oauth2.0()`, which is a modified version of [httr::init_oauth2.0()].
#'   gargle actively uses `scope` and `use_oob`, but does not use `user_params`,
#'   `type`, `as_header` (hard-wired to `TRUE`), `use_basic_auth` (accept
#'   default of `use_basic_auth = FALSE`), `config_init`, or
#'   `client_credentials`.
#' @param cache_path Specifies the OAuth token cache. Read more in
#'   [gargle::gargle_oauth_cache()].
#' @param app `r lifecycle::badge('deprecated')` Use `client` instead.
#'
#' @keywords internal
#' @export
#' @name Gargle-class
Gargle2.0 <- R6::R6Class("Gargle2.0", inherit = httr::Token2.0, list(
  #' @field email Email associated with the token.
  email = NULL,
  #' @field package Name of the package requesting a token. Used in messages.
  package = NULL,
  #' @field client An OAuth client.
  client = NULL,
  #' @description Create a Gargle2.0 token
  #' @return A Gargle2.0 token.
  initialize = function(email = gargle_oauth_email(),
                        client = gargle_client(),
                        package = "gargle",
                        credentials = NULL,
                        params = list(),
                        cache_path = gargle_oauth_cache(),
                        app = deprecated()) {
    gargle_debug("Gargle2.0 initialize")
    # I'm using deprecate_warn() intentionally here. Most folks should be
    # instantiating through gargle2.0_token() anyway, so anyone who sees this
    # warning probably needs to see it.
    if (lifecycle::is_present(app)) {
      lifecycle::deprecate_warn(
        "1.5.0",
        "Gargle2.0$initialize(app)",
        "Gargle2.0$initialize(client)"
      )
      client <- app
    }
    stopifnot(
      is.null(email) || is_scalar_character(email) ||
        isTRUE(email) || isFALSE(email) || is_na(email),
      is.oauth_app(client),
      is_string(package),
      is.list(params)
    )
    if (identical(email, "")) {
      gargle_abort(c(
        "{.arg email} must not be \"\" (the empty string).",
        "i" = "Do you intend to consult an env var, but it's unset?"
      ))
    }
    if (isTRUE(email)) {
      email <- "*"
    }
    if (isFALSE(email) || is_na(email)) {
      email <- NA_character_
    }
    # https://developers.google.com/identity/protocols/OpenIDConnect#login-hint
    # optional hint for the auth server to pre-fill the email box
    login_hint <- if (is_string(email) && !startsWith(email, "*")) email

    self$endpoint   <- gargle_oauth_endpoint()
    self$email      <- email
    self$client     <- client
    # for backwards compatibility and also because the parent class has $app;
    # I can never remove it
    self$app        <- client
    self$package    <- package
    params$scope    <- normalize_scopes(add_email_scope(params$scope))
    params$query_authorize_extra <- list(login_hint = login_hint)
    self$params     <- params
    self$cache_path <- cache_establish(cache_path)

    if (!is.null(credentials)) {
      # Use credentials created elsewhere - usually for tests
      gargle_debug("credentials provided directly")
      self$credentials <- credentials
      return(self$cache())
    }

    # Are credentials cached already?
    if (self$load_from_cache()) {
      self
    } else {
      gargle_debug("no matching token in the cache")
      self$init_credentials()
      self$email <- token_email(self) %||% NA_character_
      self$cache()
    }
  },
  #' @description Format a Gargle2.0 token
  #' @param ... Not used.
  format = function(...) {
    x <- list(
      oauth_endpoint = "google",
      client         = self$client$name,
      email          = cli::format_inline("{.email {self$email}}"),
      scopes         = commapse(base_scope(self$params$scope)),
      credentials    = commapse(names(self$credentials))
    )
    c(
      cli::cli_format_method(
        cli::cli_h1("<Token (via {.pkg gargle})>")
      ),
      glue("{fr(names(x))}: {fl(x)}")
    )
  },
  #' @description Print a Gargle2.0 token
  #' @param ... Not used.
  print = function(...) {
    # a format method is not sufficient for Gargle2.0 because the parent class
    # has a print method
    cli::cat_line(self$format())
  },
  #' @description Generate the email-augmented hash of a Gargle2.0 token
  hash = function() {
    paste(super$hash(), self$email, sep = "_")
  },
  #' @description Put a Gargle2.0 token into the cache
  cache = function() {
    token_into_cache(self)
    self
  },
  #' @description (Attempt to) get a Gargle2.0 token from the cache
  load_from_cache = function() {
    gargle_debug("loading token from the cache")
    if (is.null(self$cache_path) || is_na(self$email)) {
      return(FALSE)
    }

    gargle_debug("email: {.email {self$email}}")
    gargle_debug("oauth client name: {self$client$name}")
    gargle_debug("oauth client name: {self$client$type}")
    gargle_debug("oauth client id: {self$client$id}")
    gargle_debug("scopes: {commapse(base_scope(self$params$scope))}")

    cached <- token_from_cache(self)
    if (is.null(cached)) {
      return(FALSE)
    }

    gargle_debug("matching token found in the cache")
    self$endpoint    <- cached$endpoint
    self$email       <- cached$email
    self$client      <- cached$client
    self$app         <- cached$client
    self$credentials <- cached$credentials
    self$params      <- cached$params
    TRUE
  },
  #' @description (Attempt to) refresh a Gargle2.0 token
  refresh = function() {
    cred <- refresh_oauth2.0(
      self$endpoint, self$client, self$credentials,
      package = self$package
    )
    if (is.null(cred)) {
      token_remove_from_cache(self)
      # It's tricky to decide what to do here. Currently we return the current,
      # invalid, unrefreshed token, but we clear the refresh_token field, to
      # prevent subsequent refresh attempts.
      #
      # Analysis from a BYO token POV:
      # I've decided the status quo may be the best move, because it causes
      # token_fetch() to return instead of moving on to try other methods. If
      # someone provides token_fetch(token =), I think it's clear that they
      # want/hope to use that token and they don't want to end up doing the
      # OAuth browser dance. If we threw an error or returned NULL,
      # token_fetch() would just keep going. The refresh failure does throw a
      # visible warning:
      #
      # Warning message:
      # Unable to refresh token: invalid_grant
      # • Token has been expired or revoked.
      #
      # However, this does mean that functions like PKG_has_token() still return
      # TRUE and that some other method must be used to find out if we have a
      # *valid* token. gargle::token_tokeninfo() and API-specific functions for
      # "tell me about the current user" are good candidates, such as
      # gmailr::gm_profile() or googledrive::drive_user().
      self$credentials$refresh_token <- NULL
    } else {
      self$credentials <- cred
      self$cache()
    }
    self
  },
  #' @description Initiate a new Gargle2.0 token
  init_credentials = function() {
    gargle_debug("initiating new token")
    if (is_interactive()) {
      if (!isTRUE(self$params$use_oob) && !is_hosted_session()) {
        encourage_httpuv()
      }
      self$credentials <- init_oauth2.0(
        self$endpoint,
        self$client,
        scope = self$params$scope,
        use_oob = self$params$use_oob,
        oob_value = self$params$oob_value,
        query_authorize_extra = self$params$query_authorize_extra
      )
    } else {
      # TODO: good candidate for an eventual sub-classed gargle error
      # would be useful in testing to know that this is exactly where we aborted
      gargle_abort("OAuth2 flow requires an interactive session.")
    }
  }
))

encourage_httpuv <- function() {
  if (!is_interactive() || isTRUE(is_installed("httpuv"))) {
    return(invisible())
  }
  choice <- cli_menu(
   "The {.pkg httpuv} package enables a nicer Google auth experience, in many \\
    cases, but it isn't installed.",
    "Would you like to install it now?",
    choices = c("Yes", "No")
  )
  if (choice == 1) {
    utils::install.packages("httpuv")
  }
  invisible()
}

# I want to encourage users to create an OAuth client (newer httr2-y language)
# directly from downloaded JSON, using gargle_oauth_client_from_json().
# Sometimes there are multiple URIs and I think we can usually figure out which
# one to use for the pseudo-OOB flow.
select_pseudo_oob_value <- function(redirect_uris) {
  # https://developers.google.com/identity/protocols/oauth2/resources/oob-migration#inspect-your-application-code
  bad_values <- c(
    "urn:ietf:wg:oauth:2.0:oob",
    "urn:ietf:wg:oauth:2.0:oob:auto",
    "oob"
  )
  redirect_uris <- setdiff(redirect_uris, bad_values)

  # https://developers.google.com/identity/protocols/oauth2/web-server#uri-validation
  bad_regex <- "^http[s]?://(localhost|127.0.0.1)"
  redirect_uris <- grep(bad_regex, redirect_uris, value = TRUE, invert = TRUE)
  redirect_uris <- grep("^https", redirect_uris, value = TRUE)

  # inspired by these guidelines re: URIs associated with URL shorteners:
  # 'redirect URI must either contain "/google-callback/" in its path or end
  # with "/google-callback"'
  m <- grep("/google-callback(/|$)", redirect_uris)
  if (length(m) > 0) {
    redirect_uris <- redirect_uris[m]
  }

  if (length(redirect_uris) == 0) {
    gargle_abort('
      OAuth client does not have a redirect URI suitable for the pseudo-OOB \\
      flow.')
  }

  if (length(redirect_uris) > 1) {
    msg <- c(
      "Can't determine which redirect URI to use for the pseudo-OOB flow:",
      set_names(redirect_uris, ~ rep_along(., "*"))
    )
    gargle_abort(msg)
  }

  redirect_uris
}

Try the gargle package in your browser

Any scripts or data that you put into this service are public.

gargle documentation built on July 26, 2023, 5:29 p.m.