create and expose AzureToken class

DESCRIPTION

@@ -15,3 +15,10 @@ Imports:
     jsonlite,
     R6
 RoxygenNote: 6.0.1
+Collate: 
+    'AzureSMRbase.R'
+    'AzureToken.R'
+    'az_auth.R'
+    'az_resgroup.R'
+    'az_subscription.R'
+    'call_azure_sm.R'

NAMESPACE

@@ -1,5 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
+export(AzureToken)
 export(az_context)
 export(az_resource_group)
 export(az_subscription)
+export(call_azure_sm)
+export(get_azure_token)

R/AzureToken.R

@@ -0,0 +1,72 @@
+#' @export
+AzureToken <- R6::R6Class("AzureToken", inherit=httr::Token2.0,
+
+public=list(
+    # need to do hacky init to support explicit re-authentication instead of using a refresh token
+    initialize=function(endpoint, app, user_params, client_credentials, use_basic_auth)
+    {
+        private$az_client_credentials <- client_credentials
+        private$az_use_basic_auth <- use_basic_auth
+
+        params <- list(scope=NULL, user_params=user_params, type=NULL, use_oob=FALSE, as_header=TRUE,
+                       use_basic_auth=use_basic_auth, config_init=list(), client_credentials=client_credentials)
+
+        super$initialize(app=app, endpoint=endpoint, params=params, credentials=NULL, cache_path=FALSE)
+    },
+
+    # overrides httr::Token2.0 method
+    validate=function()
+    {
+        if(!is.null(self$endpoint$request))
+            return(super$validate())
+
+        expdate <- as.POSIXct(as.numeric(self$credentials$expires_on), origin="1970-01-01")
+        curdate <- Sys.time()
+        curdate < expdate
+    },
+
+    # overrides httr::Token2.0 method
+    refresh=function()
+    {
+        if(!is.null(self$credentials$refresh_token))
+            return(super$refresh())
+
+        # re-authenticate if no refresh token
+        self$initialize(self$endpoint, self$app, self$params$user_params,
+                        private$az_client_credentials, private$az_use_basic_auth)
+        NULL
+    }
+),
+
+private=list(
+    az_client_credentials=NULL,
+    az_use_basic_auth=NULL
+))
+
+
+#' @export
+get_azure_token=function(aad_host, tenant, app, auth_type, secret, arm_host)
+{
+    base_url <- file.path(aad_host, tenant, fsep="/")
+    if(auth_type == "client credentials")
+        auth_with_creds(base_url, app, secret, arm_host)
+    else auth_with_device(base_url, app, arm_host)
+}
+
+
+auth_with_creds <- function(base_url, app, secret, resource)
+{
+    endp <- httr::oauth_endpoint(base_url=base_url, authorize="oauth2/authorize", access="oauth2/token")
+    app <- httr::oauth_app("azure", key=app, secret=secret)
+
+    AzureToken$new(endp, app, user_params=list(resource=resource), client_credentials=TRUE, use_basic_auth=FALSE)
+}
+
+
+auth_with_device <- function(base_url, app, resource)
+{
+    endp <- httr::oauth_endpoint(base_url=base_url, authorize="oauth2/authorize", access="oauth2/devicecode")
+    app <- httr::oauth_app("azure", key=app)
+
+    AzureToken$new(endp, app, user_params=list(resource=resource), client_credentials=FALSE, use_basic_auth=TRUE)
+}

R/az_auth.R

@@ -1,4 +1,5 @@
 ### Azure Context class: authentication functionality for AAD
+#' @include AzureToken.R
 
 #' @export
 az_context <- R6::R6Class("az_context",
@@ -7,10 +8,13 @@ public=list(
     host=NULL,
     tenant=NULL,
     subscriptions=NULL,
+    auth_type=NULL,
+    token=NULL,
 
     # authenticate and get subscriptions
     initialize=function(tenant, app, auth_type=c("client credentials", "device code"), secret,
-                        host="https://management.azure.com/", config_file=NULL)
+                        host="https://management.azure.com/", aad_host="https://login.microsoftonline.com/",
+                        config_file=NULL)
     {
         if(!is.null(config_file))
         {
@@ -20,23 +24,15 @@ public=list(
             if(!is.null(conf$auth_type)) auth_type <- conf$auth_type
             if(!is.null(conf$secret)) secret <- conf$secret
             if(!is.null(conf$host)) host <- conf$host
+            if(!is.null(conf$aad_host)) aad_host <- conf$aad_host
         }
 
         self$host <- host
         self$tenant <- tenant
-        private$auth_type <- match.arg(auth_type)
+        self$auth_type <- match.arg(auth_type)
-        private$set_token(app, secret)
+        self$token <- get_azure_token(aad_host, tenant, app, self$auth_type, secret, host)
-        private$set_subs()
-        NULL
-    },
 
-    # refresh OAuth 2.0 authentication
+        private$set_subs()
-    refresh=function()
-    {
-        tok <- private$token
-        if(is.null(tok$credentials$refresh_token))
-            private$set_token(tok$app$key, tok$app$secret) # re-authenticate if no refresh token
-        else private$token$refresh()
         NULL
     },
 
@@ -47,28 +43,16 @@ public=list(
             stop("No subscriptions associated with this app")
         if(is.numeric(subscription))
             subscription <- self$subscriptions[subscription][1]
-        az_subscription$new(private$token, subscription)
+        az_subscription$new(self$token, subscription)
     }
 ),
 
 private=list(
-    auth_type=NULL,
-    token=NULL,
-
-    # obtain access token via httr OAuth 2.0 functions
-    set_token=function(app, secret)
-    {
-        base_url <- file.path("https://login.microsoftonline.com", self$tenant)
-        private$token <- if(private$auth_type == "client credentials")
-            auth_with_creds(base_url, app, secret, self$host)
-        else auth_with_device(base_url, app, self$host)
-        NULL
-    },
 
     # obtain subscription IDs owned by this app
     set_subs=function()
     {
-        cont <- call_azure_sm(private$token, subscription="", operation="")
+        cont <- call_azure_sm(self$token, subscription="", operation="")
 
         df <- lapply(cont$value, data.frame, stringsAsFactors=FALSE)
         df <- do.call(rbind, df)
@@ -82,21 +66,3 @@ private=list(
 ))
 
 
-auth_with_creds <- function(base_url, app, secret, resource)
-{
-    endp <- httr::oauth_endpoint(base_url=base_url, authorize="oauth2/authorize", access="oauth2/token")
-    app <- httr::oauth_app("azure", key=app, secret=secret)
-
-    httr::oauth2.0_token(endp, app, user_params=list(resource=resource), client_credentials=TRUE, cache=FALSE)
-}
-
-
-auth_with_device <- function(base_url, app, resource)
-{
-    endp <- httr::oauth_endpoint(base_url=base_url, authorize="oauth2/authorize", access="oauth2/devicecode")
-    app <- httr::oauth_app("azure", key=app)
-
-    httr::oauth2.0_token(endp, app, user_params=list(resource=resource), use_basic_auth=TRUE, cache=FALSE)
-}
-
-

R/az_resgroup.R

@@ -10,15 +10,16 @@ public=list(
     properties=NULL,
     tags=NULL,
     resources=NA, # NULL = no resources, NA = not yet populated
+    token=NULL,
 
     initialize=function(token, subscription, name)  # TODO: also allow initialisation with explicit data args
     {
-        private$token <- token
+        self$token <- token
         self$subscription <- subscription
         self$name <- name
 
         op <- paste0("resourcegroups/", self$name)
-        cont <- call_azure_sm(private$token, self$subscription, op)
+        cont <- call_azure_sm(self$token, self$subscription, op)
         self$id <- cont$id
         self$location <- cont$location
         self$managed_by <- cont$managedBy
@@ -36,11 +37,11 @@ public=list(
 ),
 
 private=list(
-    token=NULL,
+
     set_res=function()
     {
         op <- paste0("resourcegroups/", self$name, "/resources")
-        cont <- call_azure_sm(private$token, self$subscription, op)
+        cont <- call_azure_sm(self$token, self$subscription, op)
         self$resources <- sapply(cont$value, `[[`, "name")
         NULL
     }

R/az_subscription.R

@@ -9,10 +9,11 @@ public=list(
     policies=NULL,
     authorization_source=NULL,
     resource_groups=NA, # NULL = no resource groups, NA = not yet populated
+    token=NULL,
 
     initialize=function(token, id)
     {
-        private$token <- token
+        self$token <- token
         self$id <- id
         info <- call_azure_sm(token, id, "")
         self$name <- info$displayName
@@ -31,7 +32,7 @@ public=list(
             stop("No resource groups associated with this subscription")
         if(is.numeric(resource_group))
             resource_group <- self$resource_groups[resource_group][1]
-        az_resource_group$new(private$token, self$id, resource_group)
+        az_resource_group$new(self$token, self$id, resource_group)
     },
 
     create_resource_group=function(resource_group) { },
@@ -41,10 +42,10 @@ public=list(
 ),
 
 private=list(
-    token=NULL,
+
     set_rgrps=function()
     {
-        cont <- call_azure_sm(private$token, self$id, "resourcegroups")
+        cont <- call_azure_sm(self$token, self$id, "resourcegroups")
         self$resource_groups <- sapply(cont$value, `[[`, "name")
         NULL
     }

R/call_azure_sm.R

@@ -1,10 +1,18 @@
-call_azure_sm <- function(token, subscription, operation, api_version=getOption("azure_api_version"),
+#' @export
+call_azure_sm <- function(token, subscription, operation, ...,
                           http_verb=c("GET", "DELETE", "PUT", "POST", "HEAD"),
-                          catch=c("stop", "warn", "message", "pass"), ...)
+                          http_condition_handler=c("stop", "warn", "message", "pass"),
+                          api_version=getOption("azure_api_version"),
+                          auto_refresh=TRUE)
 {
-    creds <- token$credentials
+    # if token has expired, renew it
+    if(auto_refresh && !token$validate())
+    {
+        message("Access token has expired or is no longer valid; refreshing")
+        token$refresh()
+    }
 
-    # TODO: if token has expired, renew it
+    creds <- token$credentials
 
     url <- httr::parse_url(creds$resource)
     url$path <- file.path("subscriptions", subscription, operation, fsep="/")
@@ -14,9 +22,11 @@ call_azure_sm <- function(token, subscription, operation, api_version=getOption(
                                  `Content-type`="application/json")
 
     verb <- get(match.arg(http_verb), getNamespace("httr"))
+
+    # do actual API call
     res <- verb(httr::build_url(url), headers, ...)
 
-    catch <- match.arg(catch)
+    catch <- match.arg(http_condition_handler)
     if(catch != "pass")
     {
         catch <- get(paste0(match.arg(catch), "_for_status"), getNamespace("httr"))