R/refresh_token.R

Defines functions refresh_token

Documented in refresh_token

#' Refresh Token
#'
#' Refresh  Oauth 2.0 Token
#'
#' This function is baseed upon httr:::refresh_oauth2.0 which doesn't parse the credentials into a list.
#' An additional call to rjson::fromJSON has been added to parse the credentials correctly
#' @param endpoint the endpoint to authenticae against
#' @param app the app to autheticate
#' @param credentials the credentials list from a token generated by get_token
#' @param use_basic_auth should basic authorization be used - don't know what this does
#' @param user_params user parameters to send with request
#' @return a list of refreshed credentials
#' @importFrom utils modifyList
#' @importFrom httr authenticate
#' @importFrom httr POST
#' @importFrom httr content
#' @importFrom httr stop_for_status
#' @source https://rdrr.io/cran/httr/src/R/oauth-refresh.R https://cran.r-project.org/package=httr
refresh_token <-
  function(endpoint,
           app,
           credentials,
           user_params = NULL,
           use_basic_auth = FALSE) {
    if (is.null(credentials$refresh_token)) {
      stop("Refresh token not available", call. = FALSE)
    }

    refresh_url <- endpoint$access
    req_params <- list(
      refresh_token = credentials$refresh_token,
      client_id = app$key,
      grant_type = "refresh_token"
    )

    if (!is.null(user_params)) {
      req_params <- utils::modifyList(user_params, req_params, keep.null = FALSE)
    }

    if (isTRUE(use_basic_auth)) {
      response <- httr::POST(
        refresh_url,
        body = req_params,
        encode = "form",
        httr::authenticate(app$key, app$secret, type = "basic")
      )
    } else {
      req_params$client_secret <- app$secret
      response <-
        httr::POST(refresh_url, body = req_params, encode = "form")
    }

    err <- httr:::find_oauth2.0_error(response)
    if (!is.null(err)) {
      lines <- c(
        paste0("Unable to refresh token: ", err$error),
        err$error_description,
        err$error_uri
      )
      warning(paste(lines, collapse = "\n"), call. = FALSE)
      return(NULL)
    }

    httr::stop_for_status(response)
    refresh_data <- httr::content(response)
    # The arc gis server returns a format that httr doesn't auto parse (previously, API appears to be fixed now)
    # This line is added in to parse it and add the new credentials in
    # Only parse the JSON if it isn't already a list
    if(!is.list(refresh_data)){refresh_data <- jsonlite::fromJSON(refresh_data)}
    utils::modifyList(credentials,
                      refresh_data)
  }
MatthewJWhittle/getarc documentation built on April 22, 2023, 12:16 p.m.