diff --git a/.Rbuildignore b/.Rbuildignore index 91114bf2f..68cb2a1af 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,2 +1,3 @@ ^.*\.Rproj$ ^\.Rproj\.user$ +^\.Renviron$ diff --git a/.gitignore b/.gitignore index 5b6a06525..221b53135 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,4 @@ .Rhistory .RData .Ruserdata +.Renviron diff --git a/DESCRIPTION b/DESCRIPTION index 108bad91d..9aa12080e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -16,7 +16,8 @@ Imports: rlang, glue, fs, - config + config, + yaml RoxygenNote: 6.1.1 Suggests: rmarkdown, diff --git a/NAMESPACE b/NAMESPACE index cb926ddd6..b4fa0fc12 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index 9aeaf046f..dccde2709 100644 --- a/NEWS.md +++ b/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: diff --git a/R/connect.R b/R/connect.R index d2042e4c0..7313d0fbe 100644 --- a/R/connect.R +++ b/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") - } -} diff --git a/R/connectapi.R b/R/connectapi.R new file mode 100644 index 000000000..4a09bc54e --- /dev/null +++ b/R/connectapi.R @@ -0,0 +1,9 @@ +#' @importFrom utils compareVersion +#' @importFrom utils untar +"_PACKAGE" + +utils::globalVariables( + c( + "r_version" + ) +) diff --git a/R/github.R b/R/github.R index a92470549..33c7805c8 100644 --- a/R/github.R +++ b/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() diff --git a/R/promote.R b/R/promote.R index 0380299f2..f2fa0a295 100644 --- a/R/promote.R +++ b/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 diff --git a/R/utils.R b/R/utils.R index 3a55d34fa..2ee2e4d50 100644 --- a/R/utils.R +++ b/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") + } +} diff --git a/R/yaml.R b/R/yaml.R index 2ca6545c8..28b751066 100644 --- a/R/yaml.R +++ b/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)) } diff --git a/man/connectapi-package.Rd b/man/connectapi-package.Rd new file mode 100644 index 000000000..9ec36b16b --- /dev/null +++ b/man/connectapi-package.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/connectapi.R +\docType{package} +\name{connectapi-package} +\alias{connectapi} +\alias{connectapi-package} +\title{connectapi: Utilities for Interacting with the RStudio Connect Server API} +\description{ +Helpful R6 class for interacting with the RStudio Connect Server API and some example utility functions. +} +\author{ +\strong{Maintainer}: Sean Lopp \email{sean@rstudio.com} + +Authors: +\itemize{ + \item Cole Arendt \email{cole@rstudio.com} +} + +Other contributors: +\itemize{ + \item RStudio [copyright holder, funder] +} + +} diff --git a/man/promote.Rd b/man/promote.Rd index ef15d99b7..e32fe2b15 100644 --- a/man/promote.Rd +++ b/man/promote.Rd @@ -4,7 +4,7 @@ \alias{promote} \title{Promote content from one Connect server to another} \usage{ -promote(from, to, to_key, from_key, app_name) +promote(from, to, to_key, from_key, name) } \arguments{ \item{from}{The url for the server containing the content (the originating @@ -22,7 +22,7 @@ publisher priviliges.} \item{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.} -\item{app_name}{The name of the content on the originating "from" server. +\item{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.} diff --git a/tests/testthat/integrated-tests/test-deployment.R b/tests/testthat/integrated-tests/test-deployment.R new file mode 100644 index 000000000..b77b7f8a6 --- /dev/null +++ b/tests/testthat/integrated-tests/test-deployment.R @@ -0,0 +1,93 @@ +context("test deployment pipelines") + +# should connect with env vars +test_conn_1 <- Connect$new(host = Sys.getenv("TEST_SERVER_1"), api_key = Sys.getenv("TEST_KEY_1")) +test_conn_2 <- Connect$new(host = Sys.getenv("TEST_SERVER_2"), api_key = Sys.getenv("TEST_KEY_2")) + +cont1_name <- uuid::UUIDgenerate() +cont1_title <- "Test Content 1" +cont1_guid <- NULL +cont1_bundle <- NULL + +test_that("can create content", { + cont1 <- test_conn_1$content_create(name = cont1_name, title = cont1_title) + expect_equal(cont1$name, cont1_name) + expect_equal(cont1$title, cont1_title) + + get_cont1 <- test_conn_1$get_content(guid = cont1$guid) + expect_identical(get_cont1, cont1) + cont1_guid <<- cont1$guid +}) + +test_that("can upload and deploy content", { + cont1_bundle <<- dir_bundle( + rprojroot::find_testthat_root_file("test-plot"), + "../test-ex-1.tar.gz" + ) + expect_true(fs::file_exists(cont1_bundle)) + + res <- test_conn_1$content_upload(bundle_path = cont1_bundle, guid = cont1_guid) + expect_false(is.null(res)) + expect_silent(as.integer(res[["bundle_id"]])) + + task <- test_conn_1$content_deploy(guid = cont1_guid, bundle_id = res[["bundle_id"]]) + expect_is(task[["task_id"]], "character") + + res <- poll_task(test_conn_1, task_id = task[["task_id"]]) + expect_null(res) +}) + +test_that("can promote content to another server", { + res <- promote( + from = Sys.getenv("TEST_SERVER_1"), + from_key = Sys.getenv("TEST_KEY_1"), + to = Sys.getenv("TEST_SERVER_2"), + to_key = Sys.getenv("TEST_KEY_2"), + name = cont1_name + ) + + expect_is(res, "character") + + cont1_2 <- content_ensure( + connect = test_conn_2, + name = cont1_name + ) + + expect_identical(cont1_name, cont1_2[["name"]]) +}) + +test_that("content_ensure works with guid", { + c1 <- content_ensure(test_conn_1, guid = cont1_guid) + expect_identical(c1[["guid"]], cont1_guid) + + fake_guid <- paste0(cont1_guid, "-does-not-exist") + expect_warning({c2 <- content_ensure(test_conn_1, guid = fake_guid)}) + expect_false(identical(c2[["guid"]], cont1_guid)) +}) + +test_that("content_ensure works with name", { + expect_message(c_new <- content_ensure(test_conn_1)) + expect_is(c_new[["guid"]], "character") + + expect_message( + c_same <- content_ensure(test_conn_1, name = c_new[["name"]]) + ) + + expect_identical(c_new[["name"]], c_same[["name"]]) + expect_identical(c_new[["guid"]], c_same[["guid"]]) + + c_newname <- paste0(c_new[["name"]], "-alternate") + c_title <- "Some Title" + c_desc <- "Some Description" + expect_message( + c_diff <- content_ensure(test_conn_1, name = c_newname, + title = c_title, description = c_desc) + ) + + expect_false(identical(c_new[["name"]], c_diff[["name"]])) + expect_false(identical(c_new[["guid"]], c_diff[["guid"]])) + expect_identical(c_newname, c_diff[["name"]]) + expect_identical(c_title, c_diff[["title"]]) + expect_identical(c_desc, c_diff[["description"]]) + +}) diff --git a/tests/testthat/test-integrated.R b/tests/testthat/test-integrated.R new file mode 100644 index 000000000..25a7bc54a --- /dev/null +++ b/tests/testthat/test-integrated.R @@ -0,0 +1,19 @@ +integrated_vars <- c( + server_1 = Sys.getenv("TEST_SERVER_1"), + key_1 = Sys.getenv("TEST_KEY_1"), + server_2 = Sys.getenv("TEST_SERVER_2"), + key_2 = Sys.getenv("TEST_KEY_2") +) + +health_checks <- list( + server_1 = httr::content(httr::GET(paste0(integrated_vars[["server_1"]], "/__ping__"))), + server_2 = httr::content(httr::GET(paste0(integrated_vars[["server_2"]], "/__ping__"))) +) + +# decide if integrated tests can run +if ( + all(nchar(integrated_vars) > 0) && + all(as.logical(lapply(health_checks, function(x){length(x) == 0}))) + ) { + test_dir("integrated-tests") +} diff --git a/tests/testthat/test-plot/manifest.json b/tests/testthat/test-plot/manifest.json new file mode 100644 index 000000000..2c0d2c3ff --- /dev/null +++ b/tests/testthat/test-plot/manifest.json @@ -0,0 +1,19 @@ +{ + "version": 1, + "locale": "en_US", + "platform": "3.4.3", + "metadata": { + "appmode": "static", + "primary_rmd": null, + "primary_html": "plot.png", + "content_category": null, + "has_parameters": false + }, + "packages": null, + "files": { + "plot.png": { + "checksum": "fe381830d2434bbca940b6dc9c2251ce" + } + }, + "users": null +} diff --git a/tests/testthat/test-plot/plot.png b/tests/testthat/test-plot/plot.png new file mode 100644 index 000000000..31a1e9363 Binary files /dev/null and b/tests/testthat/test-plot/plot.png differ diff --git a/tests/testthat/test_utils.R b/tests/testthat/test-utils.R similarity index 100% rename from tests/testthat/test_utils.R rename to tests/testthat/test-utils.R