Merge pull request #312 from cornf4ke/user_params

Add option user_params to oauth2.0_token to enable endpoint-specific access parameters.

DESCRIPTION

@@ -27,4 +27,4 @@ Suggests:
 VignetteBuilder: knitr
 License: MIT + file LICENSE
 URL: https://github.com/hadley/httr
-RoxygenNote: 5.0.0
+RoxygenNote: 5.0.1

NEWS.md

@@ -1,5 +1,9 @@
 # httr 1.0.0.9000
 
+* `oauth2.0_token()` accepts the optional named list parameter `user_params`
+  which can be used to pass additional parameters to the token access endpoint
+  when acquiring or refreshing a token, if required by the endpoint protocol.
+
 * `oauth_service_token()` checks that its arguments are the correct types 
   (#282).
 

R/oauth-endpoint.r

@@ -60,7 +60,7 @@ print.oauth_endpoint <- function(x, ...) {
 #' Provides some common OAuth endpoints.
 #'
 #' @param name One of the following endpoints: linkedin, twitter,
-#'   vimeo, google, facebook, github.
+#'   vimeo, google, facebook, github, azure.
 #' @export
 #' @examples
 #' oauth_endpoints("twitter")
@@ -112,6 +112,11 @@ oauth_endpoints <- function(name) {
       authorize = "authorize",
       access = "access_token"
     ),
+    azure = oauth_endpoint(
+      base_url = "https://login.windows.net/common/oauth2",
+      authorize = "authorize",
+      access = "token"
+    ),
     stop("Unknown endpoint", call. = FALSE)
   )
 }

R/oauth-init.R

@@ -46,15 +46,18 @@ init_oauth1.0 <- function(endpoint, app, permission = NULL,
 #' @inheritParams init_oauth1.0
 #' @param type content type used to override incorrect server response
 #' @param scope a character vector of scopes to request.
+#' @param user_params Named list holding endpoint specific parameters to pass to
+#'     the server when posting the request for obtaining or refreshing the
+#'     access token.
 #' @param use_oob if FALSE, use a local webserver for the OAuth dance.
 #'     Otherwise, provide a URL to the user and prompt for a validation
 #'     code. Defaults to the of the \code{"httr_oob_default"} default,
 #'     or \code{TRUE} if \code{httpuv} is not installed.
 #' @param is_interactive Is the current environment interactive?
 #' @export
 #' @keywords internal
-init_oauth2.0 <- function(endpoint, app, scope = NULL, type = NULL,
-                          use_oob = getOption("httr_oob_default"),
+init_oauth2.0 <- function(endpoint, app, scope = NULL, user_params = NULL,
+                          type = NULL, use_oob = getOption("httr_oob_default"),
                           is_interactive = interactive()) {
   if (!use_oob && !is_installed("httpuv")) {
     message("httpuv not installed, defaulting to out-of-band authentication")
@@ -85,13 +88,16 @@ init_oauth2.0 <- function(endpoint, app, scope = NULL, type = NULL,
   }
 
   # Use authorisation code to get (temporary) access token
-  req <- POST(endpoint$access, encode = "form",
-    body = list(
+  req_params <- list(
       client_id = app$key,
       client_secret = app$secret,
       redirect_uri = redirect_uri,
       grant_type = "authorization_code",
-      code = code))
+      code = code)
+  if (! is.null(user_params)) {
+    req_params <- modifyList(user_params, req_params);
+  }
+  req <- POST(endpoint$access, encode = "form", body = req_params)
 
   stop_for_status(req)
   content(req, type = type)

R/oauth-refresh.R

@@ -3,18 +3,20 @@
 # Refreshes the given token, and returns a new credential with a
 # valid access_token. Based on:
 # https://developers.google.com/accounts/docs/OAuth2InstalledApp#refresh
-refresh_oauth2.0 <- function(endpoint, app, credentials) {
+refresh_oauth2.0 <- function(endpoint, app, credentials, user_params = NULL) {
   if (is.null(credentials$refresh_token)) {
     stop("Refresh token not available", call. = FALSE)
   }
 
   refresh_url <- endpoint$access
   body <- list(
-    refresh_token = credentials$refresh_token,
-    client_id = app$key,
-    client_secret = app$secret,
-    grant_type = "refresh_token"
-  )
+      refresh_token = credentials$refresh_token,
+      client_id = app$key,
+      client_secret = app$secret,
+      grant_type = "refresh_token")
+  if (! is.null(user_params)) {
+    body <- modifyList(user_params, body);
+  }
 
   response <- POST(refresh_url, body = body, encode = "form")
   stop_for_status(response)

R/oauth-token.r

@@ -187,12 +187,12 @@ Token1.0 <- R6::R6Class("Token1.0", inherit = Token, list(
 #' @return A \code{Token2.0} reference class (RC) object.
 #' @family OAuth
 #' @export
-oauth2.0_token <- function(endpoint, app, scope = NULL, type = NULL,
-                           use_oob = getOption("httr_oob_default"),
+oauth2.0_token <- function(endpoint, app, scope = NULL, user_params = NULL,
+                           type = NULL, use_oob = getOption("httr_oob_default"),
                            as_header = TRUE,
                            cache = getOption("httr_oauth_cache")) {
-  params <- list(scope = scope, type = type, use_oob = use_oob,
-    as_header = as_header)
+  params <- list(scope = scope, user_params = user_params, type = type,
+      use_oob = use_oob, as_header = as_header)
   Token2.0$new(app = app, endpoint = endpoint, params = params,
     cache_path = cache)
 }
@@ -202,14 +202,15 @@ oauth2.0_token <- function(endpoint, app, scope = NULL, type = NULL,
 Token2.0 <- R6::R6Class("Token2.0", inherit = Token, list(
   init_credentials = function() {
     self$credentials <- init_oauth2.0(self$endpoint, self$app,
-      scope = self$params$scope, type = self$params$type,
-      use_oob = self$params$use_oob)
+      scope = self$params$scope, user_params = self$params$user_params,
+      type = self$params$type, use_oob = self$params$use_oob)
   },
   can_refresh = function() {
     !is.null(self$credentials$refresh_token)
   },
   refresh = function() {
-    self$credentials <- refresh_oauth2.0(self$endpoint, self$app, self$credentials)
+    self$credentials <- refresh_oauth2.0(self$endpoint, self$app,
+        self$credentials, self$params$user_params)
     self$cache()
     self
   },

demo/00Index

@@ -7,3 +7,4 @@ oauth2-facebook     Using the facebook api with OAuth 2.0
 oauth2-github       Using the github api with OAuth 2.0
 oauth2-google       Using the google api with OAuth 2.0
 oauth2-linkedin     Using linkedin api with OAuth 1.0
+oauth2-azure        Using Azure apis with OAuth 2.0

demo/oauth2-azure.r

@@ -0,0 +1,52 @@
+# !!! The special redirect URI "urn:ietf:wg:oauth:2.0:oob used
+# !!! by httr in case httuv is not installed is currently not 
+# !!! supported by Azure Active Directory (AAD).
+# !!! Therefore it is required to install httpuv to make this work.
+
+# 1. Register an app app in AAD, e.g. as a "Native app", with
+#    redirect URI <http://localhost:1410>.
+# 2. Insert the App name:
+app_name <- 'myapp' # not important for authorization grant flow
+# 3. Insert the created apps client ID which was issued after app creation:
+client_id <- 'aaaaaaaa-bbbb-cccc-dddd-eeeeeeeeeeee'
+# In case your app was registered as a web app instead of a native app,
+# you might have to add your secret key string here:
+client_secret <- NULL
+# API resource ID to request access for, e.g. Power BI:
+resource_uri <- 'https://analysis.windows.net/powerbi/api'
+
+# Obtain OAuth2 endpoint settings for azure:
+#    This uses the "common" endpoint.
+#    To use a tenant url, create an
+#    oauth_endpoint(authorize = "https://login.windows.net/<tenant_id>/oauth2/authorize",
+#                   access = "https://login.windows.net/<tenant_id>/oauth2/token")
+#    with <tenant_id> replaced by your endpoint ID.
+azure_endpoint <- oauth_endpoints('azure')
+
+# Create the app instance.
+myapp <- oauth_app(appname = app_name,
+                   key = client_id,
+                   secret = client_secret)
+
+# Step through the authorization chain:
+#    1. You will be redirected to you authorization endpoint via web browser.
+#    2. Once you responded to the request, the endpoint will redirect you to
+#       the local address specified by httr.
+#    3. httr will acquire the authorization code (or error) from the data
+#       posted to the redirect URI.
+#    4. If a code was acquired, httr will contact your authorized token access
+#       endpoint to obtain the token.
+mytoken <- oauth2.0_token(azure_endpoint, myapp,
+                          user_params = list(resource = resource_uri),
+                          use_oob = FALSE)
+if (('error' %in% names(mytoken$credentials)) && (nchar(mytoken$credentials$error) > 0)) {
+  errorMsg <- paste('Error while acquiring token.',
+                    paste('Error message:', mytoken$credentials$error),
+                    paste('Error description:', mytoken$credentials$error_description),
+                    paste('Error code:', mytoken$credentials$error_codes),
+                    sep = '\n')
+  stop(errorMsg)
+}
+
+# Resource API can be accessed through "mytoken" at this point.
+