verify v2 scopes

R/AzureToken.R

@@ -165,84 +165,3 @@ private=list(
 ))
 
 
-aad_request_credentials <- function(app, password, username, certificate, auth_type)
-{
-    obj <- list(client_id=app, grant_type=auth_type)
-
-    if(auth_type == "resource_owner")
-    {
-        if(is.null(username) && is.null(password))
-            stop("Must provide a username and password for resource_owner grant", call.=FALSE)
-        obj$grant_type <- "password"
-        obj$username <- username
-        obj$password <- password
-    }
-    else if(auth_type == "client_credentials")
-    {
-        if(!is.null(password))
-            obj$client_secret <- password
-        else if(!is.null(certificate))
-        {
-            obj$client_assertion_type <- "urn:ietf:params:oauth:client-assertion-type:jwt-bearer"
-            obj$client_assertion <- certificate
-        }
-        else stop("Must provide either a client secret or certificate for client_credentials grant", call.=FALSE)
-    }
-    else if(auth_type == "authorization_code")
-    {
-        if(!is.null(password) && !is.null(username))
-            stop("Cannot provide both a username and secret with authorization_code method", call.=FALSE)
-        if(!is.null(username))
-            obj$login_hint <- username
-        if(!is.null(password))
-            obj$client_secret <- password
-    }
-
-    obj
-}
-
-
-aad_endpoint <- function(aad_host, tenant, version=1, type=c("authorize", "token", "devicecode"))
-{
-    type <- match.arg(type)
-    tenant <- normalize_tenant(tenant)
-
-    uri <- httr::parse_url(aad_host)
-    uri$path <- if(version == 1)
-        file.path(tenant, "oauth2", type)
-    else file.path(tenant, "oauth2/v2.0", type)
-
-    httr::build_url(uri)
-}
-
-
-normalize_aad_version <- function(v)
-{
-    if(v == "v1.0")
-        v <- 1
-    else if(v == "v2.0")
-        v <- 2
-    if(!(is.numeric(v) && v %in% c(1, 2)))
-        stop("Invalid AAD version")
-    v
-}
-
-
-process_aad_response=function(res)
-{
-    status <- httr::status_code(res)
-    if(status >= 300)
-    {
-        cont <- httr::content(res)
-
-        msg <- if(is.character(cont))
-            cont
-        else if(is.list(cont) && is.character(cont$error_description))
-            cont$error_description
-        else ""
-
-        msg <- paste0("obtain Azure Active Directory token. Message:\n", sub("\\.$", "", msg))
-        list(token=httr::stop_for_status(status, msg))
-    }
-    else httr::content(res)
-}

R/utils.R

@@ -0,0 +1,124 @@
+aad_request_credentials <- function(app, password, username, certificate, auth_type)
+{
+    obj <- list(client_id=app, grant_type=auth_type)
+
+    if(auth_type == "resource_owner")
+    {
+        if(is.null(username) && is.null(password))
+            stop("Must provide a username and password for resource_owner grant", call.=FALSE)
+        obj$grant_type <- "password"
+        obj$username <- username
+        obj$password <- password
+    }
+    else if(auth_type == "client_credentials")
+    {
+        if(!is.null(password))
+            obj$client_secret <- password
+        else if(!is.null(certificate))
+        {
+            obj$client_assertion_type <- "urn:ietf:params:oauth:client-assertion-type:jwt-bearer"
+            obj$client_assertion <- certificate
+        }
+        else stop("Must provide either a client secret or certificate for client_credentials grant", call.=FALSE)
+    }
+    else if(auth_type == "authorization_code")
+    {
+        if(!is.null(password) && !is.null(username))
+            stop("Cannot provide both a username and secret with authorization_code method", call.=FALSE)
+        if(!is.null(username))
+            obj$login_hint <- username
+        if(!is.null(password))
+            obj$client_secret <- password
+    }
+
+    obj
+}
+
+
+aad_endpoint <- function(aad_host, tenant, version=1, type=c("authorize", "token", "devicecode"))
+{
+    type <- match.arg(type)
+    tenant <- normalize_tenant(tenant)
+
+    uri <- httr::parse_url(aad_host)
+    uri$path <- if(version == 1)
+        file.path(tenant, "oauth2", type)
+    else file.path(tenant, "oauth2/v2.0", type)
+
+    httr::build_url(uri)
+}
+
+
+normalize_aad_version <- function(v)
+{
+    if(v == "v1.0")
+        v <- 1
+    else if(v == "v2.0")
+        v <- 2
+    if(!(is.numeric(v) && v %in% c(1, 2)))
+        stop("Invalid AAD version")
+    v
+}
+
+
+process_aad_response <- function(res)
+{
+    status <- httr::status_code(res)
+    if(status >= 300)
+    {
+        cont <- httr::content(res)
+
+        msg <- if(is.character(cont))
+            cont
+        else if(is.list(cont) && is.character(cont$error_description))
+            cont$error_description
+        else ""
+
+        msg <- paste0("obtain Azure Active Directory token. Message:\n", sub("\\.$", "", msg))
+        list(token=httr::stop_for_status(status, msg))
+    }
+    else httr::content(res)
+}
+
+
+verify_v2_scope <- function(scope)
+{
+    # some OpenID scopes get a pass
+    openid_scopes <- c("openid", "email", "profile", "offline_access")
+    if(scope %in% openid_scopes)
+        return(scope)
+
+    # but not all
+    bad_scopes <- c("address", "phone")
+    if(scope %in% bad_scopes)
+        stop("Unsupported OpenID scope: ", scope, call.=FALSE)
+
+    # is it a URI or GUID?
+    valid_uri <- grepl("^https?://", scope)
+    valid_guid <- is_guid(sub("/.+$", "", scope))
+    if(!valid_uri && !valid_guid)
+        stop("Invalid scope (must be a URI or GUID): ", scope, call.=FALSE)
+
+    # if a URI or GUID, check that there is a valid scope in the path
+    if(valid_uri)
+    {
+        uri <- httr::parse_url(scope)
+        if(uri$path == "")
+        {
+            warning("No path supplied for scope ", scope, "; setting to /.default")
+            uri$path <- ".default"
+            scope <- httr::build_url(uri)
+        }
+    }
+    else
+    {
+        path <- sub("^[^/]+/", "", scope)
+        if(path == "")
+        {
+            warning("No path supplied for scope ", scope, "; setting to /.default")
+            scope <- sub("//", "/", paste0(scope, "/.default"))
+        }
+    }
+    scope
+}
+