Merge pull request #3 from rstudio/update-paging

Misc. Cleanup

Author: colearendt

.Rbuildignore

@@ -1,2 +1,3 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
+^\.Renviron$

.gitignore

@@ -2,3 +2,4 @@
 .Rhistory
 .RData
 .Ruserdata
+.Renviron

DESCRIPTION

@@ -16,7 +16,8 @@ Imports:
     rlang,
     glue,
     fs,
-    config
+    config,
+    yaml
 RoxygenNote: 6.1.1
 Suggests: 
     rmarkdown,

NAMESPACE

@@ -6,11 +6,7 @@ export(audit_r_versions)
 export(audit_runas)
 export(audit_vanity_urls)
 export(cache_apps)
-export(content_ensure)
-export(deploy_bundle)
-export(deploy_github)
-export(dir_bundle)
-export(download_github)
-export(poll_task)
 export(promote)
 export(tag_page)
+importFrom(utils,compareVersion)
+importFrom(utils,untar)

NEWS.md

@@ -5,8 +5,12 @@ BREAKING:
   - `connect$activate_bundle` to `connect$content_deploy`
   - `connect$create_app` to `connect$content_create`
   - `connect$upload_bundle` to `connect$content_upload`
+* Change some return types to be consistent with the API
+  - `connect$content_upload` returns the response instead of `bundle_id`
+  - `connect$content_deploy` returns the response instead of `task_id`
 * Switch endpoints from using `app_id` to `guid`
 * `get_task$start` renamed to `get_task$first`
+* `promote$app_name` renamed to `promote$name`
 * rename the package to `connectapi`
 
 OTHER: 

R/connect.R

@@ -29,7 +29,8 @@ Connect <- R6::R6Class(
     tags = NULL,
     tag_map = NULL,
 
-    initialize = function(host = NA, api_key = NA) {
+    initialize = function(host = Sys.getenv("RSTUDIO_CONNECT_SERVER", NA), api_key = Sys.getenv("RSTUDIO_CONNECT_API_KEY", NA)) {
+      message(glue::glue("Defining Connect with host: {host}"))
       self$host = host
       self$api_key = api_key
     },
@@ -142,14 +143,14 @@ Connect <- R6::R6Class(
       self$POST(
         path, 
         c(
-          list(name = tolower(gsub("\\s","",name)), title = title ),
+          list(name = tolower(gsub("\\s","",name)), title = title),
           other_params
         )
       )
     },
 
     download_bundle = function(bundle_id, to_path = tempfile()) {
-      path <- sprintf('bundles/%d/download', bundle_id)
+      path <- glue::glue('bundles/{bundle_id}/download')
       self$GET(path, httr::write_disk(to_path), "raw")
       to_path
     },
@@ -158,15 +159,13 @@ Connect <- R6::R6Class(
       # todo : add X-Content-Checksum
       path <- glue::glue('v1/experimental/content/{guid}/upload')
       res <- self$POST(path, httr::upload_file(bundle_path), 'raw')
-      new_bundle_id <- res[["task_id"]]
-      new_bundle_id
+      return(res)
     },
 
     content_deploy = function(guid, bundle_id) {
       path <- sprintf('v1/experimental/content/%s/deploy', guid)
       res <- self$POST(path, list(bundle_id = as.character(bundle_id)))
-      task_id <- res[["task_id"]]
-      task_id
+      return(res)
     },
 
     get_content = function(guid) {
@@ -338,13 +337,3 @@ check_debug <- function(req, res) {
   }
 }
 
-connect_input <- function(connect) {
-  if (R6::is.R6(connect)) {
-    # is an R6 object... we presume the right type
-    return(connect)
-  } else if (is.list(connect) && c("host","api_key") %in% names(connect)) {
-    return(Connect$new(host = connect[["host"]], api_key = connect[["api_key"]]))
-  } else {
-    stop("Input 'connect' is not an R6 object or a named list")
-  }
-}

R/connectapi.R

@@ -0,0 +1,9 @@
+#' @importFrom utils compareVersion
+#' @importFrom utils untar
+"_PACKAGE"
+
+utils::globalVariables(
+  c(
+    "r_version"
+  )
+)

R/github.R

@@ -1,4 +1,3 @@
-#' @export
 download_github <- function(repo, ref = "master") {
   current_wd <- getwd()
   on.exit(setwd(current_wd), add = TRUE)
@@ -23,7 +22,6 @@ download_github <- function(repo, ref = "master") {
   return(final_loc)
 }
 
-#' @export
 deploy_github <- function(connect, repo, ref = "master", filename = ".connect.yml") {
   download_dir <- download_github(repo = repo, ref = ref)
   current_wd <- getwd()

R/promote.R

@@ -11,7 +11,7 @@
 #'   publisher priviliges.
 #' @param from_key An API key on the originating "from" server. The API key must
 #'   belong to a user with collaborator access to the content to be promoted.
-#' @param app_name The name of the content on the originating "from" server.
+#' @param name The name of the content on the originating "from" server.
 #'   If content with the same name is found on the destination server,
 #'   the content will be updated. If no content on the destination server
 #'   has a matching name, a new endpoint will be created.
@@ -21,7 +21,7 @@ promote <- function(from,
                     to,
                     to_key,
                     from_key,
-                    app_name) {
+                    name) {
 
   # TODO Validate Inputs
 
@@ -30,70 +30,73 @@ promote <- function(from,
   to_client <- Connect$new(host = to, api_key = to_key)
 
   # find app on "from" server
-  from_app <- from_client$get_apps(list(name = app_name))
+  from_app <- from_client$get_apps(list(name = name))
   if (length(from_app) != 1) {
-    stop(sprintf('Found %d apps matching app name %s on %s. Content must have a unique name.', length(from_app), app_name, from))
+    stop(sprintf('Found %d apps matching app name %s on %s. Content must have a unique name.', length(from_app), name, from))
   }
 
   # download bundle
   bundle <- from_client$download_bundle(from_app[[1]]$bundle_id)
 
   # find or create app to update
-  to_app <- to_client$get_apps(list(name = app_name))
-  if (length(to_app) > 1) {
-    stop(sprintf('Found %d apps matching %s on %s, content must have a unique name.', length(to_app), app_name, to))
-  } else if (length(to_app) == 0) {
-    # create app
-    to_app <- to_client$create_app(app_name)
-    warning(sprintf('Creating NEW app %d with name %s on %s', to_app$id, app_name, to))
-  } else {
-    to_app <- to_app[[1]]
-    warning(sprintf('Updating EXISTING app %d with name %s on %s', to_app$id, app_name, to))
-  }
+  to_app <- content_ensure(connect = to_client, name = name)
 
-  task_id <- deploy_bundle(
-    connect = to_client,
-    bundle = bundle,
-    app_id = to_app$id
-  )
+  bundle_id <- to_client$content_upload(bundle_path = bundle, guid = to_app[["guid"]])[["bundle_id"]]
+  task_id <- to_client$content_deploy(guid = to_app[["guid"]], bundle_id = bundle_id)[["task_id"]]
 
   poll_task(connect = to_client, task_id = task_id)
 
-  to_app_url <- app$url
+  to_app_url <- to_app$url
 
   return(to_app_url)
 }
 
-#' @export
-content_ensure <- function(connect, name = random_name(), title = name, ...) {
+content_ensure <- function(connect, name = random_name(), title = name, guid = NULL, ...) {
 
-  content <- connect$get_apps(list(name = name))
-  if (length(content) > 1) {
-    stop(glue::glue("Found {length(to_content)} content items ",
-              "matching {content_name} on {connect$host}",
-              ", content must have a unique name."))
-  } else if (length(content) == 0) {
-    # create app
-    content <- connect$content_create(
-      name = name,
-      title = title,
-      ...
-    )
-    message(glue::glue("Creating NEW content {content$guid} ",
-                 "with name {name} on {connect$host}"))
+  if (!is.null(guid)) {
+    # guid-based deployment
+    # just in case we get a 404 back...
+    content <- tryCatch(connect$get_content(guid = guid), error = function(e){return(NULL)})
+    if (is.null(content)) {
+      warning(glue::glue(
+        "guid {guid} was not found on {connect$host}.",
+        "Creating new content with name {name}"))
+      content <- connect$content_create(
+        name = name,
+        title = title,
+        ...
+      )
+    }
   } else {
-    content <- content[[1]]
-    message(glue::glue("Found EXISTING content {content$guid} with ",
-    "name {name} on {connect$host}"))
+    # name-based deployment
+    content <- connect$get_apps(list(name = name))
+    if (length(content) > 1) {
+      stop(glue::glue("Found {length(to_content)} content items ",
+                "matching {name} on {connect$host}",
+                ", content must have a unique name."))
+    } else if (length(content) == 0) {
+      # create app
+      content <- connect$content_create(
+        name = name,
+        title = title,
+        ...
+      )
+      message(glue::glue("Creating NEW content {content$guid} ",
+                   "with name {name} on {connect$host}"))
+    } else {
+      content <- content[[1]]
+      message(glue::glue("Found EXISTING content {content$guid} with ",
+      "name {name} on {connect$host}"))
+      # update values...? need a PUT endpoint
+    }
   }
   return(content)
 }
 
-random_name <- function(length = 13) {
+random_name <- function(length = 25) {
   tolower(paste(sample(LETTERS, length, replace = TRUE), collapse = ""))
 }
 
-#' @export
 dir_bundle <- function(path = ".", filename = "bundle.tar.gz") {
   before_wd <- getwd()
   setwd(path)
@@ -104,18 +107,16 @@ dir_bundle <- function(path = ".", filename = "bundle.tar.gz") {
   return(fs::path_abs(filename))
 }
 
-#' @export
-deploy_bundle <- function(connect, bundle, app_id){
+deploy_bundle <- function(connect, bundle_path, guid){
   #upload bundle
-  new_bundle_id <- connect$upload_bundle(bundle, app_id)
+  new_bundle_id <- connect$content_upload(bundle_path = bundle_path, guid = guid)[["bundle_id"]]
 
   #activate bundle
-  task_id <- connect$activate_bundle(app_id, new_bundle_id)
+  task_id <- connect$content_deploy(guid = guid, bundle_id = new_bundle_id)[["task_id"]]
 
   return(task_id)
 }
 
-#' @export
 poll_task <- function(connect, task_id, wait = 1) {
   finished <- FALSE
   code <- -1

R/utils.R

@@ -1,3 +1,4 @@
+# this function helps creating query parameters
 safe_query <- function(expr, prefix = "", collapse = "|") {
   if (is.null(expr)) {
     return("")
@@ -6,6 +7,9 @@ safe_query <- function(expr, prefix = "", collapse = "|") {
   }
 }
 
+
+# experimental functions
+
 check_connect_version <- function(connect) {
   settings <- connect$get_server_settings()
   using_version <- settings[["version"]]
@@ -30,3 +34,14 @@ check_connect_version <- function(connect) {
 }
 
 tested_version <- "1.7.0-11"
+
+connect_input <- function(connect) {
+  if (R6::is.R6(connect)) {
+    # is an R6 object... we presume the right type
+    return(connect)
+  } else if (is.list(connect) && c("host","api_key") %in% names(connect)) {
+    return(Connect$new(host = connect[["host"]], api_key = connect[["api_key"]]))
+  } else {
+    stop("Input 'connect' is not an R6 object or a named list")
+  }
+}

R/yaml.R

@@ -1,3 +1,23 @@
+yaml_template <- function(file = NULL){
+  obj <- list(
+    "default" = list(
+      "content" = list(
+        list(
+          "title" = "Title of the Content",
+          "path" = "./",
+          "description" = "Content description"
+        )
+      )
+    )
+  )
+  
+  if (!is.null(file)) {
+    yaml::write_yaml(x = obj, file = file)
+  } else {
+    return(cat(yaml::as.yaml(obj)))
+  }
+}
+
 yaml_content <- function(connect, filename = ".connect.yml") {
   cfg <- config::get(value = "content", file = filename)
 
@@ -9,7 +29,7 @@ yaml_content <- function(connect, filename = ".connect.yml") {
     connect = connect
   )
 
-  return(cfg)
+  return(res)
 }
 
 yaml_content_deploy <- function(
@@ -20,10 +40,11 @@ yaml_content_deploy <- function(
   tag = NULL,
   url = NULL,
   image = NULL,
+  wait = TRUE,
   ...
 ) {
-  orig_connect <- connect
-  connect <- connect_input(connect)
+  #orig_connect <- connect
+  #connect <- connect_input(connect)
   bundle_path <- dir_bundle(path = path)
 
   c_obj <- rlang::exec(
@@ -43,14 +64,16 @@ yaml_content_deploy <- function(
 
   c_task <- connect$content_deploy(
     guid = c_guid,
-    bundle_id = c_upload
+    bundle_id = c_upload[["bundle_id"]]
   )
 
-  # wait for task to complete
-  poll_task(
-    connect,
-    c_task
-  )
+  if (wait) {
+    # wait for task to complete
+    poll_task(
+      connect,
+      c_task[["task_id"]]
+    )
+  }
 
   # tag helper
   if (!is.null(tag)) {
@@ -66,4 +89,7 @@ yaml_content_deploy <- function(
   if (!is.null(image)) {
     # need public APIs
   }
+  
+  # return the content info _and_ the task info
+  return(list(content = c_obj, task = c_task))
 }