Switch audit_* functions to use content not "apps"; replace audit_vanity_urls (#271)

Author: nealrichardson

.Rbuildignore

@@ -16,4 +16,5 @@
 ^connectapi\.Rcheck$
 ^connectapi.*\.tar\.gz$
 ^connectapi.*\.tgz$
-\.orig$
+\.orig$
+^.lintr$

.lintr

@@ -0,0 +1,3 @@
+linters: linters_with_defaults(
+  line_length_linter = line_length_linter(100)
+  )

NAMESPACE

@@ -27,15 +27,13 @@ export(VariantSchedule)
 export(audit_access_open)
 export(audit_r_versions)
 export(audit_runas)
-export(audit_vanity_urls)
 export(browse_api_docs)
 export(browse_connect)
 export(browse_dashboard)
 export(browse_solo)
 export(bundle_dir)
 export(bundle_path)
 export(bundle_static)
-export(cache_apps)
 export(connect)
 export(content_add_group)
 export(content_add_user)
@@ -131,6 +129,7 @@ export(swap_vanity_url)
 export(tbl_connect)
 export(user_guid_from_username)
 export(users_create_remote)
+export(vanity_is_available)
 export(variant_render)
 export(verify_content_name)
 importFrom(lifecycle,deprecate_warn)

NEWS.md

@@ -6,6 +6,9 @@
 - The functions `Connect$download_bundle()` and
   `Connect$bundle_delete()` have been removed. Use `Content$bundle_download()`
   and `Content$bundle_delete()` instead.
+- `audit_vanity_urls()` has been removed. To check if a vanity URL is in use,
+  use `vanity_is_available()` instead.
+- Other `audit_*` functions have been modified to accept the result of `get_content()` rather than `cache_apps()` (which is now removed). They are faster as a result.
 - dplyr is no longer a required dependency. If you use `tbl_connect()`,
   you will need to install dplyr and dbplyr explicitly. (#246)
 

R/audits.R

@@ -1,106 +1,45 @@
-get_field <- function(apps, field, include_null = FALSE) {
-  all <- lapply(apps, function(x) {
-    x[[field]]
-  })
-  empty <- sapply(all, is.null)
-
-  if (!include_null) {
-    return(all[!empty])
-  }
-  all
-}
-
-#' Get information on all apps for a server
-#'
-#' \lifecycle{experimental}
-#'
-#' @param connect A Connect object
-#'
-#' @return List with application data, to be used by audit functions
-#' @family audit functions
-#' @export
-cache_apps <- function(connect) {
-  apps <- connect$get_apps()
-  apps
-}
-
-#' Audit Vanity URLs
+#' Check to see if a vanity URL is currently in use
 #'
 #' \lifecycle{experimental}
 #'
-#' @param apps App list, see [cache_apps()]
-#' @param server_url Base url for the Connect server
-#' @param vanity Optional, see details
+#' @param connect A Connect R6 object
+#' @param vanity string of the vanity URL to check
 #'
-#' @details If `vanity` is not provided, returns a list of all the vanity
-#'   urls in use. If `vanity` is provided, returns whether or not
-#'   `vanity` is eligible as a vanity url.
+#' @return logical indicating if the vanity URL is available.
 #'
 #' @family audit functions
 #' @export
-audit_vanity_urls <- function(apps, server_url, vanity = NULL) {
-  # TODO: why does vanities not work?
-  urls <- get_field(apps, "url")
-  parse_server <- httr::parse_url(server_url)
-  if (is.null(parse_server$scheme)) {
-    stop(glue::glue("ERROR: protocol (i.e. http:// or https://) not defined on server_url={server_url}"))
-  }
-  content <- sapply(urls, function(u) {
-    trim_vanity(u, parse_server$path)
-  })
+vanity_is_available <- function(connect, vanity) {
+  current_vanities <- connect$GET(v1_url("vanities"))
+  current_vanity_paths <- purrr::map_chr(current_vanities, "path")
 
-  vanities <- content[!grepl("content/\\d+", content)]
+  # In case a full URL has been given, prune it down to just the path
+  vanity <- sub(paste0("^", connect$server), "", vanity)
+  # and make sure it has a leading and trailing slash
+  vanity <- sub("^/?(.*[^/])/?$", "/\\1/", vanity)
 
-  if (!is.null(vanity)) {
-    return(
-      ifelse(sprintf("%s/", vanity) %in% vanities, sprintf("%s Not Available", vanity), sprintf("%s Available", vanity))
-    )
-  }
-  vanities
+  !(vanity %in% current_vanity_paths)
 }
 
-trim_vanity <- function(url, server_path) {
-  parsed_url <- httr::parse_url(url)
-  if (nchar(server_path) > 0) {
-    # remove the trailing slash
-    server_path <- base::sub("^(.*)/$", "\\1", server_path)
-    vanity <- sub(server_path, "", parsed_url$path)
-  } else {
-    vanity <- parsed_url$path
-  }
-
-  # ensure leading and trailing slash
-  base::sub("^/?(.*[^/])/?$", "/\\1/", vanity)
-}
-
-
 #' Audit R Versions
 #'
 #' \lifecycle{experimental}
 #'
-#' @param apps App list, see `cache_apps`
+#' @param content `data.frame` of content information, as from [get_content()]
 #'
 #' @return A plot that shows the R version used by content over time and in
 #'   aggregate.
 #' @family audit functions
 #' @export
-audit_r_versions <- function(apps) {
-  r_versions <- get_field(apps, "r_version", TRUE)
-  published <- get_field(apps, "last_deployed_time", TRUE)
+audit_r_versions <- function(content) {
+  if (!requireNamespace("ggplot2", quietly = TRUE)) {
+    stop("ggplot2 is required for this function")
+  }
+  if (!requireNamespace("gridExtra", quietly = TRUE)) {
+    stop("gridExtra is required for this function")
+  }
 
-  # TODO: this is not pretty
-  timeline <- data.frame(
-    stringsAsFactors = FALSE,
-    r_version = unlist(r_versions),
-    published = do.call(c, unname( # this flattens the list while preserving the date time
-      lapply(
-        published[!sapply(r_versions, is.null)], # filter out records w/o r version
-        function(d) {
-          lubridate::ymd_hms(d)
-        }
-      ) # convert to date time
-    ))
-  )
+  timeline <- content[!is.na(content$r_version), c("r_version", "last_deployed_time")]
 
   # histogram
   p1 <- ggplot2::ggplot(timeline) +
@@ -114,7 +53,7 @@ audit_r_versions <- function(apps) {
 
   # timeline
   p2 <- ggplot2::ggplot(timeline) +
-    ggplot2::geom_point(pch = 4, ggplot2::aes(x = published, color = r_version, y = r_version)) +
+    ggplot2::geom_point(pch = 4, ggplot2::aes(x = last_deployed_time, color = r_version, y = r_version)) +
     ggplot2::theme_minimal() +
     ggplot2::labs(
       title = "Content by Time",
@@ -130,66 +69,31 @@ audit_r_versions <- function(apps) {
 #'
 #' \lifecycle{experimental}
 #'
-#' @param apps App list, see `cache_apps`
+#' @param content `data.frame` of content information, as from [get_content()]
 #'
 #' @return A data frame with the app name and the Run As user if the Run As user
 #'   is not the default
 #' @family audit functions
 #' @export
-audit_runas <- function(apps) {
-  name <- get_field(apps, "name", TRUE)
-  run_as <- get_field(apps, "run_as", TRUE)
-  set <- !sapply(run_as, is.null)
-
-  run_as <- data.frame(
-    stringsAsFactors = FALSE,
-    app_name = unlist(name[set]),
-    run_as_user = unlist(run_as)
-  )
-
-  run_as_current <- get_field(apps, "run_as_current_user", TRUE)
-  set <- sapply(run_as_current, function(x) {
-    x == TRUE
-  })
-
-  if (sum(set > 0)) {
-    run_as_current <- data.frame(
-      stringsAsFactors = FALSE,
-      app_name = unlist(name[set]),
-      run_as_user = "current user"
-    )
-  } else {
-    run_as_current <- NULL
-  }
-
-
-  return(
-    rbind(run_as, run_as_current)
-  )
+audit_runas <- function(content) {
+  content$run_as <- ifelse(content$run_as_current_user, "current user", content$run_as)
+  content <- content[!is.na(content$run_as), c("name", "run_as")]
+  names(content) <- c("app_name", "run_as_user")
+  content
 }
 
 # type can be all, logged_in, acl
 #' Audit Access Controls
 #'
 #' \lifecycle{experimental}
 #'
-#' @param apps App list, see `cache_apps`
+#' @param content `data.frame` of content information, as from [get_content()]
 #' @param type One of "all" or "logged_in". If "all", return a list of apps
 #'   whose access control is set to "Everyone". If "logged_in", return a list of
 #'   apps whose access control is set to "All logged in users"
 #'
 #' @family audit functions
 #' @export
-audit_access_open <- function(apps, type = "all") {
-  access <- get_field(apps, "access_type", TRUE)
-  name <- get_field(apps, "name", TRUE)
-  acl_set <- !sapply(access, is.null)
-
-  access <- data.frame(
-    stringsAsFactors = FALSE,
-    name = unlist(name[acl_set]),
-    access = unlist(access)
-  )
-
-  return(access$name[access$access == type])
+audit_access_open <- function(content, type = "all") {
+  content$name[content$access_type == type]
 }

R/connectapi.R

@@ -12,6 +12,7 @@ utils::globalVariables(
     "access_type",
     "connectapi_ptypes",
     "guid",
+    "last_deployed_time",
     "owner_guid",
     "parse_connectapi_typed",
     "permission",

_pkgdown.yml

@@ -68,7 +68,6 @@ reference:
       Oher functions
     contents:
       - promote
-      - cache_apps
       - connect
       - tbl_connect
       - page_cursor