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)

R/oauth-init.R

@@ -66,6 +66,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,
@@ -75,7 +78,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)
@@ -99,7 +103,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)
   }
@@ -118,18 +123,39 @@ 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...
+
+  if(is.null(query_extra))
+  {
+    query_extra <- list()
+  }
+
+  default_query <- list(
     client_id = app$key,
     scope = scope,
     redirect_uri = redirect_uri,
     response_type = "code",
-    state = state)
-  ))
+    state = state
+  )
+
+
+  query <- modifyList(default_query, query_extra)
+  query <- compact(query)
+
+  url <- modify_url(
+    endpoint$authorize,
+    query = query
+  )
+
+  return(url)
 }
 
 #' @export

R/oauth-token.r

@@ -214,7 +214,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,
@@ -224,7 +225,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(
@@ -245,7 +247,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,
+      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,75 @@ 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 with empty input does not append empty query params", {
+  # common constructor
+  authorize_url_with_extra <- function(query_extra)
+  {
+    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 = query_extra
+    )
+  }
+
+  test_authorize_url_with_empty_input <- function(empty_input) {
+    # N.B. we do a delta between a query with and without extra query params to test
+
+    # need this later: empty named list
+    empty_named_list <- list()
+    attr(empty_named_list, "names") <- character(0)
+
+    # sample query_extra params
+    extra_pars <- list(
+      foo = "bar"
+    )
+
+    # create base/empty URL
+    url_with_empty_input <- authorize_url_with_extra(empty_input)
+    # create URL w/ extras
+    url_with_extra <- authorize_url_with_extra(extra_pars)
+
+    # get respective query params
+    qry_pars_empty_input <- parse_url(url_with_empty_input)$query
+    qry_pars_extra <- parse_url(url_with_extra)$query
+
+    # get extra params appended to extra_pars query (compared to empty_input)
+    appended_extras <- qry_pars_extra[!(qry_pars_extra %in% qry_pars_empty_input)]
+
+    # get extra params appended to empty input query (compared to empty_input)
+    appended_empty <- qry_pars_empty_input[!(qry_pars_empty_input %in% qry_pars_extra)]
+
+    expect_equal(appended_extras, extra_pars) # only extra_pars should be here
+    expect_equal(appended_empty, empty_named_list) # empty input query should be empty list
+  }
+
+  test_authorize_url_with_empty_input(list())
+  test_authorize_url_with_empty_input(NULL)
+
+})
+
 
 # Parameter checking ------------------------------------------------------