From 9cf74ba5054952f9639a54c6283dfad366e21d9c Mon Sep 17 00:00:00 2001 From: Julia Silge Date: Mon, 19 Dec 2022 17:59:10 -0700 Subject: [PATCH 01/10] First stab at GCS board --- R/board_gcs.R | 273 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 273 insertions(+) create mode 100644 R/board_gcs.R diff --git a/R/board_gcs.R b/R/board_gcs.R new file mode 100644 index 00000000..cb7025d5 --- /dev/null +++ b/R/board_gcs.R @@ -0,0 +1,273 @@ +#' Use a Google Cloud Storage bucket as a board +#' +#' Pin data to a Google Cloud Storage bucket using the googleCloudStorageR +#' package. +#' +#' # Authentication +#' +#' `board_gcs()` is powered by the googleCloudStorageR package which provides +#' several authentication options, as documented in its +#' [main vignette](https://code.markedmondson.me/googleCloudStorageR/articles/googleCloudStorageR.html). +#' Of these options, we recommend you use +#' [token authentication](https://code.markedmondson.me/googleCloudStorageR/articles/googleCloudStorageR.html#token-authentication) +#' via the [gargle](https://gargle.r-lib.org/) package. +#' +#' # Details +#' +#' * The functions in pins do not create a new bucket. You can create +#' a new bucket from R with [googleCloudStorageR::gcs_create_bucket()]. +#' * You can pass arguments for [googleCloudStorageR::gcs_upload] such as +#' `predefinedAcl` and `upload_type` through the dots of `pin_write()`. +#' * `board_gcs()` is powered by the googleCloudStorageR package, which is a +#' suggested dependency of pins (not required for pins in general). If +#' you run into errors when deploying content to a server like +#' or [Connect](https://posit.co/products/enterprise/connect/), +#' add `library(googleCloudStorageR)` to your app or document for [automatic +#' dependency discovery](https://support.posit.co/hc/en-us/articles/229998627-Why-does-my-app-work-locally-but-not-on-my-RStudio-Connect-server). +#' +#' @inheritParams new_board +#' @param bucket Bucket name. You can only write to an existing bucket. Defaults +#' to [googleCloudStorageR::gcs_get_global_bucket()]. +#' @param prefix Prefix within this bucket that this board will occupy. +#' You can use this to maintain multiple independent pin boards within +#' a single GCS bucket. Will typically end with `/` to take advantage of +#' Google Cloud Storage's directory-like handling. +#' @export +#' @examples +#' \dontrun{ +#' board <- board_gcs() +#' board %>% pin_write(mtcars) +#' board %>% pin_read("mtcars") +#' +#' # A prefix allows you to have multiple independent boards in the same pin. +#' board_sales <- board_gcs("company-pins", prefix = "sales/") +#' board_marketing <- board_gcs("company-pins", prefix = "marketing/") +#' # You can make the hierarchy arbitrarily deep. +#' +#' # Pass arguments like `predefinedAcl` through the dots of `pin_write`: +#' board %>% pin_write(mtcars, predefinedAcl = "publicRead") +#' +#' } +board_gcs <- function(bucket = googleCloudStorageR::gcs_get_global_bucket(), + prefix = NULL, + versioned = TRUE, + cache = NULL) { + + check_installed("googleCloudStorageR") + + # Check that have access to the bucket + invisible(googleCloudStorageR::gcs_get_bucket(bucket)) + + cache <- cache %||% board_cache_path(paste0("gcs-", bucket)) + new_board_v1("pins_board_gcs", + name = "gcs", + bucket = bucket, + prefix = prefix, + cache = cache, + versioned = versioned + ) +} + +board_gcs_test <- function(...) { + + skip_if_missing_envvars( + tests = "board_gcs()", + envvars = c("PINS_GCS_PASSWORD") + ) + + rlang::check_installed("sodium") + path_to_encrypted_json <- fs::path_package("pins", "secret", "pins-gcs-testing.json") + raw <- readBin(path_to_encrypted_json, "raw", file.size(path_to_encrypted_json)) + pw <- Sys.getenv("PINS_GCS_PASSWORD", "") + json <- sodium::data_decrypt( + bin = raw, + key = sodium::sha256(charToRaw(pw)), + nonce = secret_nonce() + ) + googleCloudStorageR::gcs_auth(json_file = rawToChar(json)) + + board_gcs("pins-dev", + cache = tempfile(), + ... + ) +} + +#' @export +pin_list.pins_board_gcs <- function(board, ...) { + NA +} + +#' @export +pin_exists.pins_board_gcs <- function(board, name, ...) { + gcs_file_exists(board, name) +} + +#' @export +pin_delete.pins_board_gcs <- function(board, names, ...) { + for (name in names) { + check_pin_exists(board, name) + gcs_delete_dir(board, name) + } + invisible(board) +} + +#' @export +pin_versions.pins_board_gcs <- function(board, name, ...) { + check_pin_exists(board, name) + resp <- googleCloudStorageR::gcs_list_objects( + bucket = board$bucket, + prefix = paste0(board$prefix, name) + ) + paths <- fs::path_split(unique(fs::path_dir(resp$name))) + version_from_path(map_chr(paths, ~ .x[[length(.x)]])) +} + +#' @export +pin_version_delete.pins_board_gcs <- function(board, name, version, ...) { + gcs_delete_dir(board, fs::path(name, version)) +} + +#' @export +pin_meta.pins_board_gcs <- function(board, name, version = NULL, ...) { + check_pin_exists(board, name) + version <- check_pin_version(board, name, version) + metadata_blob <- fs::path(name, version, "data.txt") + + if (!gcs_file_exists(board, metadata_blob)) { + abort_pin_version_missing(version) + } + + path_version <- fs::path(board$cache, name, version) + fs::dir_create(path_version) + gcs_download(board, metadata_blob) + local_meta( + read_meta(fs::path(board$cache, name, version)), + name = name, + dir = path_version, + version = version + ) +} + +#' @export +pin_fetch.pins_board_gcs <- function(board, name, version = NULL, ...) { + meta <- pin_meta(board, name, version = version) + cache_touch(board, meta) + + for (file in meta$file) { + key <- fs::path(name, meta$local$version, file) + gcs_download(board, key) + } + + meta +} + +#' @export +pin_store.pins_board_gcs <- function(board, name, paths, metadata, + versioned = NULL, x = NULL, ...) { + ellipsis::check_dots_used() + check_name(name) + version <- version_setup(board, name, version_name(metadata), versioned = versioned) + version_dir <- fs::path(name, version) + gcs_upload_yaml( + board, + fs::path(paste0(board$prefix, version_dir), "data.txt"), + metadata + ) + + for (path in paths) { + googleCloudStorageR::gcs_upload( + file = path, + bucket = board$bucket, + name = fs::path(paste0(board$prefix, version_dir), fs::path_file(path)), + ... + ) + } + + name +} + +#' @rdname board_deparse +#' @export +board_deparse.pins_board_gcs <- function(board, ...) { + bucket <- check_board_deparse(board, "bucket") + expr(board_gcs(!!bucket, prefix = !!board$prefix)) +} + + +#' @export +write_board_manifest_yaml.pins_board_gcs <- function(board, manifest, ...) { + paths <- googleCloudStorageR::gcs_list_objects(bucket = board$bucket)$name + if (manifest_pin_yaml_filename %in% paths) { + googleCloudStorageR::gcs_delete_object( + manifest_pin_yaml_filename, + board$bucket + ) + } + gcs_upload_yaml(board, manifest_pin_yaml_filename, manifest) +} + +#' @rdname required_pkgs.pins_board +#' @export +required_pkgs.pins_board_gcs <- function(x, ...) { + ellipsis::check_dots_empty() + "googleCloudStorageR" +} + +# Helpers ----------------------------------------------------------------- + +gcs_delete_dir <- function(board, dir) { + resp <- googleCloudStorageR::gcs_list_objects( + bucket = board$bucket, + prefix = paste0(board$prefix, dir, "/") + ) + + if (nrow(resp) == 0) { + return(invisible()) + } + + for (path in resp$name) { + googleCloudStorageR::gcs_delete_object(path, bucket = board$bucket) + } + + invisible() +} + +gcs_upload_yaml <- function(board, key, yaml, ...) { + temp_file <- withr::local_tempfile() + yaml::write_yaml(yaml, file = temp_file) + googleCloudStorageR::gcs_upload( + file = temp_file, + bucket = board$bucket, + type = "text/yaml", + name = key, + ... + ) +} + +gcs_download <- function(board, key) { + path <- fs::path(board$cache, key) + if (!fs::file_exists(path)) { + googleCloudStorageR::gcs_get_object( + object_name = paste0(board$prefix, key), + bucket = board$bucket, + saveToDisk = path + ) + fs::file_chmod(path, "u=r") + } + path +} + +gcs_file_exists <- function(board, name) { + resp <- googleCloudStorageR::gcs_list_objects( + bucket = board$bucket, + prefix = paste0(board$prefix, name) + ) + nrow(resp) > 0 +} + +## for decrypting JSON for service account: +secret_nonce <- function() { + sodium::hex2bin("cb36bab652dec6ae9b1827c684a7b6d21d2ea31cd9f766ac") +} + + From a87bd7d656d072cba3993ddcb4c5b4c645b47697 Mon Sep 17 00:00:00 2001 From: Julia Silge Date: Mon, 19 Dec 2022 18:00:10 -0700 Subject: [PATCH 02/10] Document, update DESCRIPTION + pkgdown --- DESCRIPTION | 2 + NAMESPACE | 12 ++++++ _pkgdown.yml | 3 +- man/board_deparse.Rd | 5 ++- man/board_gcs.Rd | 71 +++++++++++++++++++++++++++++++++ man/required_pkgs.pins_board.Rd | 5 ++- 6 files changed, 95 insertions(+), 3 deletions(-) create mode 100644 man/board_gcs.Rd diff --git a/DESCRIPTION b/DESCRIPTION index d8bef2ff..bad8ac8a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -48,6 +48,7 @@ Suggests: data.table, datasets, gitcreds, + googleCloudStorageR, knitr, Microsoft365R, mockery, @@ -57,6 +58,7 @@ Suggests: rmarkdown, rsconnect, shiny, + sodium, testthat (>= 3.0.0), webfakes, xml2 diff --git a/NAMESPACE b/NAMESPACE index bb0d428c..2bc0bb55 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,6 +10,7 @@ S3method(board_deparse,pins_board) S3method(board_deparse,pins_board_azure) S3method(board_deparse,pins_board_connect) S3method(board_deparse,pins_board_folder) +S3method(board_deparse,pins_board_gcs) S3method(board_deparse,pins_board_kaggle_competition) S3method(board_deparse,pins_board_kaggle_dataset) S3method(board_deparse,pins_board_s3) @@ -54,6 +55,7 @@ S3method(pin,default) S3method(pin_delete,pins_board_azure) S3method(pin_delete,pins_board_connect) S3method(pin_delete,pins_board_folder) +S3method(pin_delete,pins_board_gcs) S3method(pin_delete,pins_board_kaggle_competition) S3method(pin_delete,pins_board_kaggle_dataset) S3method(pin_delete,pins_board_ms365) @@ -62,6 +64,7 @@ S3method(pin_delete,pins_board_url) S3method(pin_exists,pins_board_azure) S3method(pin_exists,pins_board_connect) S3method(pin_exists,pins_board_folder) +S3method(pin_exists,pins_board_gcs) S3method(pin_exists,pins_board_kaggle_competition) S3method(pin_exists,pins_board_kaggle_dataset) S3method(pin_exists,pins_board_ms365) @@ -70,6 +73,7 @@ S3method(pin_exists,pins_board_url) S3method(pin_fetch,pins_board_azure) S3method(pin_fetch,pins_board_connect) S3method(pin_fetch,pins_board_folder) +S3method(pin_fetch,pins_board_gcs) S3method(pin_fetch,pins_board_kaggle_competition) S3method(pin_fetch,pins_board_kaggle_dataset) S3method(pin_fetch,pins_board_ms365) @@ -78,6 +82,7 @@ S3method(pin_fetch,pins_board_url) S3method(pin_list,pins_board_azure) S3method(pin_list,pins_board_connect) S3method(pin_list,pins_board_folder) +S3method(pin_list,pins_board_gcs) S3method(pin_list,pins_board_kaggle_competition) S3method(pin_list,pins_board_kaggle_dataset) S3method(pin_list,pins_board_local) @@ -91,6 +96,7 @@ S3method(pin_load,table) S3method(pin_meta,pins_board_azure) S3method(pin_meta,pins_board_connect) S3method(pin_meta,pins_board_folder) +S3method(pin_meta,pins_board_gcs) S3method(pin_meta,pins_board_kaggle_competition) S3method(pin_meta,pins_board_kaggle_dataset) S3method(pin_meta,pins_board_ms365) @@ -103,6 +109,7 @@ S3method(pin_search,pins_board_kaggle_dataset) S3method(pin_store,pins_board_azure) S3method(pin_store,pins_board_connect) S3method(pin_store,pins_board_folder) +S3method(pin_store,pins_board_gcs) S3method(pin_store,pins_board_kaggle_competition) S3method(pin_store,pins_board_kaggle_dataset) S3method(pin_store,pins_board_ms365) @@ -112,6 +119,7 @@ S3method(pin_version_delete,pins_board) S3method(pin_version_delete,pins_board_azure) S3method(pin_version_delete,pins_board_connect) S3method(pin_version_delete,pins_board_folder) +S3method(pin_version_delete,pins_board_gcs) S3method(pin_version_delete,pins_board_ms365) S3method(pin_version_delete,pins_board_s3) S3method(pin_version_delete,pins_board_url) @@ -119,6 +127,7 @@ S3method(pin_versions,pins_board) S3method(pin_versions,pins_board_azure) S3method(pin_versions,pins_board_connect) S3method(pin_versions,pins_board_folder) +S3method(pin_versions,pins_board_gcs) S3method(pin_versions,pins_board_kaggle_dataset) S3method(pin_versions,pins_board_ms365) S3method(pin_versions,pins_board_s3) @@ -130,12 +139,14 @@ S3method(print,pins_meta) S3method(required_pkgs,pins_board) S3method(required_pkgs,pins_board_azure) S3method(required_pkgs,pins_board_connect) +S3method(required_pkgs,pins_board_gcs) S3method(required_pkgs,pins_board_ms365) S3method(required_pkgs,pins_board_s3) S3method(str,pins_hidden) S3method(write_board_manifest_yaml,default) S3method(write_board_manifest_yaml,pins_board_azure) S3method(write_board_manifest_yaml,pins_board_folder) +S3method(write_board_manifest_yaml,pins_board_gcs) S3method(write_board_manifest_yaml,pins_board_ms365) S3method(write_board_manifest_yaml,pins_board_s3) S3method(write_board_manifest_yaml,pins_board_url) @@ -149,6 +160,7 @@ export(board_deparse) export(board_deregister) export(board_desc) export(board_folder) +export(board_gcs) export(board_get) export(board_initialize) export(board_kaggle_competitions) diff --git a/_pkgdown.yml b/_pkgdown.yml index 050c99c7..55ec55f5 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -26,8 +26,9 @@ reference: share data in a variety of ways. contents: - board_azure - - board_local + - board_gcs - board_kaggle_dataset + - board_local - board_ms365 - board_connect - board_s3 diff --git a/man/board_deparse.Rd b/man/board_deparse.Rd index 0faeeca4..4d4de2ab 100644 --- a/man/board_deparse.Rd +++ b/man/board_deparse.Rd @@ -1,11 +1,12 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/board.R, R/board_azure.R, R/board_connect.R, -% R/board_folder.R, R/board_kaggle.R, R/board_s3.R +% R/board_folder.R, R/board_gcs.R, R/board_kaggle.R, R/board_s3.R \name{board_deparse} \alias{board_deparse} \alias{board_deparse.pins_board_azure} \alias{board_deparse.pins_board_connect} \alias{board_deparse.pins_board_folder} +\alias{board_deparse.pins_board_gcs} \alias{board_deparse.pins_board_kaggle_competition} \alias{board_deparse.pins_board_kaggle_dataset} \alias{board_deparse.pins_board_s3} @@ -19,6 +20,8 @@ board_deparse(board, ...) \method{board_deparse}{pins_board_folder}(board, ...) +\method{board_deparse}{pins_board_gcs}(board, ...) + \method{board_deparse}{pins_board_kaggle_competition}(board, ...) \method{board_deparse}{pins_board_kaggle_dataset}(board, ...) diff --git a/man/board_gcs.Rd b/man/board_gcs.Rd new file mode 100644 index 00000000..1cc0ff5f --- /dev/null +++ b/man/board_gcs.Rd @@ -0,0 +1,71 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/board_gcs.R +\name{board_gcs} +\alias{board_gcs} +\title{Use a Google Cloud Storage bucket as a board} +\usage{ +board_gcs( + bucket = googleCloudStorageR::gcs_get_global_bucket(), + prefix = NULL, + versioned = TRUE, + cache = NULL +) +} +\arguments{ +\item{bucket}{Bucket name. You can only write to an existing bucket. Defaults +to \code{\link[googleCloudStorageR:gcs_get_global_bucket]{googleCloudStorageR::gcs_get_global_bucket()}}.} + +\item{prefix}{Prefix within this bucket that this board will occupy. +You can use this to maintain multiple independent pin boards within +a single GCS bucket. Will typically end with \code{/} to take advantage of +Google Cloud Storage's directory-like handling.} + +\item{versioned}{Should this board be registered with support for versions?} + +\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.} +} +\description{ +Pin data to a Google Cloud Storage bucket using the googleCloudStorageR +package. +} +\section{Authentication}{ +\code{board_gcs()} is powered by the googleCloudStorageR package which provides +several authentication options, as documented in its +\href{https://code.markedmondson.me/googleCloudStorageR/articles/googleCloudStorageR.html}{main vignette}. +Of these options, we recommend you use +\href{https://code.markedmondson.me/googleCloudStorageR/articles/googleCloudStorageR.html#token-authentication}{token authentication} +via the \href{https://gargle.r-lib.org/}{gargle} package. +} + +\section{Details}{ +\itemize{ +\item The functions in pins do not create a new bucket. You can create +a new bucket from R with \code{\link[googleCloudStorageR:gcs_create_bucket]{googleCloudStorageR::gcs_create_bucket()}}. +\item You can pass arguments for \link[googleCloudStorageR:gcs_upload]{googleCloudStorageR::gcs_upload} such as +\code{predefinedAcl} and \code{upload_type} through the dots of \code{pin_write()}. +\item \code{board_gcs()} is powered by the googleCloudStorageR package, which is a +suggested dependency of pins (not required for pins in general). If +you run into errors when deploying content to a server like +\url{https://shinyapps.io} or \href{https://posit.co/products/enterprise/connect/}{Connect}, +add \code{library(googleCloudStorageR)} to your app or document for \href{https://support.posit.co/hc/en-us/articles/229998627-Why-does-my-app-work-locally-but-not-on-my-RStudio-Connect-server}{automatic dependency discovery}. +} +} + +\examples{ +\dontrun{ +board <- board_gcs() +board \%>\% pin_write(mtcars) +board \%>\% pin_read("mtcars") + +# A prefix allows you to have multiple independent boards in the same pin. +board_sales <- board_gcs("company-pins", prefix = "sales/") +board_marketing <- board_gcs("company-pins", prefix = "marketing/") +# You can make the hierarchy arbitrarily deep. + +# Pass arguments like `predefinedAcl` through the dots of `pin_write`: +board \%>\% pin_write(mtcars, predefinedAcl = "publicRead") + +} +} diff --git a/man/required_pkgs.pins_board.Rd b/man/required_pkgs.pins_board.Rd index bcf112ca..d4202c77 100644 --- a/man/required_pkgs.pins_board.Rd +++ b/man/required_pkgs.pins_board.Rd @@ -1,9 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/board_azure.R, R/board_connect.R, -% R/board_ms365.R, R/board_s3.R, R/required_pkgs.R +% R/board_gcs.R, R/board_ms365.R, R/board_s3.R, R/required_pkgs.R \name{required_pkgs.pins_board_azure} \alias{required_pkgs.pins_board_azure} \alias{required_pkgs.pins_board_connect} +\alias{required_pkgs.pins_board_gcs} \alias{required_pkgs.pins_board_ms365} \alias{required_pkgs.pins_board_s3} \alias{required_pkgs.pins_board} @@ -13,6 +14,8 @@ \method{required_pkgs}{pins_board_connect}(x, ...) +\method{required_pkgs}{pins_board_gcs}(x, ...) + \method{required_pkgs}{pins_board_ms365}(x, ...) \method{required_pkgs}{pins_board_s3}(x, ...) From f8fe5ba83ecaf615e7700c5c059e96661fe747b6 Mon Sep 17 00:00:00 2001 From: Julia Silge Date: Mon, 19 Dec 2022 18:00:55 -0700 Subject: [PATCH 03/10] Tests, plus encrypted service account keys JSON --- .github/workflows/check-boards.yaml | 1 + inst/secret/pins-gcs-testing.json | Bin 0 -> 2323 bytes tests/testthat/_snaps/board_gcs.md | 22 ++++++++++++++++++++++ tests/testthat/test-board_gcs.R | 11 +++++++++++ 4 files changed, 34 insertions(+) create mode 100644 inst/secret/pins-gcs-testing.json create mode 100644 tests/testthat/_snaps/board_gcs.md create mode 100644 tests/testthat/test-board_gcs.R diff --git a/.github/workflows/check-boards.yaml b/.github/workflows/check-boards.yaml index 129f782a..3dbd0010 100644 --- a/.github/workflows/check-boards.yaml +++ b/.github/workflows/check-boards.yaml @@ -21,6 +21,7 @@ jobs: PINS_AZURE_ACCOUNT: ${{ secrets.PINS_AZURE_ACCOUNT }} PINS_AWS_ACCESS_KEY: ${{ secrets.PINS_AWS_ACCESS_KEY}} PINS_AWS_SECRET_ACCESS_KEY: ${{ secrets.PINS_AWS_SECRET_ACCESS_KEY}} + PINS_GCS_PASSWORD: ${{ secrets.PINS_GCS_PASSWORD }} PINS_KAGGLE_USERNAME: ${{ secrets.PINS_KAGGLE_USERNAME }} PINS_KAGGLE_KEY: ${{ secrets.PINS_KAGGLE_KEY }} diff --git a/inst/secret/pins-gcs-testing.json b/inst/secret/pins-gcs-testing.json new file mode 100644 index 0000000000000000000000000000000000000000..0afab6a6bde0ed47083bac6dc54b037fc36dc244 GIT binary patch literal 2323 zcmV+u3GDU>1ta@0`a(kpzAiq^iql9i@rgm*1eL9BbL@aSk#D@y$)x}z4jggY)9nR~ zzTT2u{ej%j;YxkeQ2%hbB)MH?VezGn(#Pj!5!x+kD8FBgG{dbRawj{OSMD;VlG4Pl zMlrES-*cxM{+*K#UhK1f1*BDt`*F_G0B7x-qgaT4+mm19unA-T4Ef^^I=7AGJ4N8R zhDxVwIKrUWRZH=ZD}D$Fe-wrv@`5AOJiy#y^up?Yp>htXfR9!??>@z*8P?Wy;^`oq zg8W()SN0lklgpw{%xhqo*dOwQG;(TuAsv2e33Sa_$(VqM6zY-;E$GRB7`ZwPH)FNZ zX3ZE8el*u>mZX(C7nX|O^>UX$BD~W|NF@o(!ssmjuF|7o2~Xsw;s|tm5Z(Yprd(@N z*gE=!-c2A2^0wWgFMv7rgi?c3#!_q#Q4W9dY<(OEP4`sf5GBCe8$g%j9*mA8MS#Zx z?kc{+Y#{WCITKo0Ce#-aeRmuE!ST5Q6{#ENB%6KLV2y~Mj-0`nhHAG^cu4kcF%frx zyqyPv>1lX25d*Y_;%WHIj2s!>ppxvWJa>JMOJf}CT20Dm>fsrAQ~c56GSw0}9S3HfixYf+ z<|z67{vUJmb@1bmU?rT@cw()zV8|Tm2C^l`vBouxs^VOcrxUTz`nPywCoLd6e9!ez zu7%J2Hh14Au{^GUwaxN=5D+ox({IE7UD-1b5R>GUmD_Ndva4xnmB`{2_tpWZQDyA7 zerI*d?4VVk_tTYd@Lbo#^y>=#VVXFi&7W_Kt&}=jw<3ajfztvi&BeSOQiggO_^Du2 zO{D>#!;H&h=l>I|GZkanU%qPvkPqCSv>NYL#2Sfp@z8ihJx5VQrMFKJe(3Lwyp(eo z0cGxlIivYU{UqS<0wiNj_EoQ*@)z+D!BfkOr|}ht$!?{nO8w;T(E!CqI@E;N4=un8 zsIFr4v+0kAx?ZP$6M}L%Tok{WYe3b9M-ZUnNmYyGlbhDLuuakp9L`y~H|!?j%=|U< z^SKjE&?^R|^A3D~H}|1k34?m%yaS7PEOn6^%198c^mKD_i4qILp-M9+P?F z5OPof$d*ll(~euEa1?dYHP_Uh12YfPj|TD$WPClQ|$GUR%W(i?k? z{DeCVjX>rWd|qTek#z|!@NA==%?hVdS__OogI-6ly)!1dcwb3_4m=#uz4w57GwH%8 zQg*Z`KoU!OZrgt7`Z6o%QcA!s#VGc>{=)a=`nl8y(U~!j?78)@G^CRnF!2naJ6Z+noag36bJFTm7tQU~Hu; zGjD!+H*r>!_=(N?5Th+BcP|>42rw2JNGOl$W37i>VVwTZoO^mlEv(&v$Ro3>{8Nu~ zq_(AQJ<;RcC?=RDWwkOkaIVTlz>HHc(fDP-)7B>nJ{}DOI8$lh;>npYk2ok}!E2J~ zGsm&bGNfHdhNI3VE`Gg59g4TxG9@JyA5~V+mRp?7$$jg_&x{$98?#V#lZ0mum1n2x z@0Pz($)fW+)D%lNZCMP0sR+IK?W6p_#X46qo4bQakrtXM@}f0}#IQ+McJgBWLdozeCNNdhP=kALzH|{&X-$Fj8YHo)uq#(Es~ZQoOI}O|@j@N@=j153 z_d?ouj#zY!orP)}4;{6G_?&Z8prR)>eDM*lEK9dz+;(sX_JEatT?Mlhy0 zyHcvP&eKV(;jYsVBQx%Et?l|`+GHjy#RK%T^9mxaY?0Pl&Ol?<08 z2WiSjH^)E})(-`mOB+;Rdv-IvbbKm~P z;*40t4Okjp3@5j=kIKLcrNP2?J+#KFy{PQr@eKaG+y^e!30m` z1tAX&5jdupf+!szNS|UT*QB*Va$T*?CnnV9wG3cM4DAALWa>qbfRPtNF18%CH0m$j za*HD!`um2At(8Xj)U$ShA6fj7(DipH>c@> t%S=xy)qTR(owFEQgwLvbIGXnLlSnb|r}N0FxPEl>GR%n Date: Tue, 20 Dec 2022 14:49:45 -0700 Subject: [PATCH 04/10] Ignore my JSON file --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index c01952c3..a162e530 100644 --- a/.gitignore +++ b/.gitignore @@ -8,3 +8,4 @@ packages docs inst/doc .Renviron +google-pins.json From 835952ef5adbc375c6f3e1895784be9a0627f8f7 Mon Sep 17 00:00:00 2001 From: Julia Silge Date: Tue, 20 Dec 2022 14:50:25 -0700 Subject: [PATCH 05/10] No manifest for GCS board, try to turn off noisy messages --- NAMESPACE | 1 - R/board_gcs.R | 21 ++++++--------------- tests/testthat/_snaps/board_gcs.md | 7 +++++++ tests/testthat/test-board_gcs.R | 2 -- 4 files changed, 13 insertions(+), 18 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 2bc0bb55..fd2bf0a2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -146,7 +146,6 @@ S3method(str,pins_hidden) S3method(write_board_manifest_yaml,default) S3method(write_board_manifest_yaml,pins_board_azure) S3method(write_board_manifest_yaml,pins_board_folder) -S3method(write_board_manifest_yaml,pins_board_gcs) S3method(write_board_manifest_yaml,pins_board_ms365) S3method(write_board_manifest_yaml,pins_board_s3) S3method(write_board_manifest_yaml,pins_board_url) diff --git a/R/board_gcs.R b/R/board_gcs.R index cb7025d5..59ee0752 100644 --- a/R/board_gcs.R +++ b/R/board_gcs.R @@ -99,6 +99,7 @@ pin_list.pins_board_gcs <- function(board, ...) { #' @export pin_exists.pins_board_gcs <- function(board, name, ...) { + withr::local_options(list(googleAuthR.verbose = 4)) gcs_file_exists(board, name) } @@ -129,6 +130,7 @@ pin_version_delete.pins_board_gcs <- function(board, name, version, ...) { #' @export pin_meta.pins_board_gcs <- function(board, name, version = NULL, ...) { + withr::local_options(list(googleAuthR.verbose = 4)) check_pin_exists(board, name) version <- check_pin_version(board, name, version) metadata_blob <- fs::path(name, version, "data.txt") @@ -150,6 +152,7 @@ pin_meta.pins_board_gcs <- function(board, name, version = NULL, ...) { #' @export pin_fetch.pins_board_gcs <- function(board, name, version = NULL, ...) { + withr::local_options(list(googleAuthR.verbose = 4)) meta <- pin_meta(board, name, version = version) cache_touch(board, meta) @@ -164,6 +167,7 @@ pin_fetch.pins_board_gcs <- function(board, name, version = NULL, ...) { #' @export pin_store.pins_board_gcs <- function(board, name, paths, metadata, versioned = NULL, x = NULL, ...) { + withr::local_options(list(googleAuthR.verbose = 4)) ellipsis::check_dots_used() check_name(name) version <- version_setup(board, name, version_name(metadata), versioned = versioned) @@ -193,19 +197,6 @@ board_deparse.pins_board_gcs <- function(board, ...) { expr(board_gcs(!!bucket, prefix = !!board$prefix)) } - -#' @export -write_board_manifest_yaml.pins_board_gcs <- function(board, manifest, ...) { - paths <- googleCloudStorageR::gcs_list_objects(bucket = board$bucket)$name - if (manifest_pin_yaml_filename %in% paths) { - googleCloudStorageR::gcs_delete_object( - manifest_pin_yaml_filename, - board$bucket - ) - } - gcs_upload_yaml(board, manifest_pin_yaml_filename, manifest) -} - #' @rdname required_pkgs.pins_board #' @export required_pkgs.pins_board_gcs <- function(x, ...) { @@ -247,11 +238,11 @@ gcs_upload_yaml <- function(board, key, yaml, ...) { gcs_download <- function(board, key) { path <- fs::path(board$cache, key) if (!fs::file_exists(path)) { - googleCloudStorageR::gcs_get_object( + suppressMessages(googleCloudStorageR::gcs_get_object( object_name = paste0(board$prefix, key), bucket = board$bucket, saveToDisk = path - ) + )) fs::file_chmod(path, "u=r") } path diff --git a/tests/testthat/_snaps/board_gcs.md b/tests/testthat/_snaps/board_gcs.md index 0a7f8f1d..397742ce 100644 --- a/tests/testthat/_snaps/board_gcs.md +++ b/tests/testthat/_snaps/board_gcs.md @@ -20,3 +20,10 @@ `metadata` must be a list. +# can deparse + + Code + board_deparse(board) + Output + board_gcs("pins-dev", prefix = NULL) + diff --git a/tests/testthat/test-board_gcs.R b/tests/testthat/test-board_gcs.R index 7c3ba09e..e87895b6 100644 --- a/tests/testthat/test-board_gcs.R +++ b/tests/testthat/test-board_gcs.R @@ -2,10 +2,8 @@ test_api_basic(board_gcs_test()) test_api_versioning(board_gcs_test()) test_api_meta(board_gcs_test()) test_api_basic(board_gcs_test(prefix = "prefixed/")) -test_api_manifest(board_gcs_test()) test_that("can deparse", { board <- board_gcs_test() expect_snapshot(board_deparse(board)) }) - From 6a509c48c38d8498514a01467cdaa20f0accb613 Mon Sep 17 00:00:00 2001 From: Julia Silge Date: Tue, 20 Dec 2022 15:32:46 -0700 Subject: [PATCH 06/10] Update NEWS and pkgdown --- NEWS.md | 2 ++ _pkgdown.yml | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index eedcf33f..2f1f89f3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -13,6 +13,8 @@ ## Other improvements +* Added new board for Google Cloud Storage `board_gcs()` (#695). + * Added vignette describing how to manage custom formats (#631, @ijlyttle). * Improved error message for `pin_versions()` (#657). diff --git a/_pkgdown.yml b/_pkgdown.yml index 55ec55f5..91b8e741 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -26,11 +26,11 @@ reference: share data in a variety of ways. contents: - board_azure + - board_connect - board_gcs - board_kaggle_dataset - board_local - board_ms365 - - board_connect - board_s3 - board_url From 76973ae94f5b069a1241ef818c6f1f0f073a1a83 Mon Sep 17 00:00:00 2001 From: Julia Silge Date: Tue, 20 Dec 2022 15:32:55 -0700 Subject: [PATCH 07/10] Update docs --- R/board_gcs.R | 6 ++---- man/board_gcs.Rd | 6 ++---- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/R/board_gcs.R b/R/board_gcs.R index 59ee0752..6c649bf9 100644 --- a/R/board_gcs.R +++ b/R/board_gcs.R @@ -8,9 +8,8 @@ #' `board_gcs()` is powered by the googleCloudStorageR package which provides #' several authentication options, as documented in its #' [main vignette](https://code.markedmondson.me/googleCloudStorageR/articles/googleCloudStorageR.html). -#' Of these options, we recommend you use -#' [token authentication](https://code.markedmondson.me/googleCloudStorageR/articles/googleCloudStorageR.html#token-authentication) -#' via the [gargle](https://gargle.r-lib.org/) package. +#' The two main options are to create a service account key (a JSON file) or an +#' authentication token; you can manage either using the [gargle](https://gargle.r-lib.org/) package. #' #' # Details #' @@ -46,7 +45,6 @@ #' #' # Pass arguments like `predefinedAcl` through the dots of `pin_write`: #' board %>% pin_write(mtcars, predefinedAcl = "publicRead") -#' #' } board_gcs <- function(bucket = googleCloudStorageR::gcs_get_global_bucket(), prefix = NULL, diff --git a/man/board_gcs.Rd b/man/board_gcs.Rd index 1cc0ff5f..c0979bd8 100644 --- a/man/board_gcs.Rd +++ b/man/board_gcs.Rd @@ -34,9 +34,8 @@ package. \code{board_gcs()} is powered by the googleCloudStorageR package which provides several authentication options, as documented in its \href{https://code.markedmondson.me/googleCloudStorageR/articles/googleCloudStorageR.html}{main vignette}. -Of these options, we recommend you use -\href{https://code.markedmondson.me/googleCloudStorageR/articles/googleCloudStorageR.html#token-authentication}{token authentication} -via the \href{https://gargle.r-lib.org/}{gargle} package. +The two main options are to create a service account key (a JSON file) or an +authentication token; you can manage either using the \href{https://gargle.r-lib.org/}{gargle} package. } \section{Details}{ @@ -66,6 +65,5 @@ board_marketing <- board_gcs("company-pins", prefix = "marketing/") # Pass arguments like `predefinedAcl` through the dots of `pin_write`: board \%>\% pin_write(mtcars, predefinedAcl = "publicRead") - } } From a919975ba98dc0ff71063c6826c2957062d182b8 Mon Sep 17 00:00:00 2001 From: Julia Silge Date: Thu, 12 Jan 2023 10:37:07 -0700 Subject: [PATCH 08/10] Apply suggestions from code review Co-authored-by: Hadley Wickham --- R/board_gcs.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/board_gcs.R b/R/board_gcs.R index 6c649bf9..98850b2f 100644 --- a/R/board_gcs.R +++ b/R/board_gcs.R @@ -21,7 +21,7 @@ #' suggested dependency of pins (not required for pins in general). If #' you run into errors when deploying content to a server like #' or [Connect](https://posit.co/products/enterprise/connect/), -#' add `library(googleCloudStorageR)` to your app or document for [automatic +#' add `requireNamespame(googleCloudStorageR)` to your app or document for [automatic #' dependency discovery](https://support.posit.co/hc/en-us/articles/229998627-Why-does-my-app-work-locally-but-not-on-my-RStudio-Connect-server). #' #' @inheritParams new_board @@ -54,7 +54,7 @@ board_gcs <- function(bucket = googleCloudStorageR::gcs_get_global_bucket(), check_installed("googleCloudStorageR") # Check that have access to the bucket - invisible(googleCloudStorageR::gcs_get_bucket(bucket)) + googleCloudStorageR::gcs_get_bucket(bucket) cache <- cache %||% board_cache_path(paste0("gcs-", bucket)) new_board_v1("pins_board_gcs", From 36773084f4c55d1bcf3e510cad8ccefecf31cdb2 Mon Sep 17 00:00:00 2001 From: Julia Silge Date: Thu, 12 Jan 2023 10:51:05 -0700 Subject: [PATCH 09/10] Apply suggestions from code review --- R/board_gcs.R | 31 +++++++++++++------------------ 1 file changed, 13 insertions(+), 18 deletions(-) diff --git a/R/board_gcs.R b/R/board_gcs.R index 98850b2f..7eafb189 100644 --- a/R/board_gcs.R +++ b/R/board_gcs.R @@ -57,12 +57,13 @@ board_gcs <- function(bucket = googleCloudStorageR::gcs_get_global_bucket(), googleCloudStorageR::gcs_get_bucket(bucket) cache <- cache %||% board_cache_path(paste0("gcs-", bucket)) - new_board_v1("pins_board_gcs", - name = "gcs", - bucket = bucket, - prefix = prefix, - cache = cache, - versioned = versioned + new_board_v1( + "pins_board_gcs", + name = "gcs", + bucket = bucket, + prefix = prefix, + cache = cache, + versioned = versioned ) } @@ -73,7 +74,6 @@ board_gcs_test <- function(...) { envvars = c("PINS_GCS_PASSWORD") ) - rlang::check_installed("sodium") path_to_encrypted_json <- fs::path_package("pins", "secret", "pins-gcs-testing.json") raw <- readBin(path_to_encrypted_json, "raw", file.size(path_to_encrypted_json)) pw <- Sys.getenv("PINS_GCS_PASSWORD", "") @@ -84,10 +84,12 @@ board_gcs_test <- function(...) { ) googleCloudStorageR::gcs_auth(json_file = rawToChar(json)) - board_gcs("pins-dev", - cache = tempfile(), - ... - ) + board_gcs("pins-dev", cache = tempfile(), ...) +} + +## for decrypting JSON for service account: +secret_nonce <- function() { + sodium::hex2bin("cb36bab652dec6ae9b1827c684a7b6d21d2ea31cd9f766ac") } #' @export @@ -253,10 +255,3 @@ gcs_file_exists <- function(board, name) { ) nrow(resp) > 0 } - -## for decrypting JSON for service account: -secret_nonce <- function() { - sodium::hex2bin("cb36bab652dec6ae9b1827c684a7b6d21d2ea31cd9f766ac") -} - - From a89c86523f95a58bce6c0bb1bf8b6254b0cbdcf2 Mon Sep 17 00:00:00 2001 From: Julia Silge Date: Fri, 13 Jan 2023 11:54:58 -0700 Subject: [PATCH 10/10] No more default bucket --- R/board_gcs.R | 6 +++--- man/board_gcs.Rd | 13 ++++--------- 2 files changed, 7 insertions(+), 12 deletions(-) diff --git a/R/board_gcs.R b/R/board_gcs.R index 7eafb189..a77193fd 100644 --- a/R/board_gcs.R +++ b/R/board_gcs.R @@ -25,8 +25,8 @@ #' dependency discovery](https://support.posit.co/hc/en-us/articles/229998627-Why-does-my-app-work-locally-but-not-on-my-RStudio-Connect-server). #' #' @inheritParams new_board -#' @param bucket Bucket name. You can only write to an existing bucket. Defaults -#' to [googleCloudStorageR::gcs_get_global_bucket()]. +#' @param bucket Bucket name. You can only write to an existing bucket, and you +#' can use [googleCloudStorageR::gcs_get_global_bucket()] here. #' @param prefix Prefix within this bucket that this board will occupy. #' You can use this to maintain multiple independent pin boards within #' a single GCS bucket. Will typically end with `/` to take advantage of @@ -46,7 +46,7 @@ #' # Pass arguments like `predefinedAcl` through the dots of `pin_write`: #' board %>% pin_write(mtcars, predefinedAcl = "publicRead") #' } -board_gcs <- function(bucket = googleCloudStorageR::gcs_get_global_bucket(), +board_gcs <- function(bucket, prefix = NULL, versioned = TRUE, cache = NULL) { diff --git a/man/board_gcs.Rd b/man/board_gcs.Rd index c0979bd8..78f4549a 100644 --- a/man/board_gcs.Rd +++ b/man/board_gcs.Rd @@ -4,16 +4,11 @@ \alias{board_gcs} \title{Use a Google Cloud Storage bucket as a board} \usage{ -board_gcs( - bucket = googleCloudStorageR::gcs_get_global_bucket(), - prefix = NULL, - versioned = TRUE, - cache = NULL -) +board_gcs(bucket, prefix = NULL, versioned = TRUE, cache = NULL) } \arguments{ -\item{bucket}{Bucket name. You can only write to an existing bucket. Defaults -to \code{\link[googleCloudStorageR:gcs_get_global_bucket]{googleCloudStorageR::gcs_get_global_bucket()}}.} +\item{bucket}{Bucket name. You can only write to an existing bucket, and you +can use \code{\link[googleCloudStorageR:gcs_get_global_bucket]{googleCloudStorageR::gcs_get_global_bucket()}} here.} \item{prefix}{Prefix within this bucket that this board will occupy. You can use this to maintain multiple independent pin boards within @@ -48,7 +43,7 @@ a new bucket from R with \code{\link[googleCloudStorageR:gcs_create_bucket]{goog suggested dependency of pins (not required for pins in general). If you run into errors when deploying content to a server like \url{https://shinyapps.io} or \href{https://posit.co/products/enterprise/connect/}{Connect}, -add \code{library(googleCloudStorageR)} to your app or document for \href{https://support.posit.co/hc/en-us/articles/229998627-Why-does-my-app-work-locally-but-not-on-my-RStudio-Connect-server}{automatic dependency discovery}. +add \code{requireNamespame(googleCloudStorageR)} to your app or document for \href{https://support.posit.co/hc/en-us/articles/229998627-Why-does-my-app-work-locally-but-not-on-my-RStudio-Connect-server}{automatic dependency discovery}. } }