Merge pull request #1 from rstudio/test-deploy

Update deploy

DESCRIPTION

@@ -1,24 +1,30 @@
-Package: connectApiUtils
+Package: connectapi
 Type: Package
-Title: Utilities for Interacting with RStudio Connect's API
-Version: 0.1.0
-Author: Sean Lopp
-Maintainer: Sean Lopp <[email protected]>
-Description: Helpful class for interacting with Connect's API and some example utility functions.
+Title: Utilities for Interacting with the RStudio Connect Server API
+Version: 0.1.0.9000
+Authors@R: c(
+  person("Sean", "Lopp", , "[email protected]", c("aut", "cre")),
+  person("Cole", "Arendt", , "[email protected]", c("aut")),
+  person("RStudio", role = c("cph", "fnd"))
+  )
+Description: Helpful R6 class for interacting with the RStudio Connect Server API and some example utility functions.
 License: GPL-2
 Encoding: UTF-8
 Imports: 
     R6,
     httr,
     rlang,
-    fs
-RoxygenNote: 6.0.1
+    glue,
+    fs,
+    config
+RoxygenNote: 6.1.1
 Suggests: 
     rmarkdown,
     htmltools,
     flexdashboard,
     webshot,
     lubridate,
     ggplot2,
-    gridExtra
+    gridExtra,
+    testthat
 Remotes: slopp/webshot

NAMESPACE

@@ -6,8 +6,11 @@ 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)

NEWS.md

@@ -0,0 +1,23 @@
+# connectapi 0.1.0.9000
+
+BREAKING: 
+* Rename a handful of functions:
+  - `connect$activate_bundle` to `connect$content_deploy`
+  - `connect$create_app` to `connect$content_create`
+  - `connect$upload_bundle` to `connect$content_upload`
+* Switch endpoints from using `app_id` to `guid`
+* `get_task$start` renamed to `get_task$first`
+* rename the package to `connectapi`
+
+OTHER: 
+* Add some endpoints:
+  - `get_content`
+  - `get_audit_logs`
+  - `get_server_settings`
+  - `get_server_settings_r`
+  - `inst_shiny_usage`
+  - `inst_content_visits`
+* Add some helper functions:
+  - `deploy_github`, `download_github`
+* Update `connect` R6 object to be compatible with Connect 1.7.0 APIs
+* Added a `NEWS.md` file to track changes to the package.

R/connect.R

@@ -133,39 +133,62 @@ Connect <- R6::R6Class(
       path <- sprintf('schedules/%d', schedule_id)
       self$GET(path)
     },
+
+    # content ----------------------------------------------------------
+
+    content_create  = function(name, title = name, ...) {
+      path <- sprintf('v1/experimental/content')
+      other_params <- rlang::dots_list(...)
+      self$POST(
+        path, 
+        c(
+          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)
       self$GET(path, httr::write_disk(to_path), "raw")
       to_path
     },
 
-    upload_bundle = function(bundle_path, app_id) {
-      path <- sprintf('applications/%d/upload', app_id)
+    content_upload = function(bundle_path, guid) {
+      # 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$id
+      new_bundle_id <- res[["task_id"]]
       new_bundle_id
     },
 
-    activate_bundle = function(app_id, bundle_id) {
-      path <- sprintf('applications/%d/deploy', app_id)
-      res <- self$POST(path, list(bundle = bundle_id))
-      task_id <- res$id
+    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
     },
+
+    get_content = function(guid) {
+      path <- sprintf("v1/experimental/content/%s", guid)
+      res <- self$GET(path)
+      return(res)
+    },
 
-    get_task = function(task_id, start = 0) {
-      path = sprintf('tasks/%s?first_status=%d', task_id, start)
+    get_task = function(task_id, first = 0, wait = 5) {
+      path <- sprintf('v1/experimental/tasks/%s?first=%d&wait=%d', task_id, first, wait)
       self$GET(path)
     },
 
+    # users -----------------------------------------------
+
     get_users = function(page_number = 1){
-      path = sprintf('v1/users?page_number=%d', page_number)
+      path <- sprintf('v1/users?page_number=%d', page_number)
       self$GET(path)
     },
 
     get_users_remote = function(prefix) {
-      path = sprintf('v1/users/remote?prefix=%s', prefix)
+      path <- sprintf('v1/users/remote?prefix=%s', prefix)
       self$GET(path)
     },
 
@@ -174,7 +197,7 @@ Connect <- R6::R6Class(
       password, user_must_set_password, 
       user_role, username
       ) {
-      path = sprintf('v1/users')
+      path <- sprintf('v1/users')
       self$POST(path = path,
                 body = list(
                   email = email,
@@ -188,39 +211,122 @@ Connect <- R6::R6Class(
     },
 
     lock_user = function(user_guid) {
-      path = sprintf('v1/users/%s/lock', user_guid)
+      path <- sprintf('v1/users/%s/lock', user_guid)
       message(path)
       self$POST(path = path,
                 body = list(locked = TRUE)
                 )
     },
 
     unlock_user = function(user_guid) {
-      path = sprintf('v1/users/%s/lock', user_guid)
+      path <- sprintf('v1/users/%s/lock', user_guid)
       self$POST(
         path = path,
         body = list(locked = FALSE)
       )
     },
 
     update_user = function(user_guid, email, ...) {
-      path = sprintf('v1/users/%s', user_guid)
+      path <- sprintf('v1/users/%s', user_guid)
       self$PUT(
         path = path,
         body = c(list(email = email), rlang::dots_list(...))
       )
     },
+
+    # instrumentation --------------------------------------------
+
+    inst_content_visits = function(
+      content_guid = NULL, 
+      min_data_version = NULL,
+      from = NULL,
+      to = NULL,
+      limit = 20,
+      previous = NULL,
+      nxt = NULL,
+      asc_order = TRUE
+      ) {
+      path <- glue::glue(
+        "v1/instrumentation/content/visits?",
+        glue::glue(
+          "{safe_query(content_guid, 'content_guid=')}",
+          "{safe_query(min_data_version, 'content_guid=')}",
+          "{safe_query(from, 'from=')}",
+          "{safe_query(to, 'to=')}",
+          "{safe_query(limit, 'limit=')}",
+          "{safe_query(previous, 'previous=')}",
+          "{safe_query(nxt, 'next=')}",
+          "{safe_query(asc_order, 'asc_order=')}",
+          .sep = "&"
+        )
+      )
+
+      self$GET(path)
+    },
 
-    create_app  = function(name) {
-      path = sprintf('applications')
-      self$POST(path, list(name = tolower(gsub("\\s","",name)), title = name ))
+    inst_shiny_usage = function(
+      content_guid = NULL, 
+      min_data_version = NULL,
+      from = NULL,
+      to = NULL,
+      limit = 20,
+      previous = NULL,
+      nxt = NULL,
+      asc_order = TRUE
+    ) {
+
+      path <- glue::glue(
+        "v1/instrumentation/shiny/usage?",
+        glue::glue(
+          "{safe_query(content_guid, 'content_guid=')}",
+          "{safe_query(min_data_version, 'content_guid=')}",
+          "{safe_query(from, 'from=')}",
+          "{safe_query(to, 'to=')}",
+          "{safe_query(limit, 'limit=')}",
+          "{safe_query(previous, 'previous=')}",
+          "{safe_query(nxt, 'next=')}",
+          "{safe_query(asc_order, 'asc_order=')}",
+          .sep = "&"
+        )
+      )
+
+      self$GET(path)
     },
 
+    # misc utilities --------------------------------------------
+
     get_docs = function(docs = "api") {
       stopifnot(docs %in% c("admin", "user", "api"))
       utils::browseURL(paste0(self$host, '/__docs__/', docs))
+    },
+
+    get_audit_logs = function(limit = 20L, previous = NULL, nxt = NULL, asc_order = TRUE) {
+      path <- glue::glue(
+        "v1/audit_logs?limit={limit}",
+        "{safe_query(previous, '&previous=')}",
+        "{safe_query(nxt, '&next=')}",
+        "&ascOrder={asc_order}"
+        )
+      self$GET(
+        path = path
+      )
+    },
+
+    get_server_settings_r = function() {
+      path <- "v1/server_settings/r"
+      self$GET(
+        path = path
+      )
+    },
+
+    get_server_settings = function() {
+      path <- "server_settings"
+      self$GET(
+        path = path
+      )
     }
 
+    # end --------------------------------------------------------
   )
 )
 
@@ -232,3 +338,13 @@ 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/github.R

@@ -0,0 +1,34 @@
+#' @export
+download_github <- function(repo, ref = "master") {
+  current_wd <- getwd()
+  on.exit(setwd(current_wd), add = TRUE)
+
+  temp_dir <- fs::dir_create(fs::path(fs::path_temp(), fs::file_temp("dir_")), recursive = TRUE)
+  tar_file <- fs::path(temp_dir, "repo.tar.gz")
+  setwd(temp_dir)
+
+  req <- httr::GET(
+    glue::glue(
+      "https://api.github.com/repos/{repo}/tarball/{ref}"
+    ), 
+    httr::write_disk(tar_file)
+  )
+
+  # un-tar and enter the repo
+  untar("repo.tar.gz")
+  setwd(fs::dir_ls(type = "directory"))
+
+  final_loc <- getwd()
+
+  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()
+  on.exit(setwd(current_wd), add = TRUE)
+
+  setwd(download_dir)
+  yaml_content(connect = connect, filename = filename)
+}