diff --git a/DESCRIPTION b/DESCRIPTION index d7949318..108bad91 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,18 +1,23 @@ -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 -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", , "sean@rstudio.com", c("aut", "cre")), + person("Cole", "Arendt", , "cole@rstudio.com", 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, @@ -20,5 +25,6 @@ Suggests: webshot, lubridate, ggplot2, - gridExtra + gridExtra, + testthat Remotes: slopp/webshot diff --git a/NAMESPACE b/NAMESPACE index 47895d7f..cb926ddd 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 00000000..9aeaf046 --- /dev/null +++ b/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. diff --git a/R/connect.R b/R/connect.R index a8084b1b..d2042e4c 100644 --- a/R/connect.R +++ b/R/connect.R @@ -133,6 +133,20 @@ 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) @@ -140,32 +154,41 @@ Connect <- R6::R6Class( 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,7 +211,7 @@ 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) @@ -196,7 +219,7 @@ Connect <- R6::R6Class( }, 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) @@ -204,23 +227,106 @@ Connect <- R6::R6Class( }, 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") + } +} diff --git a/R/github.R b/R/github.R new file mode 100644 index 00000000..a9247054 --- /dev/null +++ b/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) +} diff --git a/R/promote.R b/R/promote.R index b1e542df..0380299f 100644 --- a/R/promote.R +++ b/R/promote.R @@ -65,14 +65,43 @@ promote <- function(from, } #' @export -dir_bundle <- function(path = ".") { +content_ensure <- function(connect, name = random_name(), title = name, ...) { + + 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}")) + } else { + content <- content[[1]] + message(glue::glue("Found EXISTING content {content$guid} with ", + "name {name} on {connect$host}")) + } + return(content) +} + +random_name <- function(length = 13) { + tolower(paste(sample(LETTERS, length, replace = TRUE), collapse = "")) +} + +#' @export +dir_bundle <- function(path = ".", filename = "bundle.tar.gz") { before_wd <- getwd() setwd(path) on.exit(expr = setwd(before_wd), add = TRUE) - utils::tar(tarfile = "bundle.tar.gz", files = ".", compression = "gzip", tar = "internal") + utils::tar(tarfile = filename, files = ".", compression = "gzip", tar = "internal") - return(fs::path_abs("bundle.tar.gz")) + return(fs::path_abs(filename)) } #' @export @@ -87,18 +116,22 @@ deploy_bundle <- function(connect, bundle, app_id){ } #' @export -poll_task <- function(connect, task_id) { - start <- 0 - while (task_id > 0) { - Sys.sleep(2) - status <- connect$get_task(task_id, start) - if (length(status$status) > 0) { - lapply(status$status, print) - start <- status$last_status - } - if (status$finished) { - task_id = 0 - } +poll_task <- function(connect, task_id, wait = 1) { + finished <- FALSE + code <- -1 + first <- 0 + while (!finished) { + task_data <- connect$get_task(task_id, wait = wait, first = first) + finished <- task_data[["finished"]] + code <- task_data[["code"]] + first <- task_data[["last"]] + + lapply(task_data[["output"]], message) + } + + if (code != 0) { + msg <- task_data[["error"]] + stop(msg) } invisible() } diff --git a/R/tag_page.R b/R/tag_page.R index b71d0ff9..688bef1e 100644 --- a/R/tag_page.R +++ b/R/tag_page.R @@ -39,7 +39,7 @@ tag_page <- function(server, a }) - template <- system.file('tag_page_template.Rmd', package = "connectApiUtils") + template <- system.file('tag_page_template.Rmd', package = "connectapi") out_file <- sprintf('%s.html', tag) out_dir <- getwd() rmarkdown::render(template, diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 00000000..3a55d34f --- /dev/null +++ b/R/utils.R @@ -0,0 +1,32 @@ +safe_query <- function(expr, prefix = "", collapse = "|") { + if (is.null(expr)) { + return("") + } else { + return(paste0(prefix, glue::glue_collapse(expr, sep = collapse))) + } +} + +check_connect_version <- function(connect) { + settings <- connect$get_server_settings() + using_version <- settings[["version"]] + + comp <- compareVersion(tested_version, using_version) + + msg <- switch( + as.character(comp), + "0" = NULL, + "1" = warning(glue::glue( + "You are using an older version of RStudio Connect", + "({using_version}) than was tested ({tested_version}).", + "Some APIs may not function as expected." + )), + "-1" = warning(glue::glue( + "You are using a newer version of RStudio Connect", + "({using_version}) than was tested ({tested_version}).", + "Some APIs may not function as expected." + )) + ) + invisible() +} + +tested_version <- "1.7.0-11" diff --git a/R/yaml.R b/R/yaml.R new file mode 100644 index 00000000..2ca6545c --- /dev/null +++ b/R/yaml.R @@ -0,0 +1,69 @@ +yaml_content <- function(connect, filename = ".connect.yml") { + cfg <- config::get(value = "content", file = filename) + + res <- lapply( + cfg, + function(x, connect) { + rlang::exec(yaml_content_deploy, connect = connect, !!!x) + }, + connect = connect + ) + + return(cfg) +} + +yaml_content_deploy <- function( + connect, + name = random_name(), + path = "./", + description = NULL, + tag = NULL, + url = NULL, + image = NULL, + ... +) { + orig_connect <- connect + connect <- connect_input(connect) + bundle_path <- dir_bundle(path = path) + + c_obj <- rlang::exec( + content_ensure, + connect = connect, + name = name, + description = description, + ... + ) + + c_guid <- c_obj[["guid"]] + + c_upload <- connect$content_upload( + bundle_path = bundle_path, + guid = c_guid + ) + + c_task <- connect$content_deploy( + guid = c_guid, + bundle_id = c_upload + ) + + # wait for task to complete + poll_task( + connect, + c_task + ) + + # tag helper + if (!is.null(tag)) { + # need public APIs + } + + # set vanity URL + if (!is.null(url)) { + # need public APIs + } + + # set image path + if (!is.null(image)) { + # need public APIs + } +} diff --git a/README.md b/README.md index ba8f9d71..e7fe4523 100644 --- a/README.md +++ b/README.md @@ -7,7 +7,7 @@ This package is an **experimental WIP**. The package is designed to provide an R To get started: ```r -devtools::install_github('slopp/connectApiUtils') +devtools::install_github('rstudio/connectapi') ``` ## Client @@ -15,7 +15,7 @@ devtools::install_github('slopp/connectApiUtils') To create a client: ```r -library(connectApiUtils) +library(connectapi) client <- Connect$new( host = 'https://connect.example.com', api_key = '' diff --git a/connectApiUtils.Rproj b/connectapi.Rproj similarity index 92% rename from connectApiUtils.Rproj rename to connectapi.Rproj index 21a4da08..8de5cfd3 100644 --- a/connectApiUtils.Rproj +++ b/connectapi.Rproj @@ -12,6 +12,8 @@ Encoding: UTF-8 RnwWeave: Sweave LaTeX: pdfLaTeX +AutoAppendNewline: Yes + BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 00000000..59ac4bbb --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(connectapi) + +test_check("connectapi") diff --git a/tests/testthat/test_utils.R b/tests/testthat/test_utils.R new file mode 100644 index 00000000..71fc79d5 --- /dev/null +++ b/tests/testthat/test_utils.R @@ -0,0 +1,16 @@ +context("utils") + +test_that("safequery handles values correctly", { + pref <- "prefixed" + nullval = NULL + expect_identical(safe_query(nullval, pref), "") + + oneval <- "blah" + expect_identical(safe_query(oneval, pref), paste0(pref, oneval)) + + moreval <- c("blah", "blah2") + expect_identical(safe_query(moreval, pref), paste0(pref, paste(moreval, collapse = "|"))) + + morenull <- c(NULL, NULL) + expect_identical(safe_query(morenull, pref, "|"), "") +})