added ability to pass down url query parameters to initial oauth2.0 authorization page

NAMESPACE

@@ -116,3 +116,4 @@ export(write_function)
 export(write_memory)
 export(write_stream)
 importFrom(R6,R6Class)
+importFrom(utils,modifyList)

NEWS.md

@@ -17,6 +17,8 @@
 
 * The default value of `failure` argument in `parse_http_date()` is set to `structure(NA_real_, class = "Date")` so that the reponse with a "failure" date can be printed out correctly. (@shrektan, #544)
 
+* `oauth2.0_token` & `init_oauth2.0` (through the new `query_authorize_extra` parameter) as well as `oauth2.0_authorize_url()` (through new `query_extra` parameter) gain the ability to append extra user-specified URL query parameters (as named `list()`) to the oauth2.0 authorization URL used to initially request an oauth2.0 token from the authentication server; this is useful for some APIs (e.g. Fitbit) (@cosmomeese, #503).
+
 # httr 1.3.1
 
 * Re-enable on-disk caching (accidentally disabled in #457) (#475)

R/oauth-init.R

@@ -69,6 +69,9 @@ init_oauth1.0 <- function(endpoint, app, permission = NULL,
 #' @param client_credentials Default to \code{FALSE}. Set to \code{TRUE} to use
 #'   \emph{Client Credentials Grant} instead of \emph{Authorization
 #'   Code Grant}. See \url{https://tools.ietf.org/html/rfc6749#section-4.4}.
+#' @param query_authorize_extra Default to \code{list()}. Set to named list
+#'   holding query parameters to append to initial auth page query. Useful for
+#'   some APIs.
 #' @export
 #' @keywords internal
 init_oauth2.0 <- function(endpoint, app, scope = NULL,
@@ -79,7 +82,8 @@ init_oauth2.0 <- function(endpoint, app, scope = NULL,
                           is_interactive = interactive(),
                           use_basic_auth = FALSE,
                           config_init = list(),
-                          client_credentials = FALSE
+                          client_credentials = FALSE,
+                          query_authorize_extra = list()
                          ) {
 
   scope <- check_scope(scope)
@@ -102,7 +106,8 @@ init_oauth2.0 <- function(endpoint, app, scope = NULL,
       app,
       scope = scope,
       redirect_uri = redirect_uri,
-      state = state
+      state = state,
+      query_extra = query_authorize_extra
     )
     code <- oauth_authorize(authorize_url, use_oob)
   }
@@ -121,18 +126,32 @@ init_oauth2.0 <- function(endpoint, app, scope = NULL,
 }
 
 #' @export
+#' @importFrom utils modifyList
 #' @rdname init_oauth2.0
+#' @param query_extra See \code{query_authorize_extra}
 oauth2.0_authorize_url <- function(endpoint, app, scope,
                                    redirect_uri = app$redirect_uri,
-                                   state = nonce()
+                                   state = nonce(),
+                                   query_extra = list()
                                    ) {
-  modify_url(endpoint$authorize, query = compact(list(
+  #TODO might need to put some params before and some after...
+
+  query_extra <- query_extra %||% list() # i.e. make list if query_extra is null
+
+  default_query <- list(
     client_id = app$key,
     scope = scope,
     redirect_uri = redirect_uri,
     response_type = "code",
-    state = state)
-  ))
+    state = state
+  )
+
+  query <- compact(modifyList(default_query, query_extra))
+
+  modify_url(
+    endpoint$authorize,
+    query = query
+  )
 }
 
 #' @export

R/oauth-token.r

@@ -218,7 +218,8 @@ oauth2.0_token <- function(endpoint, app, scope = NULL, user_params = NULL,
                            cache = getOption("httr_oauth_cache"),
                            config_init = list(),
                            client_credentials = FALSE,
-                           credentials = NULL
+                           credentials = NULL,
+                           query_authorize_extra = list()
                           ) {
   params <- list(
     scope = scope,
@@ -229,7 +230,8 @@ oauth2.0_token <- function(endpoint, app, scope = NULL, user_params = NULL,
     as_header = as_header,
     use_basic_auth = use_basic_auth,
     config_init = config_init,
-    client_credentials = client_credentials
+    client_credentials = client_credentials,
+    query_authorize_extra = query_authorize_extra
   )
 
   Token2.0$new(
@@ -251,7 +253,9 @@ Token2.0 <- R6::R6Class("Token2.0", inherit = Token, list(
       oob_value = self$params$oob_value,
       use_basic_auth = self$params$use_basic_auth,
       config_init = self$params$config_init,
-      client_credentials = self$params$client_credentials)
+      client_credentials = self$params$client_credentials,
+      query_authorize_extra = self$params$query_authorize_extra
+    )
   },
   can_refresh = function() {
     !is.null(self$credentials$refresh_token)

tests/testthat/test-oauth.R

@@ -53,6 +53,45 @@ test_that("oauth_encode1 works", {
   expect_equal(orig_string, restored_string)
 })
 
+test_that("oauth2.0 authorize url appends query params", {
+  app <- oauth_app("x", "y", "z")
+  scope <- NULL
+  query_extra <- list(
+    foo = "bar"
+  )
+  authURL <- oauth2.0_authorize_url(
+    endpoint = oauth_endpoints("google"),
+    app = app,
+    scope = scope,
+    query_extra = query_extra
+  )
+
+  url <- parse_url(authURL)
+  expect_equal(url$query$foo, "bar")
+})
+
+test_that("oauth2.0 authorize url handles empty query_extra input", {
+  # common constructor
+  authorize_url_extra_params <- function(extra_params)
+  {
+    app <- oauth_app("x", "y", "z")
+    scope <- NULL
+
+    url_with_empty_input <- oauth2.0_authorize_url(
+      endpoint = oauth_endpoints("google"),
+      app = app,
+      scope = scope,
+      state = "testing-nonce",
+      query_extra = extra_params
+    )
+    parse_url(url_with_empty_input)$query
+  }
+
+  # expect NA (i.e. no) error
+  expect_error(authorize_url_extra_params(list()), NA) # with empty list
+  expect_error(authorize_url_extra_params(NULL), NA) # with NULL list
+})
+
 # Parameter checking ------------------------------------------------------
 
 test_that("scope must be character or NULL", {