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

R/oauth-init.R

@@ -66,6 +66,10 @@ 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 auth_page_query_params Default to \code{list()}. Set to named list
+#'   holding query parameters to append to initial auth page query. Useful for
+#'   some APIs (e.g. Fitbit; see Authorization page URI parameters at
+#'   \url{https://dev.fitbit.com/build/reference/web-api/oauth2/}.)
 #' @export
 #' @keywords internal
 init_oauth2.0 <- function(endpoint, app, scope = NULL,
@@ -75,7 +79,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,
+                          auth_page_query_params = list()
                          ) {
 
   scope <- check_scope(scope)
@@ -99,7 +104,8 @@ init_oauth2.0 <- function(endpoint, app, scope = NULL,
       app,
       scope = scope,
       redirect_uri = redirect_uri,
-      state = state
+      state = state,
+	    auth_page_query_params = auth_page_query_params
     )
     code <- oauth_authorize(authorize_url, use_oob)
   }
@@ -113,23 +119,33 @@ init_oauth2.0 <- function(endpoint, app, scope = NULL,
     type = type,
     redirect_uri = redirect_uri,
     client_credentials = client_credentials,
-    config = config_init
+    config = config_init,
+    auth_page_query_params=auth_page_query_params
   )
 }
 
 #' @export
 #' @rdname init_oauth2.0
 oauth2.0_authorize_url <- function(endpoint, app, scope,
                                    redirect_uri = app$redirect_uri,
-                                   state = nonce()
+                                   state = nonce(),
+                                   auth_page_query_params = auth_page_query_params
                                    ) {
-  modify_url(endpoint$authorize, query = compact(list(
-    client_id = app$key,
-    scope = scope,
-    redirect_uri = redirect_uri,
-    response_type = "code",
-    state = state)
-  ))
+  #TODO might need to put some before and some after...
+  modify_url(endpoint$authorize,
+             query = compact(
+                              c(
+                                list(
+                                  client_id = app$key,
+                                  scope = scope,
+                                  redirect_uri = redirect_uri,
+                                  response_type = "code",
+                                  state = state
+                                ), auth_page_query_params
+                              )
+                     )
+  )
+
 }
 
 #' @export
@@ -142,7 +158,8 @@ oauth2.0_access_token <- function(endpoint,
                                   use_basic_auth = FALSE,
                                   redirect_uri = app$redirect_uri,
                                   client_credentials = FALSE,
-                                  config = list()
+                                  config = list(),
+                                  auth_page_query_params=list()
                                   ) {
 
   req_params <- compact(list(

R/oauth-token.r

@@ -202,6 +202,10 @@ Token1.0 <- R6::R6Class("Token1.0", inherit = Token, list(
 #'   requests.
 #' @param credentials Advanced use only: allows you to completely customise
 #'   token generation.
+#' @param auth_page_query_params Default to \code{list()}. Set to named list
+#'   holding query parameters to append to initial auth page query. Useful for
+#'   some APIs (e.g. Fitbit; see Authorization page URI parameters at
+#'   \url{https://dev.fitbit.com/build/reference/web-api/oauth2/}.)
 #' @inheritParams oauth1.0_token
 #' @return A \code{Token2.0} reference class (RC) object.
 #' @family OAuth
@@ -214,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,
+                           auth_page_query_params = list()
                           ) {
   params <- list(
     scope = scope,
@@ -224,7 +229,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,
+    auth_page_query_params = auth_page_query_params
   )
 
   Token2.0$new(
@@ -245,7 +251,9 @@ Token2.0 <- R6::R6Class("Token2.0", inherit = Token, list(
       type = self$params$type, use_oob = self$params$use_oob,
       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,
+      auth_page_query_params = self$params$auth_page_query_params
+    )
   },
   can_refresh = function() {
     !is.null(self$credentials$refresh_token)

tests/testthat/test-oauth-query-params.R

@@ -0,0 +1,67 @@
+context("OAuth-query-params")
+
+test_that("oauth2.0 authorize url appends query params", {
+  app <- oauth_app("x", "y", "z")
+  scope <- httr:::check_scope(c("foo", "bar"))
+  queryParams <- list(
+    foo = "bar",
+    paul = "isCool"
+  )
+  authURL <- oauth2.0_authorize_url(
+    endpoint = oauth_endpoints("google"),
+    app = app,
+    scope = scope,
+    auth_page_query_params = queryParams
+  )
+
+  url <- parse_url(authURL)
+  paramNames <- names(queryParams)
+  for (qpIndex in 1:length(queryParams))
+  {
+    paramName <- paramNames[qpIndex]
+    expect_equal(url$query[paramName], queryParams[qpIndex])
+  }
+})
+
+test_that("oauth2.0 authorize url does not append empty query params", {
+  testAuthorizeUrlWithEmptyInput <- function(emptyInput) {
+    app <- oauth_app("x", "y", "z")
+    scope <- NULL
+    authURL <- oauth2.0_authorize_url(
+      endpoint = oauth_endpoints("google"),
+      app = app,
+      scope = scope,
+      state = "testing-nonce",
+      auth_page_query_params = emptyInput
+    )
+    urlQuery <- parse_url(authURL)$query
+
+    queryParams <- list(
+      foo = "bar",
+      paul = "isCool"
+    )
+    authURL2 <- oauth2.0_authorize_url(
+      endpoint = oauth_endpoints("google"),
+      app = app,
+      scope = scope,
+      state = "testing-nonce",
+      auth_page_query_params = queryParams
+    )
+    urlQuery2 <- parse_url(authURL2)$query
+
+    appendedQueryParamsIn2 <- urlQuery2[!(urlQuery2 %in% urlQuery)]
+
+    expect_equal(appendedQueryParamsIn2, queryParams)
+
+    appendedQueryParamsIn1 <- urlQuery[!(urlQuery %in% urlQuery2)]
+
+    emptyNamedList <- list()
+    attr(emptyNamedList, "names") <- character(0)
+
+    expect_equal(appendedQueryParamsIn1, emptyNamedList)
+  }
+
+  testAuthorizeUrlWithEmptyInput(list())
+  testAuthorizeUrlWithEmptyInput(NULL)
+
+})