From 2478ce80bda12deb4aa6313e7a3066dc019c07ae Mon Sep 17 00:00:00 2001 From: LTLA Date: Mon, 3 Feb 2025 09:28:14 -0800 Subject: [PATCH] Enable setting/getting of asset-level permissions in the latest gobbler. --- R/fetchPermissions.R | 42 +++++++++++++++++++++++-------- R/setPermissions.R | 25 ++++++++++++------ R/startGobbler.R | 2 +- man/fetchPermissions.Rd | 10 +++++--- man/setPermissions.Rd | 15 +++++++---- man/startGobbler.Rd | 2 +- tests/testthat/test-permissions.R | 35 +++++++++++++++++++++++++- 7 files changed, 102 insertions(+), 29 deletions(-) diff --git a/R/fetchPermissions.R b/R/fetchPermissions.R index ea2a94b..4cddb48 100644 --- a/R/fetchPermissions.R +++ b/R/fetchPermissions.R @@ -4,10 +4,12 @@ #' This will call the REST API if the caller is not on the same filesystem as the registry. #' #' @param project String containing the project name. +#' @param asset String containing the asset name. +#' If specified, permissions are retrieved for the asset rather than the entire project. #' @inheritParams listProjects #' -#' @return List containing the permissions for this project. -#' This has the following elements: +#' @return List containing the permissions for this project/asset. +#' For project-level permissions, the list has the following elements: #' \itemize{ #' \item \code{owners}, a character vector containing the user IDs of owners of this project. #' \item \code{uploaders}, a list of lists specifying the users or organizations who are authorzied to upload to this project. @@ -27,6 +29,7 @@ #' In this mode, any user can create any number of new assets in this project. #' Each user can also upload new versions of any asset that they created in this mode. #' } +#' For asset-level permissions, the list has \code{owners} and \code{uploaders} to describe the owners and uploaders, respectively, for the specified \code{asset}. #' #' @author Aaron Lun #' @@ -50,17 +53,36 @@ #' @export #' @importFrom jsonlite fromJSON #' @import httr2 -fetchPermissions <- function(project, registry, url, forceRemote=FALSE) { - if (file.exists(registry) && !forceRemote) { - content <- file.path(registry, project, "..permissions") +fetchPermissions <- function(project, registry, url, asset=NULL, forceRemote=FALSE) { + use.registry <- (file.exists(registry) && !forceRemote) + + if (is.null(asset)) { + if (use.registry) { + content <- file.path(registry, project, "..permissions") + } else { + req <- request(paste0(url, "/fetch/", paste(project, "..permissions", sep="/"))) + resp <- req_perform(req) + content <- resp_body_string(resp) + } + perms <- fromJSON(content, simplifyVector=FALSE) + } else { - req <- request(paste0(url, "/fetch/", paste(project, "..permissions", sep="/"))) - resp <- req_perform(req) - content <- resp_body_string(resp) + perms <- list(owners=list(), uploaders=list()) + if (use.registry) { + content <- file.path(registry, project, asset, "..permissions") + if (file.exists(content)) { + perms <- fromJSON(content, simplifyVector=FALSE) + } + } else { + perms <- tryCatch({ + req <- request(paste0(url, "/fetch/", paste(project, asset, "..permissions", sep="/"))) + resp <- req_perform(req) + content <- resp_body_string(resp) + fromJSON(content, simplifyVector=FALSE) + }, httr2_http_404 = function(cnd) perms) + } } - perms <- fromJSON(content, simplifyVector=FALSE) - # Converting everything to POSIX dates. for (i in seq_along(perms$uploaders)) { current <- perms$uploaders[[i]] diff --git a/R/setPermissions.R b/R/setPermissions.R index 8225201..a7d96c9 100644 --- a/R/setPermissions.R +++ b/R/setPermissions.R @@ -3,14 +3,17 @@ #' Set the owner and uploader permissions for a project. #' #' @param project String containing the project name. -#' @param owners Character vector containing the user IDs for owners of this project. +#' @param asset String containing the asset name. +#' If specified, permissions are set on the asset rather than the entire project. +#' @param owners Character vector containing the user IDs for owners of this project/asset. #' If \code{NULL}, no change is made to the existing owners of the project. -#' @param uploaders List specifying the authorized uploaders for this project. +#' @param uploaders List specifying the authorized uploaders for this project/asset. #' See the \code{uploaders} field in the \code{\link{fetchPermissions}} return value for the expected format. -#' If \code{NULL}, no change is made to the existing uploaders of the project. +#' If \code{NULL}, no change is made to the existing uploaders of the project/asset. #' @param globalWrite Logical scalar indicating whether global writes should be enabled (see \code{\link{fetchPermissions}} for details). #' If \code{NULL}, no change is made to the global write status of the project. -#' @param append Logical scalar indicating whether \code{owners} and \code{uploaders} should be appended to the existing owners and uploaders, respectively, of the project. +#' Ignored if \code{asset} is specified. +#' @param append Logical scalar indicating whether \code{owners} and \code{uploaders} should be appended to the existing owners and uploaders, respectively, of the project/asset. #' If \code{FALSE}, the \code{owners} and \code{uploaders} are used to replace the existing values. #' @param registry String containing a path to the registry. #' @inheritParams createProject @@ -49,10 +52,12 @@ #' fetchPermissions("test", registry=info$registry) #' #' @export -setPermissions <- function(project, registry, staging, url, owners=NULL, uploaders=NULL, globalWrite=NULL, append=TRUE) { +setPermissions <- function(project, registry, staging, url, asset=NULL, owners=NULL, uploaders=NULL, globalWrite=NULL, append=TRUE) { perms <- list() + names(perms) <- character(0) + if (append) { - old.perms <- fetchPermissions(project, registry=registry) + old.perms <- fetchPermissions(project, asset=asset, registry=registry, url=url) if (!is.null(owners)) { perms$owners <- as.list(union(unlist(old.perms$owners), owners)) } @@ -72,10 +77,14 @@ setPermissions <- function(project, registry, staging, url, owners=NULL, uploade perms$uploaders <- sanitize_uploaders(perms$uploaders) } - if (!is.null(globalWrite)) { + payload <- list(project=project) + if (!is.null(asset)) { + payload$asset <- asset + } else if (!is.null(globalWrite)) { perms$global_write <- globalWrite } - dump_request(staging, url, "set_permissions", list(project=project, permissions=perms)) + payload$permissions <- perms + dump_request(staging, url, "set_permissions", payload) invisible(NULL) } diff --git a/R/startGobbler.R b/R/startGobbler.R index aba9f25..807257f 100644 --- a/R/startGobbler.R +++ b/R/startGobbler.R @@ -36,7 +36,7 @@ #' #' @export #' @importFrom utils download.file -startGobbler <- function(staging=tempfile(), registry=tempfile(), port = NULL, wait = 1, version = "0.3.8", overwrite = FALSE) { +startGobbler <- function(staging=tempfile(), registry=tempfile(), port = NULL, wait = 1, version = "0.3.9", overwrite = FALSE) { if (!is.null(running$active)) { return(list(new=FALSE, staging=running$staging, registry=running$registry, port=running$port, url=assemble_url(running$port))) } diff --git a/man/fetchPermissions.Rd b/man/fetchPermissions.Rd index 828ab88..b5935d8 100644 --- a/man/fetchPermissions.Rd +++ b/man/fetchPermissions.Rd @@ -4,7 +4,7 @@ \alias{fetchPermissions} \title{Fetch project permissions} \usage{ -fetchPermissions(project, registry, url, forceRemote = FALSE) +fetchPermissions(project, registry, url, asset = NULL, forceRemote = FALSE) } \arguments{ \item{project}{String containing the project name.} @@ -14,12 +14,15 @@ fetchPermissions(project, registry, url, forceRemote = FALSE) \item{url}{String containing the URL to the Gobbler REST API. Only used for remote access.} +\item{asset}{String containing the asset name. +If specified, permissions are retrieved for the asset rather than the entire project.} + \item{forceRemote}{Logical scalar indicating whether to force remote access via the API, even if \code{registry} is on the same filesystem as the caller.} } \value{ -List containing the permissions for this project. -This has the following elements: +List containing the permissions for this project/asset. +For project-level permissions, the list has the following elements: \itemize{ \item \code{owners}, a character vector containing the user IDs of owners of this project. \item \code{uploaders}, a list of lists specifying the users or organizations who are authorzied to upload to this project. @@ -39,6 +42,7 @@ If not provided, defaults to \code{FALSE}. In this mode, any user can create any number of new assets in this project. Each user can also upload new versions of any asset that they created in this mode. } +For asset-level permissions, the list has \code{owners} and \code{uploaders} to describe the owners and uploaders, respectively, for the specified \code{asset}. } \description{ Fetch the permissions for a project. diff --git a/man/setPermissions.Rd b/man/setPermissions.Rd index 52793f2..493a44e 100644 --- a/man/setPermissions.Rd +++ b/man/setPermissions.Rd @@ -9,6 +9,7 @@ setPermissions( registry, staging, url, + asset = NULL, owners = NULL, uploaders = NULL, globalWrite = NULL, @@ -24,17 +25,21 @@ setPermissions( \item{url}{String containing the URL of the gobbler REST API.} -\item{owners}{Character vector containing the user IDs for owners of this project. +\item{asset}{String containing the asset name. +If specified, permissions are set on the asset rather than the entire project.} + +\item{owners}{Character vector containing the user IDs for owners of this project/asset. If \code{NULL}, no change is made to the existing owners of the project.} -\item{uploaders}{List specifying the authorized uploaders for this project. +\item{uploaders}{List specifying the authorized uploaders for this project/asset. See the \code{uploaders} field in the \code{\link{fetchPermissions}} return value for the expected format. -If \code{NULL}, no change is made to the existing uploaders of the project.} +If \code{NULL}, no change is made to the existing uploaders of the project/asset.} \item{globalWrite}{Logical scalar indicating whether global writes should be enabled (see \code{\link{fetchPermissions}} for details). -If \code{NULL}, no change is made to the global write status of the project.} +If \code{NULL}, no change is made to the global write status of the project. +Ignored if \code{asset} is specified.} -\item{append}{Logical scalar indicating whether \code{owners} and \code{uploaders} should be appended to the existing owners and uploaders, respectively, of the project. +\item{append}{Logical scalar indicating whether \code{owners} and \code{uploaders} should be appended to the existing owners and uploaders, respectively, of the project/asset. If \code{FALSE}, the \code{owners} and \code{uploaders} are used to replace the existing values.} } \value{ diff --git a/man/startGobbler.Rd b/man/startGobbler.Rd index de7202f..04e8eb7 100644 --- a/man/startGobbler.Rd +++ b/man/startGobbler.Rd @@ -10,7 +10,7 @@ startGobbler( registry = tempfile(), port = NULL, wait = 1, - version = "0.3.8", + version = "0.3.9", overwrite = FALSE ) diff --git a/tests/testthat/test-permissions.R b/tests/testthat/test-permissions.R index b90e070..9ab68a2 100644 --- a/tests/testthat/test-permissions.R +++ b/tests/testthat/test-permissions.R @@ -5,7 +5,7 @@ info <- startGobbler() removeProject("test-perms", staging=info$staging, url=info$url) createProject("test-perms", staging=info$staging, url=info$url, owners="LTLA") -test_that("permission setting works as expected", { +test_that("project-level permission setting works as expected", { until <- round(Sys.time() + 1000000) setPermissions("test-perms", owners="jkanche", @@ -59,3 +59,36 @@ test_that("permission setting works as expected", { perms <- fetchPermissions("test-perms", registry=info$registry) expect_false(perms$global_write) }) + +test_that("asset-level permission setting works as expected", { + until <- round(Sys.time() + 1000000) + setPermissions("test-perms", + asset="foobar", + owners="jkanche", + uploaders=list( + list(id="lawremi", until=until) + ), + staging=info$staging, + url=info$url, + registry=info$registry + ) + + perms <- fetchPermissions("test-perms", asset="foobar", registry=info$registry) + expect_identical(perms$owners, list("jkanche")) + expect_identical(length(perms$uploaders), 1L) + expect_identical(perms$uploaders[[1]]$id, "lawremi") + expect_equal(perms$uploaders[[1]]$until, until) + expect_null(perms$global_write) + + # Works with remote. + rperms <- fetchPermissions("test-perms", asset="foobar", forceRemote=TRUE, registry=info$registry, url=info$url) + expect_identical(perms, rperms) + + # Works correctly when there are no permissions. + perms <- fetchPermissions("test-perms", asset="stuff", registry=info$registry) + expect_identical(perms$owners, list()) + expect_identical(perms$uploaders, list()) + + rperms <- fetchPermissions("test-perms", asset="stuff", forceRemote=TRUE, registry=info$registry, url=info$url) + expect_identical(perms, rperms) +})