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,29 @@ 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 +154,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,8 @@ 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,63 @@
+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)
+
+})