fix #116 , global metadata, remove deprecated operation functions, re…

…move auth_email, depend remotes not devtools

DESCRIPTION

@@ -22,10 +22,10 @@ Imports:
     googleAuthR (>= 0.6.0),
     httr (>= 1.3.1),
     jsonlite (>= 1.1),
+    remotes,
     utils
 Suggests:
     covr,
-    devtools (>= 1.12.0),
     googleCloudStorageR,
     knitr,
     rmarkdown,

NAMESPACE

@@ -50,6 +50,7 @@ export(gce_get_image_family)
 export(gce_get_instance)
 export(gce_get_machinetype)
 export(gce_get_metadata)
+export(gce_get_metadata_project)
 export(gce_get_network)
 export(gce_get_op)
 export(gce_get_project)

NEWS.md

@@ -6,6 +6,7 @@
 * Block users using "rstudio" as a login name
 * Remove defunct example from `gce_schedule_docker`
 * Support GPU images for Tensorflow, keras etc. 
+* Support common instance metadata by supply `gce_set_metadata(instance = "project-wide")`
 
 # 0.2.0
 

R/future.R

@@ -123,7 +123,7 @@ gce_future_install_packages <- function(instance,
 
   if(!is.null(github_packages)){
     devt <- NULL
-    devt %<-% devtools::install_github(github_packages, auth_token = devtools::github_pat())
+    devt %<-% remotes::install_github(github_packages, auth_token = remotes::github_pat())
     devt
   }
 

R/metadata.R

@@ -73,11 +73,12 @@ gce_get_metadata <- function(instance, key = NULL){
 #' 
 #' @family Metadata functions
 #' @keywords internal
+#' @import assertthat
 Metadata <- function(items) {
 
   if(is.null(items)) return(NULL)
 
-  testthat::expect_named(items)
+  assert_that(!is.null(names(items)))
 
   key_values <- lapply(names(items), function(x) list(key = jsonlite::unbox(x), 
                                                       value = jsonlite::unbox(items[[x]])))
@@ -86,7 +87,7 @@ Metadata <- function(items) {
             class = c("gar_Metadata", "list"))
 }
 
-#' Sets metadata for the specified instance to the data included in the request.
+#' Sets metadata for the specified instance or projectwise to the data included in the request.
 #' 
 #' Set, change and append metadata for an instance.
 #' 
@@ -106,33 +107,48 @@ Metadata <- function(items) {
 #' To delete metadata pass an empty string \code{""} with the same key
 #' 
 #' @param metadata A named list of metadata key/value pairs to assign to this instance
-#' @param instance Name of the instance scoping this request
+#' @param instance Name of the instance scoping this request. If "project-wide" will set the metadata project wide, available to all instances
 #' @param project Project ID for this request, default as set by \link{gce_get_global_project}
 #' @param zone The name of the zone for this request, default as set by \link{gce_get_global_zone}
 #' @importFrom googleAuthR gar_api_generator
 #' @importFrom utils modifyList
 #' @importFrom stats setNames
 #' @family Metadata functions
 #' @export
+#' @examples 
+#' 
+#' \dontrun{
+#'  # Use "project-wide" to set "enable-oslogin" = "TRUE" to take advantage of OS Login.
+#'  gce_set_metadata(list("enable-oslogin" = "TRUE"), instance = "project-wide")
+#' }
+#'  
 gce_set_metadata <- function(metadata, 
-                             instance, 
+                             instance = NULL, 
                              project = gce_get_global_project(), 
                              zone = gce_get_global_zone()) {
-
-  ## refetch to ensure latest version of metadata fingerprint
-  ins <- gce_get_instance(instance, project = project, zone = zone)
-
-  url <- sprintf("https://www.googleapis.com/compute/v1/projects/%s/zones/%s/instances/%s/setMetadata", 
-                 project, zone, as.gce_instance_name(ins))
 
-  meta_now <- ins$metadata$items
+  if(instance == "project-wide"){
+    pw_obj <- gce_get_metadata_project(project)
+    meta_now <- pw_obj$commonInstanceMetadata$items
+    fingerprint <- pw_obj$commonInstanceMetadata$fingerprint
+    url <- sprintf("https://www.googleapis.com/compute/v1/projects/%s/setCommonInstanceMetadata",
+                   project)
+  } else {
+    ## refetch to ensure latest version of metadata fingerprint
+    ins <- gce_get_instance(instance, project = project, zone = zone)
+    meta_now <- ins$metadata$items
+    fingerprint <- ins$metadata$fingerprint
+    url <- sprintf("https://www.googleapis.com/compute/v1/projects/%s/zones/%s/instances/%s/setMetadata", 
+                   project, zone, as.gce_instance_name(ins))
+
+  }
+
   ## turn data.frame back into named list
-  meta_now_nl <- setNames(lapply(meta_now$key, function(x) meta_now[meta_now$key == x, "value"]), 
-                          meta_now$key)
+  meta_now_nl <- meta_df_to_list(meta_now)
 
   meta <- Metadata(modifyList(meta_now_nl, metadata))
   ## need current fingerprint to allow modification
-  meta$fingerprint <- ins$metadata$fingerprint
+  meta$fingerprint <- fingerprint
 
   stopifnot(inherits(meta, "gar_Metadata"))
   # compute.instances.setMetadata  
@@ -141,4 +157,20 @@ gce_set_metadata <- function(metadata,
   out <- f(the_body = meta)
   as.zone_operation(out)
 
+}
+
+meta_df_to_list <- function(meta_df){
+  setNames(lapply(meta_df$key, function(x) meta_df[meta_df$key == x, "value"]), 
+           meta_df$key)
+}
+
+#' Get project wide metadata
+#' 
+#' @param project The project to get the project-wide metadata from
+#' 
+#' @export
+gce_get_metadata_project <- function(project = gce_global_project()){
+  pw_url <- sprintf("https://www.googleapis.com/compute/v1/projects/%s", project)
+  pw <- gar_api_generator(pw_url, "GET", data_parse_function = function(x) x)
+  pw()
 }

R/operations.R

@@ -114,62 +114,6 @@ gce_delete_op.gce_global_operation <- function(operation) {
 
 }
 
-#' Deletes the specified zone-specific Operations resource.
-#' 
-#' @seealso \href{https://developers.google.com/compute/docs/reference/latest/}{Google Documentation}
-#' 
-#' @details 
-#' Authentication scopes used by this function are:
-#' \itemize{
-#'   \item https://www.googleapis.com/auth/cloud-platform
-#' \item https://www.googleapis.com/auth/compute
-#' }
-#' 
-#' @param operation Name of the Operations resource to delete
-#' @param project Project ID for this request
-#' @param zone Name of the zone for this request
-#' 
-#' @return TRUE if successful
-#' 
-#' @importFrom googleAuthR gar_api_generator
-#' @export
-gce_delete_zone_op <- function(operation,
-                               project = gce_get_global_project(), 
-                               zone = gce_get_global_zone() ) {
-
-  .Deprecated("gce_delete_op", package = "googleComputeEngineR")
-  gce_delete_op(operation)
-
-}
-
-#' Retrieves the specified zone-specific Operations resource.
-#' 
-#' 
-#' @seealso \href{https://developers.google.com/compute/docs/reference/latest/}{Google Documentation}
-#' 
-#' @details 
-#' Authentication scopes used by this function are:
-#' \itemize{
-#'   \item https://www.googleapis.com/auth/cloud-platform
-#' \item https://www.googleapis.com/auth/compute
-#' \item https://www.googleapis.com/auth/compute.readonly
-#' }
-#' 
-#' 
-#' @param operation Name of the Operations resource to return
-#' @param project Project ID for this request
-#' @param zone Name of the zone for this request
-#' 
-#' @importFrom googleAuthR gar_api_generator
-#' @export
-gce_get_zone_op <- function(operation,
-                            project = gce_get_global_project(), 
-                            zone = gce_get_global_zone()) {
-
-  .Deprecated("gce_get_op", package = "googleComputeEngineR")
-  gce_get_op(operation)
-}
-
 #' Retrieves the specified Operations resource.
 #' 
 #' s3 method dispatcher
@@ -189,7 +133,7 @@ gce_get_zone_op <- function(operation,
 #' 
 #' @importFrom googleAuthR gar_api_generator
 #' @export
-gce_get_op <- function(operation){
+gce_get_op <- function(operation = .Last.value){
 
   if(inherits(operation, c("gce_global_operation", "gce_zone_operation","gce_region_operation"))){
     UseMethod("gce_get_op", operation)
@@ -361,15 +305,3 @@ gce_wait <- function(operation, wait = 3, verbose = TRUE, timeout_tries = 50){
 
   check
 }
-
-#' @rdname gce_wait
-#' @export
-gce_check_zone_op <- function(operation, wait = 3, verbose = TRUE){
-
-  .Deprecated("gce_wait", package = "googleComputeEngineR")
-  gce_wait(operation = operation, 
-                    wait = wait, 
-                    verbose = verbose)
-
-
-}

R/scheduler.R

@@ -35,7 +35,7 @@
 #' \dontrun{
 #' # create a Dockerfile of your script
 #' if(!require(containeRit)){
-#'   devtools::install_github("o2r-project/containerit")
+#'   remotes::install_github("o2r-project/containerit")
 #'   library(containeRit)
 #' }
 #' 

R/service-accounts.R

@@ -0,0 +1,22 @@
+#' Make serviceAccounts objects
+#' @noRd
+gce_make_serviceaccounts <- function(){
+
+  if(Sys.getenv(source) == ""){
+    stop("No email found in the authentication file at Sys.getenv('GCE_AUTH_FILE')", call.=FALSE)
+  }
+
+  email <- jsonlite::unbox(jsonlite::fromJSON(Sys.getenv("GCE_AUTH_FILE"))$client_email)
+
+  if(is.null(email)){
+    stop("Couldn't find client_email in GCE_AUTH_FILE environment file", call.=FALSE)
+  }
+
+  list(
+    list(
+      email = email,
+      scopes = list("https://www.googleapis.com/auth/cloud-platform")
+    )
+  )
+
+}

R/utilities.R

@@ -48,26 +48,6 @@ indent <- function(str, indent = 0) {
   )
 }
 
-#' Get auth email
-#' If it includes '@' then assume the email, otherwise an environment file
-#' @param source where the email comes from
-#' @keywords internal
-auth_email <- function(source){
-
-  if(Sys.getenv(source) == ""){
-    stop("No email found in the authentication file at Sys.getenv(", source, "). \nSet argument auth_email to the environment file containing your service account authentication JSON file e.g. 'GCE_AUTH_FILE', or supply the authentication email directly. e.g. '[email protected]'")
-  }
-
-  if(!grepl("@", source)){
-    out <- jsonlite::fromJSON(Sys.getenv(source))$client_email
-  } else {
-    out <- source
-  }
-
-  out
-
-}
-
 #' Timestamp to R date
 #' @keywords internal
 timestamp_to_r <- function(t){

R/vms.R

@@ -87,7 +87,11 @@ gce_vm <- function(name,
   }
 
   vm <- tryCatch({
-    suppressMessages(suppressWarnings(gce_get_instance(name, zone = zone, project = project)))
+    suppressMessages(
+      suppressWarnings(
+        gce_get_instance(name, zone = zone, project = project)
+        )
+      )
   }, error = function(ex) {
     dots <- list(...)
     if(!is.null(dots[["template"]])){
@@ -140,15 +144,16 @@ gce_vm <- function(name,
 #' @param zone The name of the zone for this request, default as set by \link{gce_get_global_zone}
 #' 
 #' @importFrom googleAuthR gar_api_generator
+#' @import assertthat
 #' @export
 gce_vm_delete <- function(instance,
                           project = gce_get_global_project(), 
                           zone = gce_get_global_zone() 
                           ) {
 
-  assertthat::assert_that(
-    assertthat::is.string(project),
-    assertthat::is.string(zone)
+  assert_that(
+    is.string(project),
+    is.string(zone)
   )
 
   url <- sprintf("https://www.googleapis.com/compute/v1/projects/%s/zones/%s/instances/%s", 
@@ -216,7 +221,6 @@ gce_vm_delete <- function(instance,
 #' @param project Project ID for this request
 #' @param zone The name of the zone for this request
 #' @param dry_run whether to just create the request JSON
-#' @param auth_email If it includes '@' then assume the email, otherwise an environment file var that includes the email
 #' @param disk_size_gb If not NULL, override default size of the boot disk (size in GB) 
 #' @param use_beta If set to TRUE will use the beta version of the API. Should not be used for production purposes.
 #' @param acceleratorCount Number of GPUs to add to instance
@@ -244,7 +248,6 @@ gce_vm_create <- function(name,
                           scheduling = NULL, 
                           serviceAccounts = NULL, 
                           tags = NULL,
-                          auth_email = "GCE_AUTH_FILE",
                           project = gce_get_global_project(), 
                           zone = gce_get_global_zone(),
                           dry_run = FALSE,
@@ -362,12 +365,7 @@ gce_vm_create <- function(name,
 
   ## make serviceAccounts
   if(is.null(serviceAccounts)){
-    serviceAccounts = list(
-      list(
-        email = unbox(auth_email(auth_email)),
-        scopes = list("https://www.googleapis.com/auth/cloud-platform")
-      )
-    )
+    serviceAccounts = gce_make_serviceaccounts()
   }
 
   ## make instance object