R/oauth-flow-password.R

In r-lib/httr2: Perform HTTP Requests and Process the Responses

#' OAuth with username and password
#'
#' @description
#' This function implements the OAuth **resource owner password flow**, as
#' defined by `r rfc(6749, 4.3)`. It allows the user to supply their password
#' once, exchanging it for an access token that can be cached locally.
#'
#' Learn more about the overall OAuth authentication flow in
#' <https://httr2.r-lib.org/articles/oauth.html>
#'
#' @export
#' @family OAuth flows
#' @inheritParams req_oauth_auth_code
#' @inheritParams req_auth_basic
#' @returns `req_oauth_password()` returns a modified HTTP [request] that will
#'   use OAuth; `oauth_flow_password()` returns an [oauth_token].
#' @examples
#' req_auth <- function(req) {
#'   req_oauth_password(req,
#'     client = oauth_client("example", "https://example.com/get_token"),
#'     username = "username"
#'   )
#' }
#' if (interactive()) {
#'   request("https://example.com") |>
#'     req_auth()
#' }
req_oauth_password <- function(req,
                               client,
                               username,
                               password = NULL,
                               scope = NULL,
                               token_params = list(),
                               cache_disk = FALSE,
                               cache_key = username) {

  params <- list(
    client = client,
    username = username,
    password = password,
    scope = scope,
    token_params = token_params
  )
  cache <- cache_choose(client, cache_disk = cache_disk, cache_key = cache_key)
  req_oauth(req, "oauth_flow_password", params, cache = cache)
}

#' @export
#' @rdname req_oauth_password
oauth_flow_password <- function(client,
                                username,
                                password = NULL,
                                scope = NULL,
                                token_params = list()) {
  oauth_flow_check("resource owner password credentials", client,
    interactive = is.null(password)
  )
  check_string(username)

  oauth_client_get_token(client,
    grant_type = "password",
    username = username,
    password = check_password(password),
    scope = scope,
    !!!token_params
  )
}

check_password <- function(password, call = caller_env()) {
  if (is.null(password)) {
    check_installed("askpass", call = call)
    password <- askpass::askpass()
  }
  check_string(password, call = call)
  password
}