feat: new function set_content_image(), deprecate old set_image_* functions

DESCRIPTION

@@ -32,6 +32,7 @@ Imports:
     fs,
     glue,
     httr,
+    mime,
     jsonlite,
     lifecycle,
     magrittr,

NAMESPACE

@@ -58,6 +58,7 @@ export(dashboard_url_chr)
 export(delete_bundle)
 export(delete_image)
 export(delete_tag)
+export(delete_thumbnail)
 export(delete_vanity_url)
 export(deploy)
 export(deploy_current)
@@ -84,6 +85,7 @@ export(get_oauth_credentials)
 export(get_procs)
 export(get_tag_data)
 export(get_tags)
+export(get_thumbnail)
 export(get_timezones)
 export(get_usage_shiny)
 export(get_usage_static)
@@ -97,6 +99,7 @@ export(get_variant_schedule)
 export(get_variants)
 export(groups_create_remote)
 export(has_image)
+export(has_thumbnail)
 export(page_cursor)
 export(page_offset)
 export(poll_task)
@@ -127,6 +130,7 @@ export(set_schedule_semimonth)
 export(set_schedule_week)
 export(set_schedule_weekday)
 export(set_schedule_year)
+export(set_thumbnail)
 export(set_vanity_url)
 export(swap_vanity_url)
 export(tbl_connect)

NEWS.md

@@ -1,3 +1,21 @@
+# Unreleased
+
+## New features
+
+- New functions `set_thumbnail()`, `get_thumbnail()`, `delete_thumbnail()` and
+  `has_thumbnail()` let you interact with content thumbnails, replacing older
+  `*_image()` functions.
+
+## Lifecycle changes
+
+### Newly deprecated
+
+- `set_image_path()`, `set_image_url()`, and `set_image_webshot()` have been
+  deprecated and will be removed in a future update. They have been replaced by
+  `set_thumbnail()`, which works both with local file paths and remote URLs to
+  images. Likewise, `has_image()` and `delete_image()` have been deprecated in
+  favor of `has_thumbnail()` and `delete_thumbnail()`.
+
 # connectapi 0.3.0
 
 ## Breaking changes

R/connect.R

@@ -20,7 +20,7 @@
 #' @family R6 classes
 #'
 #' @export
 Connect <- R6::R6Class(
   "Connect",
   public = list(
     #' @field server The base URL of your Posit Connect server.
@@ -67,7 +67,7 @@
     print = function(...) {
       cat("Posit Connect API Client: \n")
       cat("  Posit Connect Server: ", self$server, "\n", sep = "")
       cat("  Posit Connect API Key: ", paste0(strrep("*", 11), substr(self$api_key, nchar(self$api_key) - 3, nchar(self$api_key))), "\n", sep = "")
       # TODO: something about API key... role... ?
       # TODO: point to docs on methods... how to see methods?
       cat("\n")
@@ -107,7 +107,13 @@
     #' @description Build a URL relative to the API root
     #' @param ... path segments
     api_url = function(...) {
-      paste(self$server, "__api__", ..., sep = "/")
+      self$server_url("__api__", ...)
+    },
+
+    #' @description Build a URL relative to the server root
+    #' @param ... path segments
+    server_url = function(...) {
+      paste(self$server, ..., sep = "/")
     },
 
     #' @description General wrapper around `httr` verbs
@@ -181,7 +187,7 @@
       self$request("HEAD", url, parser = NULL, ...)
     },
 
     #' @description Perform an HTTP DELETE request of the named API path. Returns the HTTP response object.
     #' @param path API path relative to the server's `/__api__` root.
     #' @param ... Arguments to `httr::DELETE()`
     #' @param url Target URL. Default uses `path`, but provide `url` to request
@@ -352,7 +358,7 @@
         count = min(page_size, .limit)
       )
       if (!is.null(filter)) {
         query$filter <- paste(sapply(1:length(filter), function(i) {
           sprintf("%s:%s", names(filter)[i], filter[[i]])
         }), collapse = .collapse)
       }
@@ -745,7 +751,7 @@
       warn_experimental("repo_account")
       parsed_url <- httr::parse_url(host)
       if (is.null(parsed_url$scheme) || is.null(parsed_url$hostname)) {
         stop(glue::glue("Scheme and hostname must be provided (i.e. 'https://github.com'). You provided '{host}'"))
       }
       host <- glue::glue(parsed_url$scheme, "://", parsed_url$hostname)
       path <- unversioned_url("repo", "account")
@@ -775,7 +781,7 @@
     #' @param start Starting time.
     #' @param end Ending time.
     #' @param detailed Indicates detailed schedule information.
     schedules = function(start = Sys.time(), end = Sys.time() + 60 * 60 * 24 * 7, detailed = FALSE) {
       warn_experimental("schedules")
       url <- v1_url("experimental", "schedules")
       query_params <- rlang::list2(

R/deploy.R

@@ -399,172 +399,6 @@ deploy_current <- function(content) {
   return(ContentTask$new(connect = content$get_connect(), content = content, task = res))
 }
 
-
-#' Get the Content Image
-#'
-#' \lifecycle{experimental}
-#' `get_image` saves the content image to the given path (default: temp file).
-#' `delete_image` removes the image (optionally saving to the given path)
-#' `has_image` returns whether the content has an image
-#'
-#' @param content A content object
-#' @param path optional. The path to the image on disk
-#'
-#' @rdname get_image
-#' @family content functions
-#' @export
-get_image <- function(content, path = NULL) {
-  warn_experimental("get_image")
-  validate_R6_class(content, "Content")
-  guid <- content$get_content()$guid
-
-  con <- content$get_connect()
-
-  res <- con$GET(
-    unversioned_url("applications", guid, "image"),
-    parser = NULL
-  )
-
-  if (httr::status_code(res) == 204) {
-    return(NA)
-  }
-
-  # guess file extension
-  if (is.null(path)) {
-    ct <- httr::headers(res)$`content-type`
-    if (grepl("^image/", ct)) {
-      # just strip off 'image/'
-      ext <- substr(ct, 7, nchar(ct))
-      path <- fs::file_temp(pattern = "content_image_", ext = ext)
-    } else {
-      # try png
-      warning(glue::glue("Could not infer file extension from content type: {ct}. Using '.png'"))
-      path <- fs::file_temp(pattern = "content_image_", ext = ".png")
-    }
-  }
-
-  writeBin(httr::content(res, as = "raw"), path)
-
-  return(fs::as_fs_path(path))
-}
-
-#' @rdname get_image
-#' @export
-delete_image <- function(content, path = NULL) {
-  warn_experimental("delete_image")
-  validate_R6_class(content, "Content")
-  guid <- content$get_content()$guid
-
-  con <- content$get_connect()
-
-  if (!is.null(path)) {
-    scoped_experimental_silence()
-    get_image(content, path)
-  }
-
-  res <- con$DELETE(unversioned_url("applications", guid, "image"))
-
-  return(content)
-}
-
-#' @rdname get_image
-#' @export
-has_image <- function(content) {
-  warn_experimental("has_image")
-  validate_R6_class(content, "Content")
-  guid <- content$get_content()$guid
-
-  con <- content$get_connect()
-
-  res <- con$GET(unversioned_url("applications", guid, "image"), parser = NULL)
-
-  httr::status_code(res) != 204
-}
-
-#' Set the Content Image
-#'
-#' \lifecycle{experimental}
-#'
-#' Set the Content Image using a variety of methods.
-#'
-#' NOTE: `set_image_webshot()` requires [webshot2::webshot()], but currently
-#' skips and warns for any content that requires authentication until the
-#' `webshot2` package supports authentication.
-#'
-#' @param content A content object
-#' @param path The path to an image on disk
-#' @param url The url for an image
-#' @param ... Additional arguments passed on to [webshot2::webshot()]
-#'
-#' @rdname set_image
-#' @family content functions
-#' @export
-set_image_path <- function(content, path) {
-  warn_experimental("set_image_path")
-  validate_R6_class(content, "Content")
-  guid <- content$get_content()$guid
-
-  con <- content$get_connect()
-
-  res <- con$POST(
-    path = unversioned_url("applications", guid, "image"),
-    body = httr::upload_file(path)
-  )
-
-  # return the input (in case it inherits more than just Content)
-  content
-}
-
-#' @rdname set_image
-#' @export
-set_image_url <- function(content, url) {
-  warn_experimental("set_image_url")
-  validate_R6_class(content, "Content")
-  parsed_url <- httr::parse_url(url)
-  imgfile <- fs::file_temp(pattern = "image", ext = fs::path_ext(parsed_url[["path"]]))
-  httr::GET(url, httr::write_disk(imgfile))
-
-  set_image_path(content = content, path = imgfile)
-}
-
-#' @rdname set_image
-#' @export
-set_image_webshot <- function(content, ...) {
-  warn_experimental("set_image_webshot")
-  validate_R6_class(content, "Content")
-  imgfile <- fs::file_temp(pattern = "webshot", ext = ".png")
-
-  rlang::check_installed("webshot2", "to take screenshots of applications")
-  content_details <- content$get_content_remote()
-
-  # check if it is possible to take the webshot
-  if (content_details$access_type != "all") {
-    warning(glue::glue(
-      "WARNING: unable to take webshot for content ",
-      "'{content_details$guid}' because authentication is not possible yet. ",
-      "Set access_type='all' to proceed."
-    ))
-    return(content)
-  }
-
-  # default args
-  args <- rlang::list2(...)
-
-  if (!"cliprect" %in% names(args)) {
-    args["cliprect"] <- "viewport"
-  }
-
-
-  rlang::inject(webshot2::webshot(
-    url = content_details$content_url,
-    file = imgfile,
-    !!!args
-  ))
-
-  set_image_path(content = content, path = imgfile)
-}
-
-
 #' Set the Vanity URL
 #'
 #' Sets the Vanity URL for a piece of content.