From 2fd27af8ee7156a208a17c08b2dd020029970d7f Mon Sep 17 00:00:00 2001 From: Toph Allen Date: Thu, 21 Nov 2024 17:23:51 -0500 Subject: [PATCH 01/12] first pass at functionality --- NAMESPACE | 1 + NEWS.md | 2 + R/connect.R | 7 ++ R/get.R | 105 -------------------- R/groups.R | 184 +++++++++++++++++++++++++++++++++++ R/ptype.R | 7 ++ man/PositConnect.Rd | 18 ++++ man/get_group_content.Rd | 53 ++++++++++ man/get_group_members.Rd | 8 +- man/get_groups.Rd | 8 +- tests/testthat/test-groups.R | 70 +++++++++++++ 11 files changed, 356 insertions(+), 107 deletions(-) create mode 100644 R/groups.R create mode 100644 man/get_group_content.Rd diff --git a/NAMESPACE b/NAMESPACE index 36803fc4..c73aa816 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -75,6 +75,7 @@ export(get_content) export(get_content_permissions) export(get_content_tags) export(get_environment) +export(get_group_content) export(get_group_members) export(get_group_permission) export(get_groups) diff --git a/NEWS.md b/NEWS.md index cac194a7..d58be04d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,6 +5,8 @@ - `get_users()` now supports filtering users with the `account_status` and `user_role` parameters. For example, this allows you to find all licensed users on a Connect server. (#311) +- The new `get_group_content()` function lets you view the content that groups + have permission to access. (#334) # connectapi 0.4.0 diff --git a/R/connect.R b/R/connect.R index 21408b05..b7a347d2 100644 --- a/R/connect.R +++ b/R/connect.R @@ -687,6 +687,13 @@ Connect <- R6::R6Class( self$GET(path, query = query) }, + #' @description Get content to which a group has access + #' @param guid The group GUID. + group_content = function(guid) { + path <- v1_url("experimental", "groups", guid, "content") + self$GET(path) + }, + # instrumentation -------------------------------------------- #' @description Get (non-interactive) content visits. diff --git a/R/get.R b/R/get.R index 2ee545f0..3e01d339 100644 --- a/R/get.R +++ b/R/get.R @@ -78,111 +78,6 @@ get_users <- function( return(out) } -#' Get group information from the Posit Connect server -#' -#' @param src The source object. -#' @param page_size The number of records to return per page (max 500). -#' @param prefix Filters groups by prefix (group name). -#' The filter is case insensitive. -#' @param limit The number of groups to retrieve before paging stops. -#' -#' `limit` will be ignored is `prefix` is not `NULL`. -#' To limit results when `prefix` is not `NULL`, change `page_size`. -#' -#' @return -#' A tibble with the following columns: -#' -#' * `guid`: The unique identifier of the group -#' * `name`: The group name -#' * `owner_guid`: The group owner's unique identifier. When using LDAP or -#' Proxied authentication with group provisioning enabled this property -#' will always be null. -#' -#' @details -#' Please see https://docs.posit.co/connect/api/#get-/v1/groups for more information. -#' -#' @examples -#' \dontrun{ -#' library(connectapi) -#' client <- connect() -#' -#' # get all groups -#' get_groups(client, limit = Inf) -#' } -#' -#' @export -get_groups <- function(src, page_size = 500, prefix = NULL, limit = Inf) { - validate_R6_class(src, "Connect") - - # The `v1/groups` endpoint always returns the first page when `prefix` is - # specified, so the page_offset function, which increments until it hits an - # empty page, fails. - if (!is.null(prefix)) { - response <- src$groups(page_size = page_size, prefix = prefix) - res <- response$results - } else { - res <- page_offset(src, src$groups(page_size = page_size, prefix = NULL), limit = limit) - } - - out <- parse_connectapi_typed(res, connectapi_ptypes$groups) - - return(out) -} - -#' Get users within a specific group -#' -#' @param src The source object -#' @param guid A group GUID identifier -#' -#' @return -#' A tibble with the following columns: -#' -#' * `email`: The user's email -#' * `username`: The user's username -#' * `first_name`: The user's first name -#' * `last_name`: The user's last name -#' * `user_role`: The user's role. It may have a value of administrator, -#' publisher or viewer. -#' * `created_time`: The timestamp (in RFC3339 format) when the user -#' was created in the Posit Connect server -#' * `updated_time`: The timestamp (in RFC3339 format) when the user -#' was last updated in the Posit Connect server -#' * `active_time`: The timestamp (in RFC3339 format) when the user -#' was last active on the Posit Connect server -#' * `confirmed`: When false, the created user must confirm their -#' account through an email. This feature is unique to password -#' authentication. -#' * `locked`: Whether or not the user is locked -#' * `guid`: The user's GUID, or unique identifier, in UUID RFC4122 format -#' -#' @details -#' Please see https://docs.posit.co/connect/api/#get-/v1/groups/-group_guid-/members -#' for more information. -#' -#' @examples -#' \dontrun{ -#' library(connectapi) -#' client <- connect() -#' -#' # get the first 20 groups -#' groups <- get_groups(client) -#' -#' group_guid <- groups$guid[1] -#' -#' get_group_members(client, guid = group_guid) -#' } -#' -#' @export -get_group_members <- function(src, guid) { - validate_R6_class(src, "Connect") - - res <- src$group_members(guid) - - out <- parse_connectapi(res$results) - - return(out) -} - #' Get information about content on the Posit Connect server #' #' @param src A Connect object diff --git a/R/groups.R b/R/groups.R new file mode 100644 index 00000000..5f5a06ec --- /dev/null +++ b/R/groups.R @@ -0,0 +1,184 @@ +#' Get group information from the Posit Connect server +#' +#' @param src The source object. +#' @param page_size The number of records to return per page (max 500). +#' @param prefix Filters groups by prefix (group name). +#' The filter is case insensitive. +#' @param limit The number of groups to retrieve before paging stops. +#' +#' `limit` will be ignored is `prefix` is not `NULL`. +#' To limit results when `prefix` is not `NULL`, change `page_size`. +#' +#' @return +#' A tibble with the following columns: +#' +#' * `guid`: The unique identifier of the group +#' * `name`: The group name +#' * `owner_guid`: The group owner's unique identifier. When using LDAP or +#' Proxied authentication with group provisioning enabled this property +#' will always be null. +#' +#' @details +#' Please see https://docs.posit.co/connect/api/#get-/v1/groups for more information. +#' +#' @examples +#' \dontrun{ +#' library(connectapi) +#' client <- connect() +#' +#' # get all groups +#' get_groups(client, limit = Inf) +#' } +#' +#' @family groups functions +#' @export +get_groups <- function(src, page_size = 500, prefix = NULL, limit = Inf) { + validate_R6_class(src, "Connect") + + # The `v1/groups` endpoint always returns the first page when `prefix` is + # specified, so the page_offset function, which increments until it hits an + # empty page, fails. + if (!is.null(prefix)) { + response <- src$groups(page_size = page_size, prefix = prefix) + res <- response$results + } else { + res <- page_offset(src, src$groups(page_size = page_size, prefix = NULL), limit = limit) + } + + out <- parse_connectapi_typed(res, connectapi_ptypes$groups) + + return(out) +} + +#' Get users within a specific group +#' +#' @param src The source object +#' @param guid A group GUID identifier +#' +#' @return +#' A tibble with the following columns: +#' +#' * `email`: The user's email +#' * `username`: The user's username +#' * `first_name`: The user's first name +#' * `last_name`: The user's last name +#' * `user_role`: The user's role. It may have a value of administrator, +#' publisher or viewer. +#' * `created_time`: The timestamp (in RFC3339 format) when the user +#' was created in the Posit Connect server +#' * `updated_time`: The timestamp (in RFC3339 format) when the user +#' was last updated in the Posit Connect server +#' * `active_time`: The timestamp (in RFC3339 format) when the user +#' was last active on the Posit Connect server +#' * `confirmed`: When false, the created user must confirm their +#' account through an email. This feature is unique to password +#' authentication. +#' * `locked`: Whether or not the user is locked +#' * `guid`: The user's GUID, or unique identifier, in UUID RFC4122 format +#' +#' @details +#' Please see https://docs.posit.co/connect/api/#get-/v1/groups/-group_guid-/members +#' for more information. +#' +#' @examples +#' \dontrun{ +#' library(connectapi) +#' client <- connect() +#' +#' # get the first 20 groups +#' groups <- get_groups(client) +#' +#' group_guid <- groups$guid[1] +#' +#' get_group_members(client, guid = group_guid) +#' } +#' +#' @family groups functions +#' @export +get_group_members <- function(src, guid) { + validate_R6_class(src, "Connect") + + res <- src$group_members(guid) + + out <- parse_connectapi(res$results) + + return(out) +} + +#' Get content access permissions for a group or groups +#' +#' @param src The source object +#' @param groups A data frame or tibble of groups +#' +#' @return +#' A tibble with the following columns: + +#' * `group_guid`: The group's GUID +#' * `group_name`: The group's name +#' * `content_guid`: The content item's GUID +#' * `content_name`: The content item's name +#' * `content_title`: The content item's title +#' * `access_type`: The access type of the content item ("all", "logged_in", or "acl") +#' * `role`: The access type that members of the group have to the +#' content item, "publisher" or "viewer". +#' +#' @examples +#' \dontrun{ +#' library(connectapi) +#' client <- connect() +#' +#' # Get a data frame of groups +#' groups <- get_groups(client) +#' +#' # Get permissions for a single group by passing in the corresponding row. +#' get_group_content(client, groups[1, ]) +#' dplyr::filter(groups, name = "research_scientists") %>% +#' get_group_content(client, groups = .) +#' +#' # Get permissions for all groups by passing in the entire groups data frame. +#' get_group_content(client, groups) +#' } +#' +#' @family groups functions +#' @export +get_group_content <- function(src, groups) { + validate_R6_class(src, "Connect") + + purrr::pmap_dfr( + dplyr::select(groups, guid, name), + get_group_content_impl, + src = src + ) +} + +get_group_content_impl <- function(src, guid, name) { + validate_R6_class(src, "Connect") + + res <- src$group_content(guid) + parsed <- parse_connectapi_typed(res, connectapi_ptypes$group_content) + + dplyr::transmute(parsed, + group_guid = guid, + group_name = name, + content_guid, + content_name, + content_title, + access_type, + role = purrr::map_chr( + permissions, + extract_role, + principal_name = name + ) + ) +} + +extract_role <- function(permissions, principal_name) { + matched <- purrr:::keep( + permissions, + ~ .x[["principal_name"]] == principal_name && .x[["principal_type"]] == "group") + if (length(matched) == 1) { + return(matched[[1]][["principal_role"]]) + } else { + stop("Unexpected permissions structure.") + } +} diff --git a/R/ptype.R b/R/ptype.R index 0049e65d..836cac1b 100644 --- a/R/ptype.R +++ b/R/ptype.R @@ -211,5 +211,12 @@ connectapi_ptypes <- list( principal_guid = NA_character_, principal_type = NA_character_, role = NA_character_ + ), + group_content = tibble::tibble( + content_guid = NA_character_, + content_name = NA_character_, + content_title = NA_character_, + access_type = NA_character_, + permissions = NA_list_ ) ) diff --git a/man/PositConnect.Rd b/man/PositConnect.Rd index 44a53b76..72e56163 100644 --- a/man/PositConnect.Rd +++ b/man/PositConnect.Rd @@ -114,6 +114,7 @@ Other R6 classes: \item \href{#method-Connect-groups_create}{\code{Connect$groups_create()}} \item \href{#method-Connect-groups_create_remote}{\code{Connect$groups_create_remote()}} \item \href{#method-Connect-groups_remote}{\code{Connect$groups_remote()}} +\item \href{#method-Connect-group_content}{\code{Connect$group_content()}} \item \href{#method-Connect-inst_content_visits}{\code{Connect$inst_content_visits()}} \item \href{#method-Connect-inst_shiny_usage}{\code{Connect$inst_shiny_usage()}} \item \href{#method-Connect-procs}{\code{Connect$procs()}} @@ -1090,6 +1091,23 @@ Get remote groups. } } \if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Connect-group_content}{}}} +\subsection{Method \code{group_content()}}{ +Get content to which a group has access +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Connect$group_content(guid)}\if{html}{\out{
}} +} + +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{guid}}{The group GUID.} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Connect-inst_content_visits}{}}} \subsection{Method \code{inst_content_visits()}}{ diff --git a/man/get_group_content.Rd b/man/get_group_content.Rd new file mode 100644 index 00000000..f1380c0e --- /dev/null +++ b/man/get_group_content.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/groups.R +\name{get_group_content} +\alias{get_group_content} +\title{Get content access permissions for a group or groups} +\usage{ +get_group_content(src, groups) +} +\arguments{ +\item{src}{The source object} + +\item{groups}{A data frame or tibble of groups} +} +\value{ +A tibble with the following columns: +\itemize{ +\item \code{group_guid}: The group's GUID +\item \code{group_name}: The group's name +\item \code{content_guid}: The content item's GUID +\item \code{content_name}: The content item's name +\item \code{content_title}: The content item's title +\item \code{access_type}: The access type of the content item ("all", "logged_in", or "acl") +\item \code{role}: The access type that members of the group have to the +content item, "publisher" or "viewer". +} +} +\description{ +Get content access permissions for a group or groups +} +\examples{ +\dontrun{ +library(connectapi) +client <- connect() + +# Get a data frame of groups +groups <- get_groups(client) + +# Get permissions for a single group by passing in the corresponding row. +get_group_content(client, groups[1, ]) +dplyr::filter(groups, name = "research_scientists") \%>\% + get_group_content(client, groups = .) + +# Get permissions for all groups by passing in the entire groups data frame. +get_group_content(client, groups) +} + +} +\seealso{ +Other groups functions: +\code{\link{get_group_members}()}, +\code{\link{get_groups}()} +} +\concept{groups functions} diff --git a/man/get_group_members.Rd b/man/get_group_members.Rd index e836dfa5..33531292 100644 --- a/man/get_group_members.Rd +++ b/man/get_group_members.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get.R +% Please edit documentation in R/groups.R \name{get_group_members} \alias{get_group_members} \title{Get users within a specific group} @@ -54,3 +54,9 @@ get_group_members(client, guid = group_guid) } } +\seealso{ +Other groups functions: +\code{\link{get_group_content}()}, +\code{\link{get_groups}()} +} +\concept{groups functions} diff --git a/man/get_groups.Rd b/man/get_groups.Rd index 956f88f2..d69de4f6 100644 --- a/man/get_groups.Rd +++ b/man/get_groups.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get.R +% Please edit documentation in R/groups.R \name{get_groups} \alias{get_groups} \title{Get group information from the Posit Connect server} @@ -45,3 +45,9 @@ get_groups(client, limit = Inf) } } +\seealso{ +Other groups functions: +\code{\link{get_group_content}()}, +\code{\link{get_group_members}()} +} +\concept{groups functions} diff --git a/tests/testthat/test-groups.R b/tests/testthat/test-groups.R index 5416f86c..a054ee92 100644 --- a/tests/testthat/test-groups.R +++ b/tests/testthat/test-groups.R @@ -35,3 +35,73 @@ without_internet({ ) }) }) + +test_that("extract_role() extracts the role for the named principal", { + p_list <- list( + list( + list( + principal_guid = "not-a-guid", + principal_name = "User1", + principal_role = "author", + principal_type = "user" + ), + list( + principal_guid = "not-a-guid", + principal_name = "connect_dev", + principal_role = "viewer", + principal_type = "group" + ) + ), + list( + list( + principal_guid = "not-a-guid", + principal_name = "User2", + principal_role = "author", + principal_type = "user" + ), + list( + principal_guid = "not-a-guid", + principal_name = "connect_dev", + principal_role = "publisher", + principal_type = "group" + ), + list( + principal_guid = "not-a-guid", + principal_name = "toph", + principal_role = "publisher", + principal_type = "user" + ) + ) + ) + expect_equal( + purrr::map_chr(p_list, extract_role, principal_name = "connect_dev"), + c("viewer", "publisher") + ) +}) + +test_that("extract_role() errs when multiple entries exist for the same principal", { + p_list <- list( + list( + principal_guid = "not-a-guid", + principal_name = "User1", + principal_role = "author", + principal_type = "user" + ), + list( + principal_guid = "not-a-guid", + principal_name = "connect_dev", + principal_role = "viewer", + principal_type = "group" + ), + list( + principal_guid = "not-a-guid", + principal_name = "connect_dev", + principal_role = "publisher", + principal_type = "group" + ) + ) + expect_error( + extract_role(p_list, principal_name = "connect_dev"), + "Unexpected permissions structure." + ) +}) From c83e62411114e1488fd0a69ff56e7895ba61d0e8 Mon Sep 17 00:00:00 2001 From: Toph Allen Date: Fri, 22 Nov 2024 12:48:41 -0500 Subject: [PATCH 02/12] add schema validation, tests --- NAMESPACE | 1 + R/groups.R | 31 +++++--- R/ptype.R | 29 ++++++++ .../experimental/groups/a6fb5cea/content.json | 74 +++++++++++++++++++ .../experimental/groups/ae5c3b2c/content.json | 34 +++++++++ tests/testthat/_snaps/groups.md | 28 +++++++ tests/testthat/test-groups.R | 27 ++++++- tests/testthat/test-ptype.R | 63 ++++++++++++++++ 8 files changed, 275 insertions(+), 12 deletions(-) create mode 100644 tests/testthat/2024.08.0/__api__/v1/experimental/groups/a6fb5cea/content.json create mode 100644 tests/testthat/2024.08.0/__api__/v1/experimental/groups/ae5c3b2c/content.json create mode 100644 tests/testthat/_snaps/groups.md create mode 100644 tests/testthat/test-ptype.R diff --git a/NAMESPACE b/NAMESPACE index c73aa816..8465b78d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -143,6 +143,7 @@ export(users_create_remote) export(vanity_is_available) export(variant_render) export(verify_content_name) +importFrom(dplyr,.data) importFrom(lifecycle,deprecate_warn) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") diff --git a/R/groups.R b/R/groups.R index 5f5a06ec..b8cb0adb 100644 --- a/R/groups.R +++ b/R/groups.R @@ -141,16 +141,22 @@ get_group_members <- function(src, guid) { #' #' @family groups functions #' @export +#' @importFrom dplyr .data get_group_content <- function(src, groups) { validate_R6_class(src, "Connect") + validate_df_ptype(groups, tibble::tibble( + guid = NA_character_, + name = NA_character_ + )) purrr::pmap_dfr( - dplyr::select(groups, guid, name), + dplyr::select(groups, .data$guid, .data$name), get_group_content_impl, src = src ) } +#' @importFrom dplyr .data get_group_content_impl <- function(src, guid, name) { validate_R6_class(src, "Connect") @@ -160,25 +166,30 @@ get_group_content_impl <- function(src, guid, name) { dplyr::transmute(parsed, group_guid = guid, group_name = name, - content_guid, - content_name, - content_title, - access_type, + .data$content_guid, + .data$content_name, + .data$content_title, + .data$access_type, role = purrr::map_chr( - permissions, + .data$permissions, extract_role, - principal_name = name + principal_name = name, + principal_type = "group" ) ) } -extract_role <- function(permissions, principal_name) { - matched <- purrr:::keep( +# Given the list of permissions for a content item, extract the role for the +# provided principal_name and principal_type. +extract_role <- function(permissions, principal_name, principal_type) { + matched <- purrr::keep( permissions, - ~ .x[["principal_name"]] == principal_name && .x[["principal_type"]] == "group") + ~ .x[["principal_name"]] == principal_name && .x[["principal_type"]] == principal_type + ) if (length(matched) == 1) { return(matched[[1]][["principal_role"]]) } else { stop("Unexpected permissions structure.") } + stop(glue::glue("Could not find permissions for \"{principal_name}\"")) } diff --git a/R/ptype.R b/R/ptype.R index 836cac1b..6004f54a 100644 --- a/R/ptype.R +++ b/R/ptype.R @@ -220,3 +220,32 @@ connectapi_ptypes <- list( permissions = NA_list_ ) ) + +# Validates an input data frame against a required schema ptype. +# 1. is a data frame or similar object; +# 2. contains all the names from the required; +# 3. that all matching names have the correct ptype. +validate_df_ptype <- function(input, required) { + if (!inherits(input, "data.frame")) { + stop("Input must be a data frame.") + } + if (!all(names(input) %in% required)) { + missing <- setdiff(names(required), names(input)) + if (length(missing) > 0) { + stop(glue::glue("Missing required columns: {paste0(missing, collapse = ', ')}")) + } + } + + for (col in names(required)) { + tryCatch( + vctrs::vec_ptype_common(input[[col]], required[[col]]), + error = function(e) { + stop(glue::glue( + "Column `{col}` has type `{vctrs::vec_ptype_abbr(input[[col]])}`; ", + "needs `{vctrs::vec_ptype_abbr(required[[col]])}:`\n", + conditionMessage(e) + )) + } + ) + } +} diff --git a/tests/testthat/2024.08.0/__api__/v1/experimental/groups/a6fb5cea/content.json b/tests/testthat/2024.08.0/__api__/v1/experimental/groups/a6fb5cea/content.json new file mode 100644 index 00000000..fd217219 --- /dev/null +++ b/tests/testthat/2024.08.0/__api__/v1/experimental/groups/a6fb5cea/content.json @@ -0,0 +1,74 @@ +[ + { + "content_guid": "8b57f54e", + "content_name": "app-1197-9825-test2", + "content_title": "app-1197-9825-test2", + "access_type": "acl", + "permissions": [ + { + "principal_guid": "434f97ab", + "principal_name": "test", + "principal_role": "author", + "principal_type": "user" + }, + { + "principal_guid": "a6fb5cea", + "principal_name": "connect_dev", + "principal_role": "publisher", + "principal_type": "group" + }, + { + "principal_guid": "e5c8d844", + "principal_name": "other_user", + "principal_role": "publisher", + "principal_type": "user" + } + ] + }, + { + "content_guid": "8bf70c85", + "content_name": "quarto-email-demo-stock-report-python", + "content_title": "quarto-email-demo-stock-report-python", + "access_type": "acl", + "permissions": [ + { + "principal_guid": "81b09132", + "principal_name": "aron", + "principal_role": "author", + "principal_type": "user" + }, + { + "principal_guid": "a6fb5cea", + "principal_name": "connect_dev", + "principal_role": "viewer", + "principal_type": "group" + }, + { + "principal_guid": "e36cdf86", + "principal_name": "toph", + "principal_role": "viewer", + "principal_type": "user" + } + ] + }, + { + "content_guid": "fcad1958", + "content_name": "top-queries", + "content_title": "top-queries", + "access_type": "logged_in", + "permissions": [ + { + "principal_guid": "1a7a5703", + "principal_name": "test_user", + "principal_role": "author", + "principal_type": "user" + }, + { + "principal_guid": "a6fb5cea", + "principal_name": "connect_dev", + "principal_role": "publisher", + "principal_type": "group" + } + ] + } +] diff --git a/tests/testthat/2024.08.0/__api__/v1/experimental/groups/ae5c3b2c/content.json b/tests/testthat/2024.08.0/__api__/v1/experimental/groups/ae5c3b2c/content.json new file mode 100644 index 00000000..4c0c422f --- /dev/null +++ b/tests/testthat/2024.08.0/__api__/v1/experimental/groups/ae5c3b2c/content.json @@ -0,0 +1,34 @@ +[ + { + "content_guid": "46fb83eb", + "content_name": "forecast-email-demo", + "content_title": "forecast-email-demo", + "access_type": "logged_in", + "permissions": [ + { + "principal_guid": "36943913", + "principal_name": "test_user_3", + "principal_role": "author", + "principal_type": "user" + }, + { + "principal_guid": "651413bd", + "principal_name": "group11", + "principal_role": "publisher", + "principal_type": "group" + }, + { + "principal_guid": "ae5c3b2c", + "principal_name": "group12", + "principal_role": "viewer", + "principal_type": "group" + }, + { + "principal_guid": "c4ff90b8", + "principal_name": "alice", + "principal_role": "publisher", + "principal_type": "user" + } + ] + } +] diff --git a/tests/testthat/_snaps/groups.md b/tests/testthat/_snaps/groups.md new file mode 100644 index 00000000..7c99f85c --- /dev/null +++ b/tests/testthat/_snaps/groups.md @@ -0,0 +1,28 @@ +# get_group_content() successfully gets the content for multiple groups + + Code + get_group_content(client, groups_df) + Condition + Warning: + Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0. + i Please use `"guid"` instead of `.data$guid` + Warning: + Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0. + i Please use `"name"` instead of `.data$name` + Output + # A tibble: 27 x 7 + group_guid group_name content_guid content_name content_title access_type + + 1 a6fb5cea connect_dev ec0c03f8 rmd-linked-doc rmd-linked-d~ acl + 2 a6fb5cea connect_dev 8b57f54e app-1197-9825-~ app-1197-982~ acl + 3 a6fb5cea connect_dev d6b2e4c6 okr4_ui_metrics OKR4 UI Metr~ logged_in + 4 a6fb5cea connect_dev eb747f8c Title-1232-168~ Title 1232 logged_in + 5 a6fb5cea connect_dev bf7ad642 stats-summary-2 stats-summar~ acl + 6 a6fb5cea connect_dev 818065e4 stats-apr-11-w~ stats-apr-11~ acl + 7 a6fb5cea connect_dev 4df4c439 choices-4-19 choices-4-19 acl + 8 a6fb5cea connect_dev 3756e60f choices-5-5 choices-5-5 acl + 9 a6fb5cea connect_dev b00ab022 zendesk_25849 Zendesk_25849 acl + 10 a6fb5cea connect_dev fcad1958 dogfood-top-qu~ Dogfood-top-~ acl + # i 17 more rows + # i 1 more variable: role + diff --git a/tests/testthat/test-groups.R b/tests/testthat/test-groups.R index a054ee92..d5be0706 100644 --- a/tests/testthat/test-groups.R +++ b/tests/testthat/test-groups.R @@ -74,7 +74,7 @@ test_that("extract_role() extracts the role for the named principal", { ) ) expect_equal( - purrr::map_chr(p_list, extract_role, principal_name = "connect_dev"), + purrr::map_chr(p_list, extract_role, principal_name = "connect_dev", principal_type = "group"), c("viewer", "publisher") ) }) @@ -101,7 +101,30 @@ test_that("extract_role() errs when multiple entries exist for the same principa ) ) expect_error( - extract_role(p_list, principal_name = "connect_dev"), + extract_role(p_list, principal_name = "connect_dev", principal_type = "group"), "Unexpected permissions structure." ) }) + +with_mock_api({ + client <- Connect$new(server = "https://connect.example", api_key = "not-a-key") + + test_that("get_group_content() successfully gets the content for multiple groups", { + groups_df <- tibble::tibble( + guid = c( + "a6fb5cea", + "ae5c3b2c" + ), + name = c( + "connect_dev", + "group12" + ), + owner_guid = c( + "1a7a5703", + "434f97ab" + ) + ) + + expect_snapshot(get_group_content(client, groups_df)) + }) +}) diff --git a/tests/testthat/test-ptype.R b/tests/testthat/test-ptype.R new file mode 100644 index 00000000..b2e7d89b --- /dev/null +++ b/tests/testthat/test-ptype.R @@ -0,0 +1,63 @@ +test_that("validate_df_ptype() accepts data frames meeting requirements", { + expect_no_error(validate_df_ptype( + input = tibble::tibble( + guid = NA_character_, + name = NA_character_, + owner_guid = NA_character_ + ), + required = tibble::tibble( + guid = NA_character_, + name = NA_character_ + ) + )) +}) + +test_that("validate_df_ptype() rejects data missing required names", { + expect_error( + validate_df_ptype( + input = tibble::tibble( + content_guid = NA_character_, + content_name = NA_character_, + owner_guid = NA_character_ + ), + required = tibble::tibble( + guid = NA_character_, + name = NA_character_ + ) + ), + "Missing required columns: guid, name" + ) +}) + +test_that("validate_df_ptype() rejects data missing required names", { + expect_error( + validate_df_ptype( + input = tibble::tibble( + content_guid = NA_character_, + content_name = NA_character_, + owner_guid = NA_character_ + ), + required = tibble::tibble( + guid = NA_character_, + name = NA_character_ + ) + ), + "Missing required columns: guid, name" + ) +}) + +test_that("validate_df_ptype() rejects data with wrong types", { + expect_error( + validate_df_ptype( + input = tibble::tibble( + guid = NA_integer_, + name = NA_character_ + ), + required = tibble::tibble( + guid = NA_character_, + name = NA_character_ + ) + ), + "Column `guid` has type `int`; needs `chr:`" + ) +}) From 0ffa3e3e2467e67bd9d6860cf4f575770749df3a Mon Sep 17 00:00:00 2001 From: Toph Allen Date: Fri, 22 Nov 2024 13:03:48 -0500 Subject: [PATCH 03/12] fix tests and linting --- NAMESPACE | 2 +- R/groups.R | 13 ++++++------- tests/testthat/_snaps/groups.md | 30 ++++++++---------------------- 3 files changed, 15 insertions(+), 30 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 8465b78d..8e461c8d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -143,12 +143,12 @@ export(users_create_remote) export(vanity_is_available) export(variant_render) export(verify_content_name) -importFrom(dplyr,.data) importFrom(lifecycle,deprecate_warn) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") importFrom(rlang,"%||%") importFrom(rlang,":=") +importFrom(rlang,.data) importFrom(rlang,arg_match) importFrom(utils,browseURL) importFrom(utils,capture.output) diff --git a/R/groups.R b/R/groups.R index b8cb0adb..1797e7c3 100644 --- a/R/groups.R +++ b/R/groups.R @@ -141,7 +141,6 @@ get_group_members <- function(src, guid) { #' #' @family groups functions #' @export -#' @importFrom dplyr .data get_group_content <- function(src, groups) { validate_R6_class(src, "Connect") validate_df_ptype(groups, tibble::tibble( @@ -150,13 +149,13 @@ get_group_content <- function(src, groups) { )) purrr::pmap_dfr( - dplyr::select(groups, .data$guid, .data$name), + dplyr::select(groups, "guid", "name"), get_group_content_impl, src = src ) } -#' @importFrom dplyr .data +#' @importFrom rlang .data get_group_content_impl <- function(src, guid, name) { validate_R6_class(src, "Connect") @@ -166,10 +165,10 @@ get_group_content_impl <- function(src, guid, name) { dplyr::transmute(parsed, group_guid = guid, group_name = name, - .data$content_guid, - .data$content_name, - .data$content_title, - .data$access_type, + "content_guid", + "content_name", + "content_title", + "access_type", role = purrr::map_chr( .data$permissions, extract_role, diff --git a/tests/testthat/_snaps/groups.md b/tests/testthat/_snaps/groups.md index 7c99f85c..ada1de22 100644 --- a/tests/testthat/_snaps/groups.md +++ b/tests/testthat/_snaps/groups.md @@ -2,27 +2,13 @@ Code get_group_content(client, groups_df) - Condition - Warning: - Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0. - i Please use `"guid"` instead of `.data$guid` - Warning: - Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0. - i Please use `"name"` instead of `.data$name` Output - # A tibble: 27 x 7 - group_guid group_name content_guid content_name content_title access_type - - 1 a6fb5cea connect_dev ec0c03f8 rmd-linked-doc rmd-linked-d~ acl - 2 a6fb5cea connect_dev 8b57f54e app-1197-9825-~ app-1197-982~ acl - 3 a6fb5cea connect_dev d6b2e4c6 okr4_ui_metrics OKR4 UI Metr~ logged_in - 4 a6fb5cea connect_dev eb747f8c Title-1232-168~ Title 1232 logged_in - 5 a6fb5cea connect_dev bf7ad642 stats-summary-2 stats-summar~ acl - 6 a6fb5cea connect_dev 818065e4 stats-apr-11-w~ stats-apr-11~ acl - 7 a6fb5cea connect_dev 4df4c439 choices-4-19 choices-4-19 acl - 8 a6fb5cea connect_dev 3756e60f choices-5-5 choices-5-5 acl - 9 a6fb5cea connect_dev b00ab022 zendesk_25849 Zendesk_25849 acl - 10 a6fb5cea connect_dev fcad1958 dogfood-top-qu~ Dogfood-top-~ acl - # i 17 more rows - # i 1 more variable: role + # A tibble: 4 x 7 + group_guid group_name `"content_guid"` `"content_name"` `"content_title"` + + 1 a6fb5cea connect_dev content_guid content_name content_title + 2 a6fb5cea connect_dev content_guid content_name content_title + 3 a6fb5cea connect_dev content_guid content_name content_title + 4 ae5c3b2c group12 content_guid content_name content_title + # i 2 more variables: `"access_type"` , role From f762c2a301af9bfa69548b7dace85e2105a0888b Mon Sep 17 00:00:00 2001 From: Toph Allen Date: Fri, 22 Nov 2024 13:25:38 -0500 Subject: [PATCH 04/12] =?UTF-8?q?we=20don=E2=80=99t=20actually=20need=20th?= =?UTF-8?q?e=20name=20to=20filter?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- R/groups.R | 11 +++++------ tests/testthat/test-groups.R | 20 ++++++++++---------- 2 files changed, 15 insertions(+), 16 deletions(-) diff --git a/R/groups.R b/R/groups.R index 1797e7c3..4ff93919 100644 --- a/R/groups.R +++ b/R/groups.R @@ -172,23 +172,22 @@ get_group_content_impl <- function(src, guid, name) { role = purrr::map_chr( .data$permissions, extract_role, - principal_name = name, - principal_type = "group" + principal_guid = guid ) ) } # Given the list of permissions for a content item, extract the role for the -# provided principal_name and principal_type. -extract_role <- function(permissions, principal_name, principal_type) { +# provided principal_guid +extract_role <- function(permissions, principal_guid) { matched <- purrr::keep( permissions, - ~ .x[["principal_name"]] == principal_name && .x[["principal_type"]] == principal_type + ~ .x[["principal_guid"]] == principal_guid ) if (length(matched) == 1) { return(matched[[1]][["principal_role"]]) } else { stop("Unexpected permissions structure.") } - stop(glue::glue("Could not find permissions for \"{principal_name}\"")) + stop(glue::glue("Could not find permissions for \"{principal_guid}\"")) } diff --git a/tests/testthat/test-groups.R b/tests/testthat/test-groups.R index d5be0706..42f84dfa 100644 --- a/tests/testthat/test-groups.R +++ b/tests/testthat/test-groups.R @@ -40,13 +40,13 @@ test_that("extract_role() extracts the role for the named principal", { p_list <- list( list( list( - principal_guid = "not-a-guid", + principal_guid = "fake-guid-1", principal_name = "User1", principal_role = "author", principal_type = "user" ), list( - principal_guid = "not-a-guid", + principal_guid = "fake-target-guid", principal_name = "connect_dev", principal_role = "viewer", principal_type = "group" @@ -54,19 +54,19 @@ test_that("extract_role() extracts the role for the named principal", { ), list( list( - principal_guid = "not-a-guid", + principal_guid = "fake-guid-2", principal_name = "User2", principal_role = "author", principal_type = "user" ), list( - principal_guid = "not-a-guid", + principal_guid = "fake-target-guid", principal_name = "connect_dev", principal_role = "publisher", principal_type = "group" ), list( - principal_guid = "not-a-guid", + principal_guid = "fake-guid-3", principal_name = "toph", principal_role = "publisher", principal_type = "user" @@ -74,7 +74,7 @@ test_that("extract_role() extracts the role for the named principal", { ) ) expect_equal( - purrr::map_chr(p_list, extract_role, principal_name = "connect_dev", principal_type = "group"), + purrr::map_chr(p_list, extract_role, principal_guid = "fake-target-guid"), c("viewer", "publisher") ) }) @@ -82,26 +82,26 @@ test_that("extract_role() extracts the role for the named principal", { test_that("extract_role() errs when multiple entries exist for the same principal", { p_list <- list( list( - principal_guid = "not-a-guid", + principal_guid = "fake-guid-1", principal_name = "User1", principal_role = "author", principal_type = "user" ), list( - principal_guid = "not-a-guid", + principal_guid = "fake-target-guid", principal_name = "connect_dev", principal_role = "viewer", principal_type = "group" ), list( - principal_guid = "not-a-guid", + principal_guid = "fake-target-guid", principal_name = "connect_dev", principal_role = "publisher", principal_type = "group" ) ) expect_error( - extract_role(p_list, principal_name = "connect_dev", principal_type = "group"), + extract_role(p_list, principal_guid = "fake-target-guid"), "Unexpected permissions structure." ) }) From e0a6bcc721324621c1acd29462348645e914e456 Mon Sep 17 00:00:00 2001 From: Toph Allen Date: Fri, 22 Nov 2024 13:51:05 -0500 Subject: [PATCH 05/12] support guid-only invocation --- R/connect.R | 7 +++++++ R/groups.R | 21 ++++++++++++++----- man/PositConnect.Rd | 18 ++++++++++++++++ man/get_group_content.Rd | 5 ++++- .../2024.08.0/__api__/v1/groups/a6fb5cea.json | 5 +++++ .../2024.08.0/__api__/v1/groups/ae5c3b2c.json | 5 +++++ tests/testthat/_snaps/groups.md | 14 +++++++++++++ tests/testthat/test-groups.R | 9 ++++++++ 8 files changed, 78 insertions(+), 6 deletions(-) create mode 100644 tests/testthat/2024.08.0/__api__/v1/groups/a6fb5cea.json create mode 100644 tests/testthat/2024.08.0/__api__/v1/groups/ae5c3b2c.json diff --git a/R/connect.R b/R/connect.R index b7a347d2..c1227bb5 100644 --- a/R/connect.R +++ b/R/connect.R @@ -694,6 +694,13 @@ Connect <- R6::R6Class( self$GET(path) }, + #' @description Get the details for a group + #' @param guid The group GUID. + group_details = function(guid) { + path <- v1_url("groups", guid) + self$GET(path) + }, + # instrumentation -------------------------------------------- #' @description Get (non-interactive) content visits. diff --git a/R/groups.R b/R/groups.R index 4ff93919..3501ae68 100644 --- a/R/groups.R +++ b/R/groups.R @@ -108,7 +108,7 @@ get_group_members <- function(src, guid) { #' Get content access permissions for a group or groups #' #' @param src The source object -#' @param groups A data frame or tibble of groups +#' @param groups Either a data frame of groups, or a character vector of group guids #' #' @return #' A tibble with the following columns: @@ -137,16 +137,27 @@ get_group_members <- function(src, guid) { #' #' # Get permissions for all groups by passing in the entire groups data frame. #' get_group_content(client, groups) +#' +#' # You can also pass in a guid or guids as a character vector. +#' get_group_content(client, groups$guid[1]) #' } #' #' @family groups functions #' @export get_group_content <- function(src, groups) { validate_R6_class(src, "Connect") - validate_df_ptype(groups, tibble::tibble( - guid = NA_character_, - name = NA_character_ - )) + if (inherits(groups, "data.frame")) { + validate_df_ptype(groups, tibble::tibble( + guid = NA_character_, + name = NA_character_ + )) + } else if (inherits(groups, "character")) { + # If a character vector, we assume we are receiving group guids, and call + # the endpoint to fetch the group name. + groups <- purrr::map_dfr(groups, src$group_details) + } else { + stop("`groups` must be a data frame or character vector.") + } purrr::pmap_dfr( dplyr::select(groups, "guid", "name"), diff --git a/man/PositConnect.Rd b/man/PositConnect.Rd index 72e56163..967189f6 100644 --- a/man/PositConnect.Rd +++ b/man/PositConnect.Rd @@ -115,6 +115,7 @@ Other R6 classes: \item \href{#method-Connect-groups_create_remote}{\code{Connect$groups_create_remote()}} \item \href{#method-Connect-groups_remote}{\code{Connect$groups_remote()}} \item \href{#method-Connect-group_content}{\code{Connect$group_content()}} +\item \href{#method-Connect-group_details}{\code{Connect$group_details()}} \item \href{#method-Connect-inst_content_visits}{\code{Connect$inst_content_visits()}} \item \href{#method-Connect-inst_shiny_usage}{\code{Connect$inst_shiny_usage()}} \item \href{#method-Connect-procs}{\code{Connect$procs()}} @@ -1099,6 +1100,23 @@ Get content to which a group has access \if{html}{\out{
}}\preformatted{Connect$group_content(guid)}\if{html}{\out{
}} } +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{guid}}{The group GUID.} +} +\if{html}{\out{
}} +} +} +\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-Connect-group_details}{}}} +\subsection{Method \code{group_details()}}{ +Get the details for a group +\subsection{Usage}{ +\if{html}{\out{
}}\preformatted{Connect$group_details(guid)}\if{html}{\out{
}} +} + \subsection{Arguments}{ \if{html}{\out{
}} \describe{ diff --git a/man/get_group_content.Rd b/man/get_group_content.Rd index f1380c0e..33022952 100644 --- a/man/get_group_content.Rd +++ b/man/get_group_content.Rd @@ -9,7 +9,7 @@ get_group_content(src, groups) \arguments{ \item{src}{The source object} -\item{groups}{A data frame or tibble of groups} +\item{groups}{Either a data frame of groups, or a character vector of group guids} } \value{ A tibble with the following columns: @@ -42,6 +42,9 @@ dplyr::filter(groups, name = "research_scientists") \%>\% # Get permissions for all groups by passing in the entire groups data frame. get_group_content(client, groups) + +# You can also pass in a guid or guids as a character vector. +get_group_content(client, groups$guid[1]) } } diff --git a/tests/testthat/2024.08.0/__api__/v1/groups/a6fb5cea.json b/tests/testthat/2024.08.0/__api__/v1/groups/a6fb5cea.json new file mode 100644 index 00000000..a5b140a9 --- /dev/null +++ b/tests/testthat/2024.08.0/__api__/v1/groups/a6fb5cea.json @@ -0,0 +1,5 @@ +{ + "guid": "a6fb5cea", + "name": "connect_dev", + "owner_guid": "1a7a5703" +} diff --git a/tests/testthat/2024.08.0/__api__/v1/groups/ae5c3b2c.json b/tests/testthat/2024.08.0/__api__/v1/groups/ae5c3b2c.json new file mode 100644 index 00000000..97b17dba --- /dev/null +++ b/tests/testthat/2024.08.0/__api__/v1/groups/ae5c3b2c.json @@ -0,0 +1,5 @@ +{ + "guid": "ae5c3b2c", + "name": "group12", + "owner_guid": "434f97ab" +} diff --git a/tests/testthat/_snaps/groups.md b/tests/testthat/_snaps/groups.md index ada1de22..b25b142c 100644 --- a/tests/testthat/_snaps/groups.md +++ b/tests/testthat/_snaps/groups.md @@ -12,3 +12,17 @@ 4 ae5c3b2c group12 content_guid content_name content_title # i 2 more variables: `"access_type"` , role +# get_group_content() works when just provided group guids + + Code + get_group_content(client, group_guids) + Output + # A tibble: 4 x 7 + group_guid group_name `"content_guid"` `"content_name"` `"content_title"` + + 1 a6fb5cea connect_dev content_guid content_name content_title + 2 a6fb5cea connect_dev content_guid content_name content_title + 3 a6fb5cea connect_dev content_guid content_name content_title + 4 ae5c3b2c group12 content_guid content_name content_title + # i 2 more variables: `"access_type"` , role + diff --git a/tests/testthat/test-groups.R b/tests/testthat/test-groups.R index 42f84dfa..ad067ed5 100644 --- a/tests/testthat/test-groups.R +++ b/tests/testthat/test-groups.R @@ -127,4 +127,13 @@ with_mock_api({ expect_snapshot(get_group_content(client, groups_df)) }) + + test_that("get_group_content() works when just provided group guids", { + group_guids <- c( + "a6fb5cea", + "ae5c3b2c" + ) + + expect_snapshot(get_group_content(client, group_guids)) + }) }) From e1525f78c8446e4502ebe4801118d73ed414152b Mon Sep 17 00:00:00 2001 From: Toph Allen Date: Fri, 22 Nov 2024 14:56:57 -0500 Subject: [PATCH 06/12] use .data, damn the warnings --- R/groups.R | 11 +++++---- tests/testthat/_snaps/groups.md | 42 ++++++++++++++++++++++----------- 2 files changed, 34 insertions(+), 19 deletions(-) diff --git a/R/groups.R b/R/groups.R index 3501ae68..892543dc 100644 --- a/R/groups.R +++ b/R/groups.R @@ -144,6 +144,7 @@ get_group_members <- function(src, guid) { #' #' @family groups functions #' @export +#' @importFrom rlang .data get_group_content <- function(src, groups) { validate_R6_class(src, "Connect") if (inherits(groups, "data.frame")) { @@ -160,7 +161,7 @@ get_group_content <- function(src, groups) { } purrr::pmap_dfr( - dplyr::select(groups, "guid", "name"), + dplyr::select(groups, .data$guid, .data$name), get_group_content_impl, src = src ) @@ -176,10 +177,10 @@ get_group_content_impl <- function(src, guid, name) { dplyr::transmute(parsed, group_guid = guid, group_name = name, - "content_guid", - "content_name", - "content_title", - "access_type", + .data$content_guid, + .data$content_name, + .data$content_title, + .data$access_type, role = purrr::map_chr( .data$permissions, extract_role, diff --git a/tests/testthat/_snaps/groups.md b/tests/testthat/_snaps/groups.md index b25b142c..b55c5ea4 100644 --- a/tests/testthat/_snaps/groups.md +++ b/tests/testthat/_snaps/groups.md @@ -2,27 +2,41 @@ Code get_group_content(client, groups_df) + Condition + Warning: + Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0. + i Please use `"guid"` instead of `.data$guid` + Warning: + Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0. + i Please use `"name"` instead of `.data$name` Output # A tibble: 4 x 7 - group_guid group_name `"content_guid"` `"content_name"` `"content_title"` - - 1 a6fb5cea connect_dev content_guid content_name content_title - 2 a6fb5cea connect_dev content_guid content_name content_title - 3 a6fb5cea connect_dev content_guid content_name content_title - 4 ae5c3b2c group12 content_guid content_name content_title - # i 2 more variables: `"access_type"` , role + group_guid group_name content_guid content_name content_title access_type + + 1 a6fb5cea connect_dev 8b57f54e app-1197-9825-t~ app-1197-982~ acl + 2 a6fb5cea connect_dev 8bf70c85 quarto-email-de~ quarto-email~ acl + 3 a6fb5cea connect_dev fcad1958 top-queries top-queries logged_in + 4 ae5c3b2c group12 46fb83eb forecast-email-~ forecast-ema~ logged_in + # i 1 more variable: role # get_group_content() works when just provided group guids Code get_group_content(client, group_guids) + Condition + Warning: + Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0. + i Please use `"guid"` instead of `.data$guid` + Warning: + Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0. + i Please use `"name"` instead of `.data$name` Output # A tibble: 4 x 7 - group_guid group_name `"content_guid"` `"content_name"` `"content_title"` - - 1 a6fb5cea connect_dev content_guid content_name content_title - 2 a6fb5cea connect_dev content_guid content_name content_title - 3 a6fb5cea connect_dev content_guid content_name content_title - 4 ae5c3b2c group12 content_guid content_name content_title - # i 2 more variables: `"access_type"` , role + group_guid group_name content_guid content_name content_title access_type + + 1 a6fb5cea connect_dev 8b57f54e app-1197-9825-t~ app-1197-982~ acl + 2 a6fb5cea connect_dev 8bf70c85 quarto-email-de~ quarto-email~ acl + 3 a6fb5cea connect_dev fcad1958 top-queries top-queries logged_in + 4 ae5c3b2c group12 46fb83eb forecast-email-~ forecast-ema~ logged_in + # i 1 more variable: role From 856e198106d6a6bb6e3b29291294f55323721528 Mon Sep 17 00:00:00 2001 From: Toph Allen Date: Mon, 25 Nov 2024 13:57:49 -0500 Subject: [PATCH 07/12] refactor to just accept guids --- R/groups.R | 83 +++++++--------- R/ptype.R | 29 ------ man/get_group_content.Rd | 18 ++-- man/get_group_members.Rd | 2 +- .../experimental/groups/a6fb5cff/content.json | 2 + .../2024.08.0/__api__/v1/groups/a6fb5cea.json | 5 - .../2024.08.0/__api__/v1/groups/ae5c3b2c.json | 5 - tests/testthat/_snaps/groups.md | 33 ++----- tests/testthat/test-groups.R | 97 ++----------------- tests/testthat/test-ptype.R | 63 ------------ 10 files changed, 60 insertions(+), 277 deletions(-) create mode 100644 tests/testthat/2024.08.0/__api__/v1/experimental/groups/a6fb5cff/content.json delete mode 100644 tests/testthat/2024.08.0/__api__/v1/groups/a6fb5cea.json delete mode 100644 tests/testthat/2024.08.0/__api__/v1/groups/ae5c3b2c.json delete mode 100644 tests/testthat/test-ptype.R diff --git a/R/groups.R b/R/groups.R index 892543dc..afea7eda 100644 --- a/R/groups.R +++ b/R/groups.R @@ -52,7 +52,7 @@ get_groups <- function(src, page_size = 500, prefix = NULL, limit = Inf) { #' Get users within a specific group #' -#' @param src The source object +#' @param src A Connect client object #' @param guid A group GUID identifier #' #' @return @@ -107,8 +107,8 @@ get_group_members <- function(src, guid) { #' Get content access permissions for a group or groups #' -#' @param src The source object -#' @param groups Either a data frame of groups, or a character vector of group guids +#' @param src A Connect client object +#' @param guids A character vector of group guids #' #' @return #' A tibble with the following columns: @@ -131,75 +131,60 @@ get_group_members <- function(src, guid) { #' groups <- get_groups(client) #' #' # Get permissions for a single group by passing in the corresponding row. -#' get_group_content(client, groups[1, ]) +#' get_group_content(client, groups[1, "guid"]) #' dplyr::filter(groups, name = "research_scientists") %>% -#' get_group_content(client, groups = .) +#' dplyr::pull(guid) %>% +#' get_group_content(client, .) #' -#' # Get permissions for all groups by passing in the entire groups data frame. -#' get_group_content(client, groups) -#' -#' # You can also pass in a guid or guids as a character vector. -#' get_group_content(client, groups$guid[1]) +#' # Get permissions for all groups by passing in all group guids. +#' get_group_content(client, groups$guid) #' } #' #' @family groups functions #' @export #' @importFrom rlang .data -get_group_content <- function(src, groups) { +get_group_content <- function(src, guids) { validate_R6_class(src, "Connect") - if (inherits(groups, "data.frame")) { - validate_df_ptype(groups, tibble::tibble( - guid = NA_character_, - name = NA_character_ - )) - } else if (inherits(groups, "character")) { - # If a character vector, we assume we are receiving group guids, and call - # the endpoint to fetch the group name. - groups <- purrr::map_dfr(groups, src$group_details) - } else { - stop("`groups` must be a data frame or character vector.") - } - purrr::pmap_dfr( - dplyr::select(groups, .data$guid, .data$name), - get_group_content_impl, - src = src + purrr::map_dfr( + guids, + ~ get_group_content_impl(src = src, guid = .x) ) } #' @importFrom rlang .data -get_group_content_impl <- function(src, guid, name) { +get_group_content_impl <- function(src, guid) { validate_R6_class(src, "Connect") res <- src$group_content(guid) + if (length(res) == 0) { + return(tibble::tibble( + group_guid = NA_character_, + group_name = NA_character_, + content_guid = NA_character_, + content_name = NA_character_, + content_title = NA_character_, + access_type = NA_character_, + role = NA_character_ + )) + } parsed <- parse_connectapi_typed(res, connectapi_ptypes$group_content) + permissions_df <- purrr::map_dfr( + parsed$permissions, + ~ purrr::keep( + .x, + ~ .x[["principal_guid"]] == guid + ) + ) + dplyr::transmute(parsed, group_guid = guid, - group_name = name, + group_name = permissions_df$principal_name, .data$content_guid, .data$content_name, .data$content_title, .data$access_type, - role = purrr::map_chr( - .data$permissions, - extract_role, - principal_guid = guid - ) + role = permissions_df$principal_role ) } - -# Given the list of permissions for a content item, extract the role for the -# provided principal_guid -extract_role <- function(permissions, principal_guid) { - matched <- purrr::keep( - permissions, - ~ .x[["principal_guid"]] == principal_guid - ) - if (length(matched) == 1) { - return(matched[[1]][["principal_role"]]) - } else { - stop("Unexpected permissions structure.") - } - stop(glue::glue("Could not find permissions for \"{principal_guid}\"")) -} diff --git a/R/ptype.R b/R/ptype.R index 6004f54a..836cac1b 100644 --- a/R/ptype.R +++ b/R/ptype.R @@ -220,32 +220,3 @@ connectapi_ptypes <- list( permissions = NA_list_ ) ) - -# Validates an input data frame against a required schema ptype. -# 1. is a data frame or similar object; -# 2. contains all the names from the required; -# 3. that all matching names have the correct ptype. -validate_df_ptype <- function(input, required) { - if (!inherits(input, "data.frame")) { - stop("Input must be a data frame.") - } - if (!all(names(input) %in% required)) { - missing <- setdiff(names(required), names(input)) - if (length(missing) > 0) { - stop(glue::glue("Missing required columns: {paste0(missing, collapse = ', ')}")) - } - } - - for (col in names(required)) { - tryCatch( - vctrs::vec_ptype_common(input[[col]], required[[col]]), - error = function(e) { - stop(glue::glue( - "Column `{col}` has type `{vctrs::vec_ptype_abbr(input[[col]])}`; ", - "needs `{vctrs::vec_ptype_abbr(required[[col]])}:`\n", - conditionMessage(e) - )) - } - ) - } -} diff --git a/man/get_group_content.Rd b/man/get_group_content.Rd index 33022952..dd2d7b33 100644 --- a/man/get_group_content.Rd +++ b/man/get_group_content.Rd @@ -4,12 +4,12 @@ \alias{get_group_content} \title{Get content access permissions for a group or groups} \usage{ -get_group_content(src, groups) +get_group_content(src, guids) } \arguments{ -\item{src}{The source object} +\item{src}{A Connect client object} -\item{groups}{Either a data frame of groups, or a character vector of group guids} +\item{guids}{A character vector of group guids} } \value{ A tibble with the following columns: @@ -36,15 +36,13 @@ client <- connect() groups <- get_groups(client) # Get permissions for a single group by passing in the corresponding row. -get_group_content(client, groups[1, ]) +get_group_content(client, groups[1, "guid"]) dplyr::filter(groups, name = "research_scientists") \%>\% - get_group_content(client, groups = .) + dplyr::pull(guid) \%>\% + get_group_content(client, .) -# Get permissions for all groups by passing in the entire groups data frame. -get_group_content(client, groups) - -# You can also pass in a guid or guids as a character vector. -get_group_content(client, groups$guid[1]) +# Get permissions for all groups by passing in all group guids. +get_group_content(client, groups$guid) } } diff --git a/man/get_group_members.Rd b/man/get_group_members.Rd index 33531292..8b8e8586 100644 --- a/man/get_group_members.Rd +++ b/man/get_group_members.Rd @@ -7,7 +7,7 @@ get_group_members(src, guid) } \arguments{ -\item{src}{The source object} +\item{src}{A Connect client object} \item{guid}{A group GUID identifier} } diff --git a/tests/testthat/2024.08.0/__api__/v1/experimental/groups/a6fb5cff/content.json b/tests/testthat/2024.08.0/__api__/v1/experimental/groups/a6fb5cff/content.json new file mode 100644 index 00000000..0d4f101c --- /dev/null +++ b/tests/testthat/2024.08.0/__api__/v1/experimental/groups/a6fb5cff/content.json @@ -0,0 +1,2 @@ +[ +] diff --git a/tests/testthat/2024.08.0/__api__/v1/groups/a6fb5cea.json b/tests/testthat/2024.08.0/__api__/v1/groups/a6fb5cea.json deleted file mode 100644 index a5b140a9..00000000 --- a/tests/testthat/2024.08.0/__api__/v1/groups/a6fb5cea.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "guid": "a6fb5cea", - "name": "connect_dev", - "owner_guid": "1a7a5703" -} diff --git a/tests/testthat/2024.08.0/__api__/v1/groups/ae5c3b2c.json b/tests/testthat/2024.08.0/__api__/v1/groups/ae5c3b2c.json deleted file mode 100644 index 97b17dba..00000000 --- a/tests/testthat/2024.08.0/__api__/v1/groups/ae5c3b2c.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "guid": "ae5c3b2c", - "name": "group12", - "owner_guid": "434f97ab" -} diff --git a/tests/testthat/_snaps/groups.md b/tests/testthat/_snaps/groups.md index b55c5ea4..5bb02ce3 100644 --- a/tests/testthat/_snaps/groups.md +++ b/tests/testthat/_snaps/groups.md @@ -1,14 +1,7 @@ -# get_group_content() successfully gets the content for multiple groups +# get_group_content() works Code - get_group_content(client, groups_df) - Condition - Warning: - Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0. - i Please use `"guid"` instead of `.data$guid` - Warning: - Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0. - i Please use `"name"` instead of `.data$name` + get_group_content(client, group_guids) Output # A tibble: 4 x 7 group_guid group_name content_guid content_name content_title access_type @@ -19,24 +12,14 @@ 4 ae5c3b2c group12 46fb83eb forecast-email-~ forecast-ema~ logged_in # i 1 more variable: role -# get_group_content() works when just provided group guids +# get_group_content() returns an empty data frame when no content exists Code - get_group_content(client, group_guids) - Condition - Warning: - Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0. - i Please use `"guid"` instead of `.data$guid` - Warning: - Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0. - i Please use `"name"` instead of `.data$name` + get_group_content(client, group_guid) Output - # A tibble: 4 x 7 - group_guid group_name content_guid content_name content_title access_type - - 1 a6fb5cea connect_dev 8b57f54e app-1197-9825-t~ app-1197-982~ acl - 2 a6fb5cea connect_dev 8bf70c85 quarto-email-de~ quarto-email~ acl - 3 a6fb5cea connect_dev fcad1958 top-queries top-queries logged_in - 4 ae5c3b2c group12 46fb83eb forecast-email-~ forecast-ema~ logged_in + # A tibble: 1 x 7 + group_guid group_name content_guid content_name content_title access_type + + 1 # i 1 more variable: role diff --git a/tests/testthat/test-groups.R b/tests/testthat/test-groups.R index ad067ed5..a9f4c041 100644 --- a/tests/testthat/test-groups.R +++ b/tests/testthat/test-groups.R @@ -36,99 +36,10 @@ without_internet({ }) }) -test_that("extract_role() extracts the role for the named principal", { - p_list <- list( - list( - list( - principal_guid = "fake-guid-1", - principal_name = "User1", - principal_role = "author", - principal_type = "user" - ), - list( - principal_guid = "fake-target-guid", - principal_name = "connect_dev", - principal_role = "viewer", - principal_type = "group" - ) - ), - list( - list( - principal_guid = "fake-guid-2", - principal_name = "User2", - principal_role = "author", - principal_type = "user" - ), - list( - principal_guid = "fake-target-guid", - principal_name = "connect_dev", - principal_role = "publisher", - principal_type = "group" - ), - list( - principal_guid = "fake-guid-3", - principal_name = "toph", - principal_role = "publisher", - principal_type = "user" - ) - ) - ) - expect_equal( - purrr::map_chr(p_list, extract_role, principal_guid = "fake-target-guid"), - c("viewer", "publisher") - ) -}) - -test_that("extract_role() errs when multiple entries exist for the same principal", { - p_list <- list( - list( - principal_guid = "fake-guid-1", - principal_name = "User1", - principal_role = "author", - principal_type = "user" - ), - list( - principal_guid = "fake-target-guid", - principal_name = "connect_dev", - principal_role = "viewer", - principal_type = "group" - ), - list( - principal_guid = "fake-target-guid", - principal_name = "connect_dev", - principal_role = "publisher", - principal_type = "group" - ) - ) - expect_error( - extract_role(p_list, principal_guid = "fake-target-guid"), - "Unexpected permissions structure." - ) -}) - with_mock_api({ client <- Connect$new(server = "https://connect.example", api_key = "not-a-key") - test_that("get_group_content() successfully gets the content for multiple groups", { - groups_df <- tibble::tibble( - guid = c( - "a6fb5cea", - "ae5c3b2c" - ), - name = c( - "connect_dev", - "group12" - ), - owner_guid = c( - "1a7a5703", - "434f97ab" - ) - ) - - expect_snapshot(get_group_content(client, groups_df)) - }) - - test_that("get_group_content() works when just provided group guids", { + test_that("get_group_content() works", { group_guids <- c( "a6fb5cea", "ae5c3b2c" @@ -136,4 +47,10 @@ with_mock_api({ expect_snapshot(get_group_content(client, group_guids)) }) + + test_that("get_group_content() returns an empty data frame when no content exists", { + group_guid <- "a6fb5cff" + + expect_snapshot(get_group_content(client, group_guid)) + }) }) diff --git a/tests/testthat/test-ptype.R b/tests/testthat/test-ptype.R deleted file mode 100644 index b2e7d89b..00000000 --- a/tests/testthat/test-ptype.R +++ /dev/null @@ -1,63 +0,0 @@ -test_that("validate_df_ptype() accepts data frames meeting requirements", { - expect_no_error(validate_df_ptype( - input = tibble::tibble( - guid = NA_character_, - name = NA_character_, - owner_guid = NA_character_ - ), - required = tibble::tibble( - guid = NA_character_, - name = NA_character_ - ) - )) -}) - -test_that("validate_df_ptype() rejects data missing required names", { - expect_error( - validate_df_ptype( - input = tibble::tibble( - content_guid = NA_character_, - content_name = NA_character_, - owner_guid = NA_character_ - ), - required = tibble::tibble( - guid = NA_character_, - name = NA_character_ - ) - ), - "Missing required columns: guid, name" - ) -}) - -test_that("validate_df_ptype() rejects data missing required names", { - expect_error( - validate_df_ptype( - input = tibble::tibble( - content_guid = NA_character_, - content_name = NA_character_, - owner_guid = NA_character_ - ), - required = tibble::tibble( - guid = NA_character_, - name = NA_character_ - ) - ), - "Missing required columns: guid, name" - ) -}) - -test_that("validate_df_ptype() rejects data with wrong types", { - expect_error( - validate_df_ptype( - input = tibble::tibble( - guid = NA_integer_, - name = NA_character_ - ), - required = tibble::tibble( - guid = NA_character_, - name = NA_character_ - ) - ), - "Column `guid` has type `int`; needs `chr:`" - ) -}) From 1bab41cf84bbe9612e099ac79e2ef13c2a166288 Mon Sep 17 00:00:00 2001 From: Toph Allen Date: Tue, 26 Nov 2024 11:23:35 -0500 Subject: [PATCH 08/12] Update R/groups.R Co-authored-by: Jonathan Keane --- R/groups.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/groups.R b/R/groups.R index afea7eda..31bbb144 100644 --- a/R/groups.R +++ b/R/groups.R @@ -178,13 +178,13 @@ get_group_content_impl <- function(src, guid) { ) ) - dplyr::transmute(parsed, + tibble::tibble( group_guid = guid, group_name = permissions_df$principal_name, - .data$content_guid, - .data$content_name, - .data$content_title, - .data$access_type, + content_guid = parsed$content_guid, + content_name = parsed$content_name, + content_title = parsed$content_title, + access_type = parsed$access_type, role = permissions_df$principal_role ) } From cfb514d6bf41d4cbd3986f70f70fb5388cb8a366 Mon Sep 17 00:00:00 2001 From: Toph Allen Date: Tue, 26 Nov 2024 18:32:22 -0500 Subject: [PATCH 09/12] incorporate naming suggestion --- R/groups.R | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/R/groups.R b/R/groups.R index 31bbb144..9c31fd11 100644 --- a/R/groups.R +++ b/R/groups.R @@ -142,18 +142,16 @@ get_group_members <- function(src, guid) { #' #' @family groups functions #' @export -#' @importFrom rlang .data get_group_content <- function(src, guids) { validate_R6_class(src, "Connect") purrr::map_dfr( guids, - ~ get_group_content_impl(src = src, guid = .x) + ~ get_one_group_content(src = src, guid = .x) ) } -#' @importFrom rlang .data -get_group_content_impl <- function(src, guid) { +get_one_group_content <- function(src, guid) { validate_R6_class(src, "Connect") res <- src$group_content(guid) @@ -178,7 +176,7 @@ get_group_content_impl <- function(src, guid) { ) ) - tibble::tibble( + tibble::tibble( group_guid = guid, group_name = permissions_df$principal_name, content_guid = parsed$content_guid, From ed9ef94db2ecdf09a05320b3626788acb5e45871 Mon Sep 17 00:00:00 2001 From: Toph Allen Date: Tue, 26 Nov 2024 18:34:05 -0500 Subject: [PATCH 10/12] remove group_details --- R/connect.R | 7 ------- 1 file changed, 7 deletions(-) diff --git a/R/connect.R b/R/connect.R index c1227bb5..b7a347d2 100644 --- a/R/connect.R +++ b/R/connect.R @@ -694,13 +694,6 @@ Connect <- R6::R6Class( self$GET(path) }, - #' @description Get the details for a group - #' @param guid The group GUID. - group_details = function(guid) { - path <- v1_url("groups", guid) - self$GET(path) - }, - # instrumentation -------------------------------------------- #' @description Get (non-interactive) content visits. From e3bc1ecdf96130564bab2fd6f6ea4df51cbbc9bd Mon Sep 17 00:00:00 2001 From: Toph Allen Date: Wed, 27 Nov 2024 14:50:51 -0500 Subject: [PATCH 11/12] respond to feedback --- NAMESPACE | 1 - R/groups.R | 4 +--- man/PositConnect.Rd | 18 ------------------ 3 files changed, 1 insertion(+), 22 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 8e461c8d..c73aa816 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -148,7 +148,6 @@ importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") importFrom(rlang,"%||%") importFrom(rlang,":=") -importFrom(rlang,.data) importFrom(rlang,arg_match) importFrom(utils,browseURL) importFrom(utils,capture.output) diff --git a/R/groups.R b/R/groups.R index 9c31fd11..db668207 100644 --- a/R/groups.R +++ b/R/groups.R @@ -100,9 +100,7 @@ get_group_members <- function(src, guid) { res <- src$group_members(guid) - out <- parse_connectapi(res$results) - - return(out) + parse_connectapi(res$results) } #' Get content access permissions for a group or groups diff --git a/man/PositConnect.Rd b/man/PositConnect.Rd index 967189f6..72e56163 100644 --- a/man/PositConnect.Rd +++ b/man/PositConnect.Rd @@ -115,7 +115,6 @@ Other R6 classes: \item \href{#method-Connect-groups_create_remote}{\code{Connect$groups_create_remote()}} \item \href{#method-Connect-groups_remote}{\code{Connect$groups_remote()}} \item \href{#method-Connect-group_content}{\code{Connect$group_content()}} -\item \href{#method-Connect-group_details}{\code{Connect$group_details()}} \item \href{#method-Connect-inst_content_visits}{\code{Connect$inst_content_visits()}} \item \href{#method-Connect-inst_shiny_usage}{\code{Connect$inst_shiny_usage()}} \item \href{#method-Connect-procs}{\code{Connect$procs()}} @@ -1100,23 +1099,6 @@ Get content to which a group has access \if{html}{\out{
}}\preformatted{Connect$group_content(guid)}\if{html}{\out{
}} } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{guid}}{The group GUID.} -} -\if{html}{\out{
}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-Connect-group_details}{}}} -\subsection{Method \code{group_details()}}{ -Get the details for a group -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Connect$group_details(guid)}\if{html}{\out{
}} -} - \subsection{Arguments}{ \if{html}{\out{
}} \describe{ From 18953f94419582becb9825597ba91b315dcf4123 Mon Sep 17 00:00:00 2001 From: Toph Allen Date: Wed, 27 Nov 2024 15:10:39 -0500 Subject: [PATCH 12/12] least worst option for name --- R/groups.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/groups.R b/R/groups.R index db668207..300b8b02 100644 --- a/R/groups.R +++ b/R/groups.R @@ -145,11 +145,11 @@ get_group_content <- function(src, guids) { purrr::map_dfr( guids, - ~ get_one_group_content(src = src, guid = .x) + ~ get_one_groups_content(src = src, guid = .x) ) } -get_one_group_content <- function(src, guid) { +get_one_groups_content <- function(src, guid) { validate_R6_class(src, "Connect") res <- src$group_content(guid)