diff --git a/.github/rstudio-connect.gcfg b/.github/rstudio-connect.gcfg index 15538ad8..c30e42d2 100644 --- a/.github/rstudio-connect.gcfg +++ b/.github/rstudio-connect.gcfg @@ -11,6 +11,7 @@ Provider = pam [Authorization] DefaultUserRole = publisher +PublishersCanManageVanities = true [RPackageRepository "CRAN"] URL = https://packagemanager.rstudio.com/cran/__linux__/bionic/latest diff --git a/DESCRIPTION b/DESCRIPTION index dc3f4b50..20eb265a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -48,6 +48,7 @@ Suggests: filelock, gitcreds, googleCloudStorageR, + ids, knitr, Microsoft365R, mime, diff --git a/NAMESPACE b/NAMESPACE index 0e33796e..1e119501 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -155,6 +155,7 @@ export(board_azure) export(board_browse) export(board_cache_path) export(board_connect) +export(board_connect_url) export(board_default) export(board_deparse) export(board_deregister) @@ -193,6 +194,7 @@ export(board_url) export(cache_browse) export(cache_info) export(cache_prune) +export(connect_auth_headers) export(legacy_azure) export(legacy_datatxt) export(legacy_dospace) diff --git a/NEWS.md b/NEWS.md index 9abf63dd..a648508b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,6 +10,9 @@ * Added new check for whether a new version is the same as the previous version, as can happen when writing pin versions very quickly (#727). + +* Added new `headers` argument for `board_url()`, mostly for authentication, as + well as new board for Connect vanity URLs `board_connect_url()` (#732). # pins 1.1.0 diff --git a/R/board_connect_url.R b/R/board_connect_url.R new file mode 100644 index 00000000..49c3aad5 --- /dev/null +++ b/R/board_connect_url.R @@ -0,0 +1,91 @@ +#' Use a vector of Posit Connect vanity URLs as a board +#' +#' @description +#' `board_connect_url()` lets you build up a board from individual +#' [vanity urls](https://docs.posit.co/connect/user/content-settings/#custom-url). +#' +#' `board_connect_url()` is read only, and does not support versioning. +#' +#' @param vanity_urls A named character vector of +#' [Connect vanity URLs](https://docs.posit.co/connect/user/content-settings/#custom-url). +#' This board is read only, and the best way to write to a pin on Connect is +#' [board_connect()]. +#' @family boards +#' @inheritParams new_board +#' @inheritParams board_url +#' @inheritParams board_connect +#' @details +#' This board is a thin wrapper around [board_url()] which uses +#' `connect_auth_headers()` for authentication via environment variable. +#' @export +#' @examplesIf interactive() +#' connect_auth_headers() +#' +#' board <- board_connect_url(c( +#' my_vanity_url_pin = "https://colorado.posit.co/rsc/great-numbers/" +#' )) +#' +#' board %>% pin_read("my_vanity_url_pin") +#' +board_connect_url <- function(vanity_urls, + cache = NULL, + use_cache_on_failure = is_interactive(), + headers = connect_auth_headers()) { + board_url( + urls = vanity_urls, + cache = cache, + use_cache_on_failure = use_cache_on_failure, + headers = headers + ) +} + +#' @export +#' @rdname board_connect_url +connect_auth_headers <- function(key = Sys.getenv("CONNECT_API_KEY")) { + c(Authorization = paste("Key", key)) +} + + +vanity_url_test <- function(env = parent.frame()) { + board <- board_connect_test() + name <- pin_write(board, 1:10, random_pin_name()) + withr::defer(if (pin_exists(board, name)) pin_delete(board, name), env) + + vanity_slug <- ids::adjective_animal() + body_path <- withr::local_tempfile() + body <- list(force = FALSE, path = glue("/{vanity_slug}/")) + jsonlite::write_json(body, body_path, auto_unbox = TRUE) + body <- httr::upload_file(body_path, "application/json") + + meta <- pin_meta(board, name) + path <- glue("v1/content/{meta$local$content_id}/vanity") + path <- rsc_path(board, path) + auth <- rsc_auth(board, path, "PUT", body_path) + resp <- httr::PUT(board$url, path = path, body = body, auth) + httr::stop_for_status(resp) + + glue("{board$url}/{vanity_slug}/") +} + +board_connect_url_test <- function(...) { + if (connect_has_colorado()) { + board_connect_url_colorado(...) + } else { + board_connect_url_susan(...) + } +} + +board_connect_url_colorado <- function(...) { + if (!connect_has_colorado()) { + testthat::skip("board_connect_url_colorado() only works with Posit's demo server") + } + board_connect_url(..., cache = fs::file_temp()) +} + +board_connect_url_susan <- function(...) { + creds <- read_creds() + board_connect_url( + ..., + headers = connect_auth_headers(creds$susan_key) + ) +} diff --git a/R/board_url.R b/R/board_url.R index 5a1d2ea0..3cba6a04 100644 --- a/R/board_url.R +++ b/R/board_url.R @@ -14,6 +14,8 @@ #' use the last cached version? Defaults to `is_interactive()` so you'll #' be robust to poor internet connectivity when exploring interactively, #' but you'll get clear errors when the code is deployed. +#' @param headers Named character vector for additional HTTP headers (such as for +#' authentication). See [connect_auth_headers()] for Posit Connect support. #' @family boards #' @inheritParams new_board #' @details @@ -42,9 +44,26 @@ #' Using a [manifest file][write_board_manifest()] can be useful because you #' can serve a board of pins and allow collaborators to access the board #' straight from a URL, without worrying about board-level storage details. -#' #' Some examples are provided in `vignette("using-board-url")`. #' +#' # Authentication for `board_url()` +#' +#' The `headers` argument allows you to pass authentication details or other +#' HTTP headers to the board, such as for a Posit Connect vanity URL that is +#' not public (see [board_connect_url()]) or a private GitHub repo. +#' +#' ```r +#' gh_pat_auth <- c( +#' Authorization = paste("token", "github_pat_XXXX") +#' ) +#' board <- board_url( +#' "https://raw.githubusercontent.com/username/repo/main/path/to/pins", +#' headers = gh_pat_auth +#' ) +#' +#' board %>% pin_list() +#' ``` +#' #' @export #' @examples #' github_raw <- function(x) paste0("https://raw.githubusercontent.com/", x) @@ -69,15 +88,18 @@ #' board_url <- function(urls, cache = NULL, - use_cache_on_failure = is_interactive()) { + use_cache_on_failure = is_interactive(), + headers = NULL) { + check_headers(headers) url_format <- get_url_format(urls) if (url_format == "pins_yaml") { - manifest <- get_manifest(urls) + manifest <- get_manifest(urls, headers) board <- board_url( manifest, cache = cache, - use_cache_on_failure = use_cache_on_failure + use_cache_on_failure = use_cache_on_failure, + headers = headers ) return(board) } @@ -92,7 +114,8 @@ board_url <- function(urls, urls = urls, cache = cache, versioned = versioned, - use_cache_on_failure = use_cache_on_failure + use_cache_on_failure = use_cache_on_failure, + headers = headers ) } @@ -136,7 +159,8 @@ pin_meta.pins_board_url <- function(board, name, version = NULL, ...) { url = paste0(url, "data.txt"), path_dir = cache_dir, path_file = "data.txt", - use_cache_on_failure = board$use_cache_on_failure + use_cache_on_failure = board$use_cache_on_failure, + headers = board$headers ) meta <- read_meta(cache_dir) local_meta( @@ -187,7 +211,8 @@ pin_fetch.pins_board_url <- function(board, name, version = NULL, ...) { url = url, path_dir = meta$local$dir, path_file = file, - use_cache_on_failure = board$use_cache_on_failure + use_cache_on_failure = board$use_cache_on_failure, + headers = board$headers ) }) @@ -240,7 +265,7 @@ get_url_format <- function(urls) { } } -get_manifest <- function(url, call = rlang::caller_env()) { +get_manifest <- function(url, headers, call = rlang::caller_env()) { # if ends with "/", look for manifest if (grepl("/$", url)) { url <- paste0(url, manifest_pin_yaml_filename) @@ -249,7 +274,7 @@ get_manifest <- function(url, call = rlang::caller_env()) { # if request fails or returns with error code tryCatch( { - resp <- httr::GET(url) + resp <- httr::GET(url, httr::add_headers(headers)) httr::stop_for_status(resp) }, error = function(e) { @@ -293,6 +318,7 @@ get_manifest <- function(url, call = rlang::caller_env()) { http_download <- function(url, path_dir, path_file, ..., use_cache_on_failure = FALSE, + headers = NULL, on_failure = NULL) { cache_path <- download_cache_path(path_dir) cache <- read_cache(cache_path)[[url]] @@ -303,12 +329,11 @@ http_download <- function(url, path_dir, path_file, ..., return(cache$path) } - headers <- httr::add_headers( + headers <- c( + headers, `If-Modified-Since` = http_date(cache$modified), `If-None-Match` = cache$etag ) - } else { - headers <- NULL } path <- fs::path(path_dir, path_file) @@ -317,7 +342,7 @@ http_download <- function(url, path_dir, path_file, ..., write_out <- httr::write_disk(tmp_path) req <- tryCatch( - httr::GET(url, headers, ..., write_out), + httr::GET(url, httr::add_headers(headers), ..., write_out), error = function(e) { if (!is.null(cache) && use_cache_on_failure) { NULL @@ -403,3 +428,10 @@ http_date <- function(x = Sys.time(), tz = "UTC") { withr::local_locale(LC_TIME = "C") strftime(.POSIXct(x), "%a, %d %b %Y %H:%M:%S", tz = tz, usetz = TRUE) } + +check_headers <- function(x, arg = caller_arg(x), call = caller_env()) { + if (!is.null(x) && (!is_character(x) || !is_named(x))) { + stop_input_type(x, "a named character vector", allow_null = TRUE, arg = arg, call = call) + } + +} diff --git a/_pkgdown.yml b/_pkgdown.yml index d2d3205d..06f403dc 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -28,6 +28,7 @@ reference: contents: - board_azure - board_connect + - board_connect_url - board_gcs - board_local - board_ms365 diff --git a/man/board_connect.Rd b/man/board_connect.Rd index b126e0e8..f5fb2242 100644 --- a/man/board_connect.Rd +++ b/man/board_connect.Rd @@ -116,6 +116,7 @@ board \%>\% pin_read("timothy/mtcars") } \seealso{ Other boards: +\code{\link{board_connect_url}()}, \code{\link{board_folder}()}, \code{\link{board_url}()} } diff --git a/man/board_connect_url.Rd b/man/board_connect_url.Rd new file mode 100644 index 00000000..8fa845c3 --- /dev/null +++ b/man/board_connect_url.Rd @@ -0,0 +1,64 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/board_connect_url.R +\name{board_connect_url} +\alias{board_connect_url} +\alias{connect_auth_headers} +\title{Use a vector of Posit Connect vanity URLs as a board} +\usage{ +board_connect_url( + vanity_urls, + cache = NULL, + use_cache_on_failure = is_interactive(), + headers = connect_auth_headers() +) + +connect_auth_headers(key = Sys.getenv("CONNECT_API_KEY")) +} +\arguments{ +\item{vanity_urls}{A named character vector of +\href{https://docs.posit.co/connect/user/content-settings/#custom-url}{Connect vanity URLs}. +This board is read only, and the best way to write to a pin on Connect is +\code{\link[=board_connect]{board_connect()}}.} + +\item{cache}{Cache path. Every board requires a local cache to avoid +downloading files multiple times. The default stores in a standard +cache location for your operating system, but you can override if needed.} + +\item{use_cache_on_failure}{If the pin fails to download, is it ok to +use the last cached version? Defaults to \code{is_interactive()} so you'll +be robust to poor internet connectivity when exploring interactively, +but you'll get clear errors when the code is deployed.} + +\item{headers}{Named character vector for additional HTTP headers (such as for +authentication). See \code{\link[=connect_auth_headers]{connect_auth_headers()}} for Posit Connect support.} + +\item{key}{The Posit Connect API key.} +} +\description{ +\code{board_connect_url()} lets you build up a board from individual +\href{https://docs.posit.co/connect/user/content-settings/#custom-url}{vanity urls}. + +\code{board_connect_url()} is read only, and does not support versioning. +} +\details{ +This board is a thin wrapper around \code{\link[=board_url]{board_url()}} which uses +\code{connect_auth_headers()} for authentication via environment variable. +} +\examples{ +\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +connect_auth_headers() + +board <- board_connect_url(c( + my_vanity_url_pin = "https://colorado.posit.co/rsc/great-numbers/" +)) + +board \%>\% pin_read("my_vanity_url_pin") +\dontshow{\}) # examplesIf} +} +\seealso{ +Other boards: +\code{\link{board_connect}()}, +\code{\link{board_folder}()}, +\code{\link{board_url}()} +} +\concept{boards} diff --git a/man/board_folder.Rd b/man/board_folder.Rd index f556eafe..f6d29dfc 100644 --- a/man/board_folder.Rd +++ b/man/board_folder.Rd @@ -37,6 +37,7 @@ board <- board_temp() } \seealso{ Other boards: +\code{\link{board_connect_url}()}, \code{\link{board_connect}()}, \code{\link{board_url}()} } diff --git a/man/board_url.Rd b/man/board_url.Rd index c43ecf9d..3e9e97cb 100644 --- a/man/board_url.Rd +++ b/man/board_url.Rd @@ -4,7 +4,12 @@ \alias{board_url} \title{Use a vector of URLs as a board} \usage{ -board_url(urls, cache = NULL, use_cache_on_failure = is_interactive()) +board_url( + urls, + cache = NULL, + use_cache_on_failure = is_interactive(), + headers = NULL +) } \arguments{ \item{urls}{Identify available pins being served at a URL or set of URLs (see details): @@ -22,6 +27,9 @@ cache location for your operating system, but you can override if needed.} use the last cached version? Defaults to \code{is_interactive()} so you'll be robust to poor internet connectivity when exploring interactively, but you'll get clear errors when the code is deployed.} + +\item{headers}{Named character vector for additional HTTP headers (such as for +authentication). See \code{\link[=connect_auth_headers]{connect_auth_headers()}} for Posit Connect support.} } \description{ \code{board_url()} lets you build up a board from individual urls or a \link[=write_board_manifest]{manifest file}. @@ -56,9 +64,25 @@ download fails, you'll get the previously cached result with a warning. Using a \link[=write_board_manifest]{manifest file} can be useful because you can serve a board of pins and allow collaborators to access the board straight from a URL, without worrying about board-level storage details. - Some examples are provided in \code{vignette("using-board-url")}. } +\section{Authentication for \code{board_url()}}{ +The \code{headers} argument allows you to pass authentication details or other +HTTP headers to the board, such as for a Posit Connect vanity URL that is +not public (see \code{\link[=board_connect_url]{board_connect_url()}}) or a private GitHub repo. + +\if{html}{\out{
}}\preformatted{gh_pat_auth <- c( + Authorization = paste("token", "github_pat_XXXX") +) +board <- board_url( + "https://raw.githubusercontent.com/username/repo/main/path/to/pins", + headers = gh_pat_auth +) + +board \%>\% pin_list() +}\if{html}{\out{
}} +} + \examples{ github_raw <- function(x) paste0("https://raw.githubusercontent.com/", x) @@ -83,6 +107,7 @@ b2 \%>\% pin_versions("y") } \seealso{ Other boards: +\code{\link{board_connect_url}()}, \code{\link{board_connect}()}, \code{\link{board_folder}()} } diff --git a/tests/testthat/_snaps/board_connect_url.md b/tests/testthat/_snaps/board_connect_url.md new file mode 100644 index 00000000..79ffb757 --- /dev/null +++ b/tests/testthat/_snaps/board_connect_url.md @@ -0,0 +1,23 @@ +# useful errors for unsupported methods + + Code + board %>% pin_write(1:5, "x") + Condition + Error in `pin_store()`: + ! `board_url()` is read only + Code + board %>% pin_delete("x") + Condition + Error in `pin_delete()`: + ! `board_url()` is read only + Code + board %>% pin_versions("x") + Condition + Error in `pin_versions_modern()`: + ! This `board_url()` is not versioned + Code + board %>% pin_version_delete("x") + Condition + Error in `pin_version_delete()`: + ! `board_url()` is read only + diff --git a/tests/testthat/_snaps/board_url.md b/tests/testthat/_snaps/board_url.md index a876216e..735df98f 100644 --- a/tests/testthat/_snaps/board_url.md +++ b/tests/testthat/_snaps/board_url.md @@ -78,4 +78,14 @@ * an unnamed character scalar, i.e. a single URL * a named character vector * a named list, where all elements are character scalars or vectors + Code + board_url(c(x = "foo"), headers = list(auth = "x")) + Condition + Error in `board_url()`: + ! `headers` must be a named character vector or `NULL`, not a list. + Code + board_url(c(x = "foo"), headers = "my_api_key") + Condition + Error in `board_url()`: + ! `headers` must be a named character vector or `NULL`, not the string "my_api_key". diff --git a/tests/testthat/test-board_connect_url.R b/tests/testthat/test-board_connect_url.R new file mode 100644 index 00000000..1f37502d --- /dev/null +++ b/tests/testthat/test-board_connect_url.R @@ -0,0 +1,42 @@ +skip_if_not_installed("rsconnect") + +test_that("provides key methods", { + vanity_url <- vanity_url_test() + board <- board_connect_url_test(c(x = vanity_url)) + + board %>% + pin_list() %>% + expect_equal("x") + + board %>% + pin_read("x") %>% + expect_equal(1:10) + + expect_s3_class( + board %>% pin_meta("x"), + "pins_meta" + ) +}) + +test_that("absent pins handled consistently", { + vanity_url <- vanity_url_test() + board <- board_connect_url_test(c(x = vanity_url)) + + expect_equal(pin_list(board), "x") + expect_equal(pin_exists(board, "x"), TRUE) + expect_equal(pin_exists(board, "y"), FALSE) + + expect_error(pin_meta(board, "y"), class = "pins_pin_missing") +}) + +test_that("useful errors for unsupported methods", { + vanity_url <- vanity_url_test() + board <- board_connect_url_test(c(x = vanity_url)) + + expect_snapshot(error = TRUE, { + board %>% pin_write(1:5, "x") + board %>% pin_delete("x") + board %>% pin_versions("x") + board %>% pin_version_delete("x") + }) +}) diff --git a/tests/testthat/test-board_url.R b/tests/testthat/test-board_url.R index 98a77cf4..a52f1892 100644 --- a/tests/testthat/test-board_url.R +++ b/tests/testthat/test-board_url.R @@ -165,6 +165,8 @@ test_that("useful errors for specifying board", { board_url(c("foo", "bar")) board_url(list("a", 1:2)) board_url(1:10) + board_url(c("x" = "foo"), headers = list(auth = "x")) + board_url(c("x" = "foo"), headers = "my_api_key") }) }) @@ -176,7 +178,7 @@ test_that("use cache with Last-Modified header", { url <- "https://httpbin.org/cache" expect_condition( - http_download(url, path, "test"), + http_download(url, path, "test", header = c(x = "potato")), class = "pins_cache_downloaded" )