Allow exact group matches (#261)

Co-authored-by: Toph Allen <[email protected]>
Co-authored-by: Neal Richardson <[email protected]>
Co-authored-by: Barret Schloerke <[email protected]>

Author: 4 people

.gitignore

@@ -14,4 +14,5 @@ connectapi*.tgz
 *.orig
 tests/integrated/integrated-results-check.txt
 tests/integrated/testthat-problems.rds
-CRAN-SUBMISSION
+CRAN-SUBMISSION
+tests/testthat/Rplots.pdf

NEWS.md

@@ -7,6 +7,9 @@
 - New functions `set_thumbnail()`, `get_thumbnail()`, `delete_thumbnail()` and
   `has_thumbnail()` let you interact with content thumbnails, replacing older
   `*_image()` functions. (#294, #304)
+- `groups_create_remote()` now has an `exact` parameter. Setting `exact` causes
+  the function to consider only exact group name matches when searching for
+  remote groups and checking for existing local groups. (#216)
 
 ## Lifecycle changes
 

R/get.R

@@ -59,7 +59,7 @@ get_users <- function(src, page_size = 500, prefix = NULL, limit = Inf) {
 #' @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 max number of groups to return
+#' @param limit The max number of groups to return.
 #'
 #' @return
 #' A tibble with the following columns:

R/remote.R

@@ -9,14 +9,14 @@
 #' NOTE: there can be problems with usernames that are not unique. Please open
 #' an issue if you run into any problems.
 #'
-#' @param connect A R6 Connect object
-#' @param prefix character. The prefix of the user name to search for
-#' @param expect number. Optional. The number of responses to expect for this search
-#' @param check boolean. Optional. Whether to check for local existence first
+#' @param connect An R6 Connect object.
+#' @param prefix character. The prefix of the user name to search for.
+#' @param expect number. Optional. The number of responses to expect for this search.
+#' @param check boolean. Optional. Whether to check for local existence first.
 #' @param exact boolean. Optional. Whether to only create users whose username
 #'   exactly matches the provided `prefix`.
 #'
-#' @return The results of creating the users
+#' @return The results of creating the users.
 #'
 #' @export
 users_create_remote <- function(connect, prefix, expect = 1, check = TRUE, exact = FALSE) {
@@ -63,39 +63,50 @@ users_create_remote <- function(connect, prefix, expect = 1, check = TRUE, exact
 
 #' Create a Remote Group
 #'
-#' @param connect A R6 Connect object
-#' @param prefix character. The prefix of the group name to search for
-#' @param expect number. The number of responses to expect for this search
-#' @param check boolean. Whether to check for local existence first
+#' @param connect An R6 Connect object.
+#' @param prefix character. The prefix of the user name to search for.
+#' @param expect number. Optional. The number of responses to expect for this search.
+#' @param check boolean. Optional. Whether to check for local existence first.
+#' @param exact boolean. Optional. Whether to only create groups whose name
+#'   exactly matches the provided `prefix`.
 #'
-#' @return The results of creating the groups
+#' @return The results of creating the groups.
 #'
 #' @export
-groups_create_remote <- function(connect, prefix, expect = 1, check = TRUE) {
+groups_create_remote <- function(connect, prefix, expect = 1, check = TRUE, exact = FALSE) {
   expect <- as.integer(expect)
-  if (check && expect > 1) {
-    stop(glue::glue("expect > 1 is not tested. Please set expect = 1, and specify a more narrow 'prefix'. You provided: expect={expect}"))
-  }
   if (check) {
     # TODO: limit = 1 due to a paging bug in Posit Connect
-    local_groups <- get_groups(connect, prefix = prefix, limit = 1)
+    local_groups <- get_groups(connect, page_size = 500, prefix = prefix, limit = 1)
+    if (exact) {
+      local_groups <- local_groups[local_groups["name"] == prefix, ]
+    }
     if (nrow(local_groups) > 0) {
-      message(glue::glue("At least one group with name prefix '{prefix}' already exists"))
+      if (!exact) {
+        message(glue::glue("At least one group with name prefix '{prefix}' already exists"))
+      } else {
+        message(glue::glue("A group with the name '{prefix}' already exists"))
+
+      }
       return(local_groups)
     }
   }
 
   remote_groups <- connect$groups_remote(prefix = prefix)
-  if (remote_groups$total != expect) {
-    message(glue::glue("Found {remote_groups$total} remote groups. Expected {expect}"))
-    if (remote_groups$total > 0) {
-      group_str <- toString(purrr::map_chr(remote_groups$results, ~ .x[["name"]]))
-      message(glue::glue("Groups found: {group_str}"))
+  remote_groups_res <- remote_groups[["results"]]
+  if (exact) {
+    remote_groups_res <- purrr::keep(remote_groups_res, ~ .x[["name"]] == prefix)
+  }
+  if (length(remote_groups_res) != expect) {
+    message(glue::glue("Found {length(remote_groups_res)} remote groups. Expected {expect}"))
+    if (length(remote_groups_res) > 0) {
+      groups_found <- glue::glue_collapse(purrr::map_chr(remote_groups_res, ~ .x[["name"]]), sep = ", ")
+      message(glue::glue("Groups found: {groups_found}"))
     }
     stop("The expected group(s) were not found. Please specify a more accurate 'prefix'")
   }
   group_creation <- purrr::map(
-    remote_groups$results,
+    remote_groups_res,
     function(.x, src) {
       message(glue::glue("Creating remote group: {.x[['name']]}"))
       src$groups_create_remote(temp_ticket = .x[["temp_ticket"]])

man/get_groups.Rd

@@ -0,0 +1,9 @@
+{
+    "results": [
+        {
+            "name": "Everyone Else"
+        }
+    ],
+    "current_page": 1,
+    "total": 1
+}

man/groups_create_remote.Rd

@@ -0,0 +1,7 @@
+// v1/groups?page_number=1&page_size=500&prefix=Art
+{
+    "results": [
+    ],
+    "current_page": 1,
+    "total": 0
+}

man/users_create_remote.Rd

@@ -0,0 +1,6 @@
+{
+    "results": [
+    ],
+    "current_page": 1,
+    "total": 0
+}

tests/testthat/2024.08.0/__api__/v1/groups-5f8a7c.json

@@ -0,0 +1,6 @@
+// v1/groups {"temp_ticket":"fake-art"}
+{
+    "guid": "1c1ab604-4a6a-4d07-9477-a88ac08386cd",
+    "name": "Art",
+    "owner_guid": null
+}

tests/testthat/2024.08.0/__api__/v1/groups-abb1cb.json

@@ -0,0 +1,17 @@
+// v1/groups/remote?limit=500&prefix=Art
+{
+    "results": [
+        {
+            "name": "Art",
+            "guid": null,
+            "temp_ticket": "fake-art"
+        },
+        {
+            "name": "Arthur O Eve - E O P Program",
+            "guid": null,
+            "temp_ticket": "fake-arthur"
+        }
+    ],
+    "current_page": 1,
+    "total": 2
+}

tests/testthat/2024.08.0/__api__/v1/groups-ae20d8.json

@@ -0,0 +1,6 @@
+{
+    "results": [
+    ],
+    "current_page": 1,
+    "total": 1
+}

tests/testthat/2024.08.0/__api__/v1/groups-fdf22e-PUT.json

@@ -46,18 +46,23 @@ MockConnect <- R6Class(
       self$api_key <- "fake"
       private$.version <- version
     },
+    # The request function matches the route against the routes in the names of
+    # the response list. When a response is selected, it is removed from the
+    # list.
     request = function(method, url, ..., parser = "parsed") {
       route <- paste(method, url)
-      print(route)
 
       # Record call
       self$log_call(route)
 
       # Look for response
       if (!(route %in% names(self$responses))) {
-        stop("Unexpected route")
+        stop(glue::glue("Unexpected route: {route}"))
       }
-      res <- self$responses[[route]]
+
+      idx <- match(route, names(self$responses))
+      res <- self$responses[[idx]]
+      self$responses <- self$responses[-idx]
 
       if (is.null(parser)) {
         res
@@ -67,12 +72,22 @@ MockConnect <- R6Class(
       }
     },
     responses = list(),
+    # Add a response to a list of responses. The response is keyed according to
+    # its route, represented as `{VERB} {URL}`. The URL is constructed as an API
+    # URL for the server (this will probably have to change in the future). Each
+    # response can only be used once. You can supply multiple responses for the
+    # same URL.
     mock_response = function(method, path, content, status_code = 200L, headers = c("Content-Type" = "application/json; charset=utf-8")) {
       url <- self$api_url(path)
-      route <- paste(method, url)
-      print(route)
+    
       res <- new_mock_response(url, content, status_code, headers)
-      self$responses[[route]] <- res
+
+      route <- paste(method, url)
+      new_response <- list(res)
+      new_response <- setNames(new_response, route)
+
+      self$responses <- append(self$responses, new_response)
+
     },
     call_log = character(),
     log_call = function(route) {
@@ -91,7 +106,7 @@ new_mock_response <- function(url, content, status_code, headers = character())
   if (is.character(content) && length(content) == 1) {
     content <- charToRaw(content)
   } else if (is.list(content)) {
-    content <- charToRaw(jsonlite::toJSON(content, auto_unbox = TRUE))
+    content <- charToRaw(jsonlite::toJSON(content, auto_unbox = TRUE, null = "null"))
   }
 
   structure(