From b14c8eff56dd3ddce0284d6094bf7909a8ecd96a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Fri, 24 Oct 2025 09:20:50 +0200 Subject: [PATCH 01/77] Updated OAuth2 authentication process and token management --- DESCRIPTION | 2 +- NAMESPACE | 1 + R/CONSTANTS.R | 26 ++- R/auth_service.R | 111 ++++++++++ R/auth_state.R | 74 +++++++ R/auth_utils.R | 134 ++++++++++++ R/login_db.R | 230 ++++++++------------- R/logout_db.R | 29 +-- R/make_default_request.R | 49 +++-- R/token_helpers.R | 61 ++++++ R/whoami.R | 57 +++++ README.Rmd | 17 +- man/login_db.Rd | 17 +- man/logout_db.Rd | 2 +- man/make_default_request.Rd | 22 +- man/whoami.Rd | 29 +++ tests/testthat/test-login_db.R | 44 ++-- tests/testthat/test-logout_db.R | 9 +- tests/testthat/test-make_default_request.R | 15 ++ tests/testthat/test-whoami.R | 29 +++ 20 files changed, 729 insertions(+), 229 deletions(-) create mode 100644 R/auth_service.R create mode 100644 R/auth_state.R create mode 100644 R/auth_utils.R create mode 100644 R/token_helpers.R create mode 100644 R/whoami.R create mode 100644 man/whoami.Rd create mode 100644 tests/testthat/test-whoami.R diff --git a/DESCRIPTION b/DESCRIPTION index a91bbb3d..dd58e65b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -46,4 +46,4 @@ Config/testthat/edition: 3 Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.3 diff --git a/NAMESPACE b/NAMESPACE index 0a4166b8..9b6da36c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -49,6 +49,7 @@ export(make_login_client) export(search_for_funder) export(search_for_keywords) export(search_for_tags) +export(whoami) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") importFrom(methods,is) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 07b70d86..ebe26b03 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -2,6 +2,8 @@ #' #' +# Legacy endpoints (temporary until all functions migrated) ------------------- + API_CONSTANTS <- "https://nyu.databrary.org/api/constants" CREATE_SLOT <- @@ -47,8 +49,8 @@ GET_ASSET_BY_ID <- "https://nyu.databrary.org/api/asset/%s" GET_ASSET_BY_VOLUME_SESSION_ID <- "https://nyu.databrary.org/api/volume/%s/slot/%s/asset/%s" -LOGIN <- "https://nyu.databrary.org/api/user/login" -LOGOUT <- "https://nyu.databrary.org/api/user/logout" +# LOGIN <- "https://nyu.databrary.org/api/user/login" +# LOGOUT <- "https://nyu.databrary.org/api/user/logout" QUERY_SLOT <- "https://nyu.databrary.org/api/slot/%s/-?records&assets&excerpts&tags&comments" @@ -62,9 +64,9 @@ UPLOAD_CHUNK <- "https://nyu.databrary.org/api/upload" UPDATE_SLOT <- "https://nyu.databrary.org/api/slot/%s" # Authentication parameters -USER_AGENT <- - "databraryr (https://cran.r-project.org/package=databraryr)" -KEYRING_SERVICE <- 'org.databrary.databraryr' +# USER_AGENT <- +# "databraryr (https://cran.r-project.org/package=databraryr)" +# KEYRING_SERVICE <- 'org.databrary.databraryr' # httr2 request parameters RETRY_LIMIT <- 3 @@ -72,3 +74,17 @@ RETRY_WAIT_TIME <- 1 # seconds RETRY_BACKOFF <- 2 # exponential backoff REQUEST_TIMEOUT <- 5 # seconds REQUEST_TIMEOUT_VERY_LONG <- 600 + +# Base host ----------------------------------------------------------------- + +DATABRARY_BASE_URL <- Sys.getenv("DATABRARY_BASE_URL", "https://api.stg-databrary.its.nyu.edu") + +# OAuth endpoints ------------------------------------------------------------- + +OAUTH_TOKEN_URL <- sprintf("%s/o/token/", DATABRARY_BASE_URL) +OAUTH_TEST_URL <- sprintf("%s/oauth2/test/", DATABRARY_BASE_URL) + +# Authentication parameters --------------------------------------------------- + +USER_AGENT <- Sys.getenv("USER_AGENT", "SRW$*Kxy2nYdyo4LozoGV#i6LvH/") +KEYRING_SERVICE <- 'org.databrary.databraryr' diff --git a/R/auth_service.R b/R/auth_service.R new file mode 100644 index 00000000..b747ca8e --- /dev/null +++ b/R/auth_service.R @@ -0,0 +1,111 @@ +# OAuth2 network operations --------------------------------------------------- + +httr2_error_message <- function(resp) { + if (is.null(resp)) { + return("Request failed before receiving a response.") + } + status <- httr2::resp_status(resp) + if (status < 400) { + return(NULL) + } + body <- try(httr2::resp_body_json(resp), silent = TRUE) + if (!inherits(body, "try-error") && is.list(body)) { + fields <- c(body$error_description, body$error, body$detail) + fields <- fields[!vapply(fields, is_missing_string, logical(1))] + if (length(fields)) { + return(paste0("HTTP ", status, ": ", fields[[1]])) + } + } + sprintf("HTTP %s returned with empty error body.", status) +} + +#' @noRd +oauth_password_grant <- function(username, + password, + client_id, + client_secret, + vb = FALSE) { + assertthat::assert_that(assertthat::is.string(username)) + assertthat::assert_that(assertthat::is.string(password)) + assertthat::assert_that(assertthat::is.string(client_id)) + assertthat::assert_that(assertthat::is.string(client_secret)) + + req <- make_default_request(with_token = FALSE) |> + httr2::req_url(OAUTH_TOKEN_URL) + + resp <- tryCatch( + req |> + httr2::req_body_form( + grant_type = "password", + username = username, + password = password, + client_id = client_id, + client_secret = client_secret + ) |> + httr2::req_perform(), + error = function(err) { + if (vb) message("OAuth token request failed: ", conditionMessage(err)) + NULL + } + ) + + if (is.null(resp)) { + return(NULL) + } + + if (httr2::resp_status(resp) >= 400) { + if (vb) message(httr2_error_message(resp)) + return(NULL) + } + + payload <- httr2::resp_body_json(resp) + list( + access_token = payload$access_token, + refresh_token = if (is.null(payload$refresh_token)) NULL else payload$refresh_token, + expires_in = if (is.null(payload$expires_in)) 3600 else payload$expires_in + ) +} + +#' @noRd +oauth_refresh_grant <- function(refresh_token, + client_id, + client_secret, + vb = FALSE) { + assertthat::assert_that(assertthat::is.string(refresh_token)) + assertthat::assert_that(assertthat::is.string(client_id)) + assertthat::assert_that(assertthat::is.string(client_secret)) + + req <- make_default_request() |> + httr2::req_url(OAUTH_TOKEN_URL) + + resp <- tryCatch( + req |> + httr2::req_body_form( + grant_type = "refresh_token", + refresh_token = refresh_token, + client_id = client_id, + client_secret = client_secret + ) |> + httr2::req_perform(), + error = function(err) { + if (vb) message("OAuth refresh request failed: ", conditionMessage(err)) + NULL + } + ) + + if (is.null(resp)) { + return(NULL) + } + + if (httr2::resp_status(resp) >= 400) { + if (vb) message(httr2_error_message(resp)) + return(NULL) + } + + payload <- httr2::resp_body_json(resp) + list( + access_token = payload$access_token, + refresh_token = if (is.null(payload$refresh_token)) refresh_token else payload$refresh_token, + expires_in = if (is.null(payload$expires_in)) 3600 else payload$expires_in + ) +} diff --git a/R/auth_state.R b/R/auth_state.R new file mode 100644 index 00000000..899b8ff4 --- /dev/null +++ b/R/auth_state.R @@ -0,0 +1,74 @@ +# Token state management ------------------------------------------------------- + +.databrary_token_env <- new.env(parent = emptyenv()) + +#' @noRd +set_token_bundle <- function(access_token, + refresh_token = NULL, + expires_in = NULL, + issued_at = Sys.time(), + client_id = NULL, + client_secret = NULL, + username = NULL) { + assertthat::assert_that(assertthat::is.string(access_token)) + .databrary_token_env$access_token <- access_token + .databrary_token_env$refresh_token <- if (is_missing_string(refresh_token)) NULL else refresh_token + .databrary_token_env$issued_at <- issued_at + if (is.null(expires_in)) { + .databrary_token_env$expires_at <- NULL + } else { + assertthat::assert_that(is.numeric(expires_in), length(expires_in) == 1) + .databrary_token_env$expires_at <- issued_at + as.difftime(as.numeric(expires_in), units = "secs") + } + .databrary_token_env$client_id <- if (is_missing_string(client_id)) NULL else client_id + .databrary_token_env$client_secret <- if (is_missing_string(client_secret)) NULL else client_secret + .databrary_token_env$username <- if (is_missing_string(username)) NULL else username + invisible(.databrary_token_env) +} + +#' @noRd +get_token_bundle <- function() { + if (!is.null(.databrary_token_env$access_token)) { + return(list( + access_token = .databrary_token_env$access_token, + refresh_token = .databrary_token_env$refresh_token, + expires_at = .databrary_token_env$expires_at, + issued_at = .databrary_token_env$issued_at, + client_id = .databrary_token_env$client_id, + client_secret = .databrary_token_env$client_secret, + username = .databrary_token_env$username + )) + } + NULL +} + +#' @noRd +clear_token_bundle <- function() { + rm(list = ls(.databrary_token_env), envir = .databrary_token_env) + invisible(NULL) +} + +#' @noRd +token_should_refresh <- function() { + bundle <- get_token_bundle() + if (is.null(bundle)) { + return(FALSE) + } + expires_at <- bundle$expires_at + if (is.null(expires_at)) { + return(FALSE) + } + now <- Sys.time() + now >= (expires_at - as.difftime(30, units = "secs")) +} + +#' @noRd +require_access_token <- function() { + bundle <- get_token_bundle() + if (is.null(bundle) || is_missing_string(bundle$access_token)) { + stop("No access token available. Please call login_db() first.", call. = FALSE) + } + bundle$access_token +} + + diff --git a/R/auth_utils.R b/R/auth_utils.R new file mode 100644 index 00000000..46230bac --- /dev/null +++ b/R/auth_utils.R @@ -0,0 +1,134 @@ +# Internal helpers for authentication and credential management + +#' @noRd +CREDENTIAL_ENV_VARS <- c( + email = "DATABRARY_LOGIN", + password = "DATABRARY_PASSWORD", + client_id = "DATABRARY_CLIENT_ID", + client_secret = "DATABRARY_CLIENT_SECRET" +) + +#' @noRd +is_missing_string <- function(x) { + if (is.null(x) || length(x) == 0) { + return(TRUE) + } + value <- x[[1]] + if (is.na(value)) { + return(TRUE) + } + if (!is.character(value)) { + return(FALSE) + } + trimmed <- trimws(value) + identical(trimmed, "") +} + +#' @noRd +try_keyring_get <- function(service, username, vb = FALSE) { + if (!keyring::has_keyring_support()) { + return(NULL) + } + if (is_missing_string(username)) { + return(NULL) + } + result <- try(keyring::key_get(service = service, username = username), silent = TRUE) + if (inherits(result, "try-error")) { + if (vb) { + message("No keyring entry for service='", service, "' and username='", username, "'.") + } + return(NULL) + } + if (is_missing_string(result)) { + return(NULL) + } + result +} + +#' @noRd +store_keyring_value <- function(service, username, value, vb = FALSE) { + if (!keyring::has_keyring_support()) { + return(FALSE) + } + if (is_missing_string(value) || is_missing_string(username)) { + return(FALSE) + } + outcome <- try(keyring::key_set_with_value( + service = service, + username = username, + password = value + ), silent = TRUE) + if (inherits(outcome, "try-error")) { + if (vb) { + message("Unable to store keyring entry for service='", service, "' and username='", username, "'.") + } + return(FALSE) + } + if (vb) { + message("Stored credentials in keyring service='", service, "'.") + } + TRUE +} + +#' @noRd +resolve_credential_value <- function(label, + value, + prompt_label, + service, + username = NULL, + overwrite, + vb) { + if (!is_missing_string(value)) { + assertthat::assert_that(assertthat::is.string(value)) + return(value) + } + + # Check environment variable using the static map + env_var_name <- CREDENTIAL_ENV_VARS[[label]] + env_value <- Sys.getenv(env_var_name, NA_character_) + if (!is.na(env_value) && nzchar(env_value)) { + return(env_value) + } + + # For email, skip keyring lookup since email is the identifier used for other keyring lookups + # Only do keyring lookup for client_id and other credentials that are actually stored + if (!is_missing_string(username) && !overwrite && label != "email") { + stored <- try_keyring_get(service = service, username = username, vb = vb) + if (!is.null(stored)) { + return(stored) + } + } + + message("Please enter your ", prompt_label, ".") + readline(prompt = paste0(prompt_label, ": ")) +} + +#' @noRd +resolve_secret_value <- function(label, + value, + prompt_label, + service, + username, + overwrite, + vb) { + if (!is_missing_string(value)) { + assertthat::assert_that(assertthat::is.string(value)) + return(value) + } + + # Check environment variable using the static map + env_var_name <- CREDENTIAL_ENV_VARS[[label]] + env_value <- Sys.getenv(env_var_name, NA_character_) + if (!is.na(env_value) && nzchar(env_value)) { + return(env_value) + } + + if (!overwrite) { + recovered <- try_keyring_get(service = service, username = username, vb = vb) + if (!is.null(recovered)) { + return(recovered) + } + } + + getPass::getPass(paste0("Please enter your ", prompt_label, " ")) +} diff --git a/R/login_db.R b/R/login_db.R index 75c47d82..67b0251b 100644 --- a/R/login_db.R +++ b/R/login_db.R @@ -1,25 +1,20 @@ -#' @eval options::as_params() -#' @name options_params -#' -NULL - #' Log In To Databrary.org. #' #' @param email Databrary account email address. #' @param password Databrary password (not recommended as it will displayed #' as you type) -#' @param store A boolean value. If TRUE store/retrieve credentials from the -#' system keyring/keychain. -#' @param overwrite A boolean value. If TRUE and store is TRUE, overwrite/ -#' update stored credentials in keyring/keychain. -#' @param SERVICE A character label for stored credentials in the keyring. -#' Default is "databrary" -#' @param rq An `http` request object. Defaults to NULL. -#' +#' @param client_id OAuth2 client identifier. +#' @param client_secret OAuth2 client secret. +#' @param store A boolean value. If TRUE store/retrieve credentials from the +#' system keyring/keychain. +#' @param overwrite A boolean value. If TRUE and store is TRUE, overwrite/ +#' update stored credentials in keyring/keychain. +#' @param SERVICE A character label for stored credentials in the keyring. +#' Default is `org.databrary.databraryr`. +#' @param vb Show verbose messages. +#' #' @returns Logical value indicating whether log in is successful or not. -#' -#' @inheritParams options_params -#' +#' #' @examplesIf interactive() #' login_db() # Queries user for email and password interactively. #' @examples @@ -34,145 +29,92 @@ NULL #' @export login_db <- function(email = NULL, password = NULL, + client_id = NULL, + client_secret = NULL, store = FALSE, overwrite = FALSE, - vb = options::opt("vb"), SERVICE = KEYRING_SERVICE, - rq = NULL) { - # Check parameters - assertthat::assert_that(length(store) == 1) - assertthat::assert_that(is.logical(store)) - - assertthat::assert_that(length(overwrite) == 1) - assertthat::assert_that(is.logical(overwrite)) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(length(SERVICE) == 1) - assertthat::assert_that(is.character(SERVICE)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - # Handle NULL request - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - } - rq <- databraryr::make_default_request() - } - + vb = options::opt("vb")) { + assertthat::assert_that(length(store) == 1, is.logical(store)) + assertthat::assert_that(length(overwrite) == 1, is.logical(overwrite)) + assertthat::assert_that(length(vb) == 1, is.logical(vb)) + assertthat::assert_that(length(SERVICE) == 1, is.character(SERVICE)) + # If the user wants to store or use their stored credentials, # check for keyring support if (store) { assertthat::assert_that(keyring::has_keyring_support(), msg = "No keyring support; please use store=FALSE") } - - # Check or get email - if (!is.null(email)) { - assertthat::assert_that(assertthat::is.string(email)) - } else { - message("Please enter your Databrary user ID (email).") - email <- readline(prompt = "Email: ") - } - - do_collect_password <- TRUE - - if (!is.null(password)) { - assertthat::assert_that(assertthat::is.string(password)) - do_collect_password <- FALSE - } - - # If the user wants to store or use their stored credentials and - # doesn't provide a password - if (store && is.null(password) && !overwrite) { - if (vb) - message("Retrieving password for service='", - SERVICE, - "' from keyring.") - kl <- keyring::key_list(service = SERVICE) - # Make sure our service is in the keyring - if (exists('kl') && is.data.frame(kl)) { - # If it is under the email entered, keep it to try later and not - # collect it here - password <- - try(keyring::key_get(service = SERVICE, username = email), - silent = TRUE) - if ("try-error" %in% class(password)) { - do_collect_password <- TRUE - if (vb) - message("No password found in keyring for service='", SERVICE, ".") - } else { - do_collect_password <- FALSE - if (vb) - message("Password retrieved from keyring.") - } - } else { - if (vb) - message("Error retrieving keyring data for service='", - SERVICE, - "'.") - } - } - - # If we need to, securely collect the password - if (do_collect_password) { - password <- - getPass::getPass("Please enter your Databrary password ") - } - - is_login_successful <- FALSE - - if (is.null(rq)) - rq <- make_default_request() - - rq <- rq %>% - httr2::req_url(LOGIN) %>% - httr2::req_body_json(list(email = email, password = password)) - - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) - NULL + + email_value <- resolve_credential_value( + label = "email", + value = email, + prompt_label = "Databrary user ID (email)", + service = SERVICE, + overwrite = overwrite, + vb = vb ) - - if (!is.null(resp) & httr2::resp_status(resp) == 200) { - is_login_successful <- TRUE - } - - # If the username/password was successful and the user wanted to - # store their credentials - - # Store them in the keyring - if (is_login_successful) { - if (store && (do_collect_password || overwrite)) { - keyring::key_set_with_value(service = SERVICE, - username = email, - password = password) - if (vb) - message(paste0("Login successful; password stored in keyring/keychain")) - } else { - if (vb) - message(paste("Login successful.")) - } - return(TRUE) + + password_value <- resolve_secret_value( + label = "password", + value = password, + prompt_label = "Databrary password", + service = SERVICE, + username = paste0(email_value, "::password"), + overwrite = overwrite, + vb = vb + ) + + client_id_value <- resolve_credential_value( + label = "client_id", + value = client_id, + prompt_label = "OAuth client ID", + service = SERVICE, + username = paste0(email_value, "::client_id"), + overwrite = overwrite, + vb = vb + ) + + client_secret_value <- resolve_secret_value( + label = "client_secret", + value = client_secret, + prompt_label = "OAuth client secret", + service = SERVICE, + username = paste0(email_value, "::client_secret"), + overwrite = overwrite, + vb = vb + ) + + token <- oauth_password_grant( + username = email_value, + password = password_value, + client_id = client_id_value, + client_secret = client_secret_value, + vb = vb + ) + + if (is.null(token)) { + if (vb) message("Login failed; see previous messages for details.") + return(FALSE) } - + + set_token_bundle( + access_token = token$access_token, + refresh_token = token$refresh_token, + expires_in = token$expires_in, + issued_at = Sys.time(), + client_id = client_id_value, + client_secret = client_secret_value, + username = email_value + ) + if (store) { - if (vb) - message( - paste0( - 'Login failed; nothing stored in keyring; HTTP status ', - httr2::resp_status(resp), - '\n' - ) - ) - } else { - if (vb) - message(paste0('Login failed; HTTP status ', - httr2::resp_status(resp), '\n')) + store_keyring_value(service = SERVICE, username = paste0(email_value, "::password"), value = password_value, vb = vb) + store_keyring_value(service = SERVICE, username = paste0(email_value, "::client_id"), value = client_id_value, vb = vb) + store_keyring_value(service = SERVICE, username = paste0(email_value, "::client_secret"), value = client_secret_value, vb = vb) } - - return(FALSE) + + if (vb) message("Login successful.") + TRUE } diff --git a/R/logout_db.R b/R/logout_db.R index 6c15304a..4cf1ea11 100644 --- a/R/logout_db.R +++ b/R/logout_db.R @@ -16,26 +16,17 @@ NULL #' logout_db() #' } #' @export -logout_db <- function(vb = options::opt("vb"), rq = NULL){ +logout_db <- function(vb = options::opt("vb")) { + assertthat::assert_that(is.logical(vb), length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - if (is.null(rq)) { - if (vb) message("Empty request. Generating new one.") - rq <- databraryr::make_default_request() + bundle <- get_token_bundle() + if (is.null(bundle)) { + if (vb) message("No active session; nothing to log out from.") + return(TRUE) } - rq <- rq %>% - httr2::req_url(LOGOUT) - - r <- httr2::req_perform(rq) - delete_cookie <- file.remove(rq$options$cookiefile) - if (httr2::resp_status(r) == 200 & delete_cookie) { - if (vb) message('Logout Successful.') - TRUE - } else { - if (vb) message(paste0('Logout Failed, HTTP status: ', - httr2::resp_status(r), '.\n')) - FALSE - } + clear_token_bundle() + + if (vb) message("Logout successful.") + TRUE } diff --git a/R/make_default_request.R b/R/make_default_request.R index 290de5c8..aab67b5d 100644 --- a/R/make_default_request.R +++ b/R/make_default_request.R @@ -1,17 +1,42 @@ -#' Set default httr request parameters. +#' Set base request defaults for Databrary API. +#' +#' Creates an `httr2` request with the package's default options, including +#' base URL, user agent, Accept header, and timeout tuned for the Django API. +#' +#' @inheritParams options_params +#' @param with_token Should the request include an OAuth2 `Authorization` header? +#' Defaults to `TRUE` since all API calls now require authentication. +#' @param refresh When `with_token = TRUE`, determines whether to refresh the +#' cached token if it is near expiry. Defaults to `TRUE`. +#' +#' @returns An `httr2_request` object configured for the Databrary API. #' -#' `make_default_request` sets default parameters for httr requests. -#' @returns An `httr2` request object. -#' #' @examples #' make_default_request() #' @export -make_default_request <- function() { - path <- tempfile() - rq <- httr2::request(DATABRARY_API) %>% - httr2::req_user_agent(USER_AGENT) %>% - httr2::req_retry(max_tries = RETRY_LIMIT) %>% - httr2::req_timeout(REQUEST_TIMEOUT) %>% - httr2::req_cookie_preserve(path) - rq +make_default_request <- function(with_token = TRUE, + refresh = TRUE, + vb = options::opt("vb")) { + assertthat::assert_that(is.logical(with_token), length(with_token) == 1) + assertthat::assert_that(is.logical(refresh), length(refresh) == 1) + assertthat::assert_that(is.logical(vb), length(vb) == 1) + + req <- httr2::request(DATABRARY_BASE_URL) |> + httr2::req_user_agent(USER_AGENT) |> + httr2::req_retry(max_tries = RETRY_LIMIT) |> + httr2::req_headers("Accept" = "application/json") |> + httr2::req_timeout(REQUEST_TIMEOUT) + + if (!isTRUE(with_token)) { + return(req) + } + + token <- if (isTRUE(refresh)) { + bundle <- ensure_valid_token(refresh = TRUE, vb = vb) + bundle$access_token + } else { + require_access_token() + } + + httr2::req_headers(req, Authorization = paste("Bearer", token)) } \ No newline at end of file diff --git a/R/token_helpers.R b/R/token_helpers.R new file mode 100644 index 00000000..f901f375 --- /dev/null +++ b/R/token_helpers.R @@ -0,0 +1,61 @@ +# Token-aware request helpers ------------------------------------------------- + +#' @noRd +add_bearer_token <- function(rq) { + assertthat::assert_that(inherits(rq, "httr2_request")) + access_token <- require_access_token() + httr2::req_headers(rq, Authorization = paste("Bearer", access_token)) +} + +#' @noRd +ensure_valid_token <- function(refresh = TRUE, + client_id = NULL, + client_secret = NULL, + vb = FALSE) { + bundle <- get_token_bundle() + if (is.null(bundle)) { + stop("No OAuth token available; call login_db() first.", call. = FALSE) + } + + if (!token_should_refresh()) { + return(bundle) + } + + if (!refresh) { + stop("Access token expired and refresh disabled.", call. = FALSE) + } + + refresh_token <- bundle$refresh_token + if (is_missing_string(refresh_token)) { + stop("Access token expired and no refresh token available.", call. = FALSE) + } + + refresh_client_id <- if (is_missing_string(client_id)) bundle$client_id else client_id + refresh_client_secret <- if (is_missing_string(client_secret)) bundle$client_secret else client_secret + + refreshed <- oauth_refresh_grant( + refresh_token = refresh_token, + client_id = refresh_client_id, + client_secret = refresh_client_secret, + vb = vb + ) + + if (is.null(refreshed)) { + clear_token_bundle() + stop("Token refresh failed; please re-authenticate with login_db().", call. = FALSE) + } + + set_token_bundle( + access_token = refreshed$access_token, + refresh_token = refreshed$refresh_token, + expires_in = refreshed$expires_in, + issued_at = Sys.time(), + client_id = refresh_client_id, + client_secret = refresh_client_secret, + username = bundle$username + ) + + get_token_bundle() +} + + diff --git a/R/whoami.R b/R/whoami.R new file mode 100644 index 00000000..5c39c3c6 --- /dev/null +++ b/R/whoami.R @@ -0,0 +1,57 @@ +#' Retrieve metadata about the authenticated Databrary user. +#' +#' Calls the Django `/oauth2/test/` endpoint to report the current authentication +#' method and user profile. Requires a valid OAuth2 access token acquired via +#' `login_db()`. +#' +#' @inheritParams options_params +#' @param refresh Whether to attempt automatic token refresh when the current +#' access token is expired. Defaults to `TRUE`. +#' +#' @returns A list containing `auth_method` and `user` fields (both lists) or +#' `NULL` if the request fails due to lack of authentication. +#' +#' @examples +#' \\dontrun{ +#' login_db() +#' whoami() +#' } +#' @export +whoami <- function(refresh = TRUE, vb = options::opt("vb")) { + assertthat::assert_that(is.logical(refresh), length(refresh) == 1) + assertthat::assert_that(is.logical(vb), length(vb) == 1) + + req <- tryCatch( + make_default_request(refresh = refresh, vb = vb), + error = function(err) { + if (vb) message("Authentication required: ", conditionMessage(err)) + NULL + } + ) + + if (is.null(req)) { + return(NULL) + } + + resp <- tryCatch( + httr2::req_url(req, OAUTH_TEST_URL) |> + httr2::req_perform(), + error = function(err) { + if (vb) message("whoami request failed: ", conditionMessage(err)) + NULL + } + ) + + if (is.null(resp)) { + return(NULL) + } + + status <- httr2::resp_status(resp) + if (status >= 400) { + if (vb) message(httr2_error_message(resp)) + return(NULL) + } + + httr2::resp_body_json(resp, simplifyVector = TRUE) +} + diff --git a/README.Rmd b/README.Rmd index ce23e410..204dd364 100644 --- a/README.Rmd +++ b/README.Rmd @@ -48,16 +48,23 @@ The registration process involves the creation of an (email-account-based) user Once institutional authorization has been granted, a user may gain access to shared video, audio, and other data. See for more information about gaining access to restricted data. -However, many commands in the `databraryr` package return meaningful results *without* or *prior to* formal authorization. -These commands access public data or metadata. +All API calls now require OAuth2 authentication. Before +running the examples below, ensure you have set the following environment variables +or stored values with `login_db(store = TRUE)`: + +- `DATABRARY_CLIENT_ID` +- `DATABRARY_CLIENT_SECRET` +- `DATABRARY_LOGIN` (your Databrary account email) +- `DATABRARY_PASSWORD` (optional; prompted securely if missing) + +You can configure these via `usethis::edit_r_environ()`. ```{r example} library(databraryr) -get_db_stats() +login_db() -list_volume_assets() |> - head() +whoami() ``` ## Lifecycle diff --git a/man/login_db.Rd b/man/login_db.Rd index e10d0ea1..98be6bd7 100644 --- a/man/login_db.Rd +++ b/man/login_db.Rd @@ -7,11 +7,12 @@ login_db( email = NULL, password = NULL, + client_id = NULL, + client_secret = NULL, store = FALSE, overwrite = FALSE, - vb = options::opt("vb"), SERVICE = KEYRING_SERVICE, - rq = NULL + vb = options::opt("vb") ) } \arguments{ @@ -20,18 +21,20 @@ login_db( \item{password}{Databrary password (not recommended as it will displayed as you type)} +\item{client_id}{OAuth2 client identifier.} + +\item{client_secret}{OAuth2 client secret.} + \item{store}{A boolean value. If TRUE store/retrieve credentials from the system keyring/keychain.} \item{overwrite}{A boolean value. If TRUE and store is TRUE, overwrite/ update stored credentials in keyring/keychain.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - \item{SERVICE}{A character label for stored credentials in the keyring. -Default is "databrary"} +Default is \code{org.databrary.databraryr}.} -\item{rq}{An \code{http} request object. Defaults to NULL.} +\item{vb}{Show verbose messages.} } \value{ Logical value indicating whether log in is successful or not. @@ -40,7 +43,7 @@ Logical value indicating whether log in is successful or not. Log In To Databrary.org. } \examples{ -\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (interactive()) withAutoprint(\{ # examplesIf} login_db() # Queries user for email and password interactively. \dontshow{\}) # examplesIf} \donttest{ diff --git a/man/logout_db.Rd b/man/logout_db.Rd index 49e55875..2ea6c141 100644 --- a/man/logout_db.Rd +++ b/man/logout_db.Rd @@ -4,7 +4,7 @@ \alias{logout_db} \title{Log Out of Databrary.org.} \usage{ -logout_db(vb = options::opt("vb"), rq = NULL) +logout_db(vb = options::opt("vb")) } \arguments{ \item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} diff --git a/man/make_default_request.Rd b/man/make_default_request.Rd index ddb0d76b..17f17644 100644 --- a/man/make_default_request.Rd +++ b/man/make_default_request.Rd @@ -2,15 +2,29 @@ % Please edit documentation in R/make_default_request.R \name{make_default_request} \alias{make_default_request} -\title{Set default httr request parameters.} +\title{Set base request defaults for Databrary API.} \usage{ -make_default_request() +make_default_request( + with_token = TRUE, + refresh = TRUE, + vb = options::opt("vb") +) +} +\arguments{ +\item{with_token}{Should the request include an OAuth2 \code{Authorization} header? +Defaults to \code{TRUE} since all API calls now require authentication.} + +\item{refresh}{When \code{with_token = TRUE}, determines whether to refresh the +cached token if it is near expiry. Defaults to \code{TRUE}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} } \value{ -An \code{httr2} request object. +An \code{httr2_request} object configured for the Databrary API. } \description{ -\code{make_default_request} sets default parameters for httr requests. +Creates an \code{httr2} request with the package's default options, including +base URL, user agent, Accept header, and timeout tuned for the Django API. } \examples{ make_default_request() diff --git a/man/whoami.Rd b/man/whoami.Rd new file mode 100644 index 00000000..08932656 --- /dev/null +++ b/man/whoami.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/whoami.R +\name{whoami} +\alias{whoami} +\title{Retrieve metadata about the authenticated Databrary user.} +\usage{ +whoami(refresh = TRUE, vb = options::opt("vb")) +} +\arguments{ +\item{refresh}{Whether to attempt automatic token refresh when the current +access token is expired. Defaults to \code{TRUE}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +} +\value{ +A list containing \code{auth_method} and \code{user} fields (both lists) or +\code{NULL} if the request fails due to lack of authentication. +} +\description{ +Calls the Django \verb{/oauth2/test/} endpoint to report the current authentication +method and user profile. Requires a valid OAuth2 access token acquired via +\code{login_db()}. +} +\examples{ +\\dontrun{ +login_db() +whoami() +} +} diff --git a/tests/testthat/test-login_db.R b/tests/testthat/test-login_db.R index 1a69237c..0787a463 100644 --- a/tests/testthat/test-login_db.R +++ b/tests/testthat/test-login_db.R @@ -1,31 +1,23 @@ test_that("login_db rejects bad input parameters", { - # expect_error(login_db(email = -1)) - # expect_error(login_db(email = c("a", "b"))) - # expect_error(login_db(email = list("a", "b"))) - # expect_error(login_db(email = TRUE)) - # - # expect_error(login_db(password = -1)) - # expect_error(login_db(password = 3)) - # expect_error(login_db(password = list("a", "b"))) - # expect_error(login_db(password = TRUE)) - # - # expect_error(login_db(store = -1)) - # expect_error(login_db(store = 'a')) - # expect_error(login_db(store = list("a", "b"))) - # - # expect_error(login_db(overwrite = -1)) - # expect_error(login_db(overwrite = 'a')) - # expect_error(login_db(overwrite = list("a", "b"))) - expect_error(login_db(vb = -1)) expect_error(login_db(vb = 3)) expect_error(login_db(vb = "a")) - - # expect_error(login_db(SERVICE = -1)) - # expect_error(login_db(SERVICE = TRUE)) - # expect_error(login_db(SERVICE = list("a", "b"))) - # - # expect_error(login_db(rq = 3)) - # expect_error(login_db(rq = "a")) - # expect_error(login_db(rq = TRUE)) }) + +test_that("login_db stores token bundle on success", { + orig <- get("oauth_password_grant", envir = asNamespace("databraryr")) + assignInNamespace("oauth_password_grant", function(username, password, client_id, client_secret, vb = FALSE) list(access_token = "abc", refresh_token = "def", expires_in = 3600), ns = "databraryr") + on.exit(assignInNamespace("oauth_password_grant", orig, ns = "databraryr"), add = TRUE) + clear_token_bundle() + expect_true(login_db(email = "user@example.com", + password = "pw", + client_id = "cid", + client_secret = "sec", + store = FALSE, + vb = FALSE)) + bundle <- get_token_bundle() + expect_equal(bundle$access_token, "abc") + expect_equal(bundle$refresh_token, "def") + clear_token_bundle() +}) + diff --git a/tests/testthat/test-logout_db.R b/tests/testthat/test-logout_db.R index 334337e9..30b16c2d 100644 --- a/tests/testthat/test-logout_db.R +++ b/tests/testthat/test-logout_db.R @@ -5,9 +5,8 @@ test_that("logout_db rejects bad input parameters", { expect_error(logout_db(vb = c(TRUE, FALSE))) }) -test_that("logout_db returns logical", { - expect_true(is.logical(logout_db())) +test_that("logout_db clears token state", { + set_token_bundle(access_token = "abc", refresh_token = "def", expires_in = 3600) + expect_true(logout_db(vb = FALSE)) + expect_null(get_token_bundle()) }) - -# Actually log out -logout_db() diff --git a/tests/testthat/test-make_default_request.R b/tests/testthat/test-make_default_request.R index 03573f4f..b418044b 100644 --- a/tests/testthat/test-make_default_request.R +++ b/tests/testthat/test-make_default_request.R @@ -3,3 +3,18 @@ test_that("make_default_request returns httr2_request", { expect_true("httr2_request" %in% class(make_default_request())) }) +test_that("make_default_request optionally attaches bearer token", { + clear_token_bundle() + set_token_bundle(access_token = "xyz", refresh_token = NULL) + req <- make_default_request(with_token = TRUE, refresh = FALSE, vb = FALSE) + headers <- req$headers + expect_equal(headers$Authorization, "Bearer xyz") + clear_token_bundle() +}) + +test_that("make_default_request errors when token missing", { + clear_token_bundle() + expect_error(make_default_request(with_token = TRUE, refresh = FALSE, vb = FALSE), + "No OAuth token available") +}) + diff --git a/tests/testthat/test-whoami.R b/tests/testthat/test-whoami.R new file mode 100644 index 00000000..21053784 --- /dev/null +++ b/tests/testthat/test-whoami.R @@ -0,0 +1,29 @@ +test_that("whoami returns NULL when unauthenticated", { + clear_token_bundle() + expect_null(whoami(refresh = FALSE, vb = FALSE)) +}) + +test_that("whoami fetches user info", { + clear_token_bundle() + set_token_bundle(access_token = "abc", refresh_token = NULL) + + local_mocked_bindings( + req_perform = function(...) { + httr2::response( + method = "GET", + url = OAUTH_TEST_URL, + status_code = 200, + headers = list("Content-Type" = "application/json"), + body = charToRaw('{"auth_method":"password","user":{"id":1}}') + ) + }, + .package = "httr2" + ) + + result <- whoami(refresh = FALSE, vb = FALSE) + + expect_equal(result$auth_method, "password") + expect_equal(result$user$id, 1) + clear_token_bundle() +}) + From 7ac22e09d6dab0cf25f4f5f5f2ec6b22a684de55 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Fri, 31 Oct 2025 12:07:54 +0100 Subject: [PATCH 02/77] Refactor API interaction: add new helper functions, remove deprecated functions, and update documentation. Adjust tests for consistency and add new tests for recent changes. --- NAMESPACE | 28 +- R/CONSTANTS.R | 109 +++---- R/api_utils.R | 176 +++++++++++ R/assign_constants.R | 56 ++-- R/download_party_avatar.R | 136 --------- R/get_db_stats.R | 85 ++---- R/get_folder_by_id.R | 56 ++++ R/get_institution_by_id.R | 46 +++ R/get_party_by_id.R | 76 ----- R/get_session_by_id.R | 74 ++--- R/get_session_by_name.R | 62 +--- R/get_user_by_id.R | 46 +++ R/get_volume_by_id.R | 53 ++-- R/list_authorized_investigators.R | 73 ++--- R/list_folder_assets.R | 102 +++++++ R/list_institution_affiliates.R | 45 +++ R/list_party_affiliates.R | 77 ----- R/list_party_sponsors.R | 99 ------- R/list_party_volumes.R | 104 ------- R/list_session_activity.R | 159 +++++++--- R/list_session_assets.R | 145 ++++----- R/list_sponsors.R | 72 ----- R/list_user_affiliates.R | 39 +++ R/list_user_history.R | 65 +++++ R/list_user_sponsors.R | 50 ++++ R/list_user_volumes.R | 52 ++++ R/list_users.R | 115 ++++++++ R/list_volume_activity.R | 90 ++++-- R/list_volume_assets.R | 139 ++++----- R/list_volume_collaborators.R | 80 +++++ R/list_volume_excerpts.R | 60 ---- R/list_volume_folders.R | 69 +++++ R/list_volume_funding.R | 85 ++---- R/list_volume_info.R | 115 +++----- R/list_volume_links.R | 45 ++- R/list_volume_owners.R | 73 ----- R/list_volume_session_assets.R | 133 ++++----- R/list_volume_sessions.R | 99 +++---- R/list_volume_tags.R | 36 +-- R/list_volumes.R | 86 ++++++ R/misc_enums.R | 43 +++ R/search_for_funder.R | 68 +++-- R/search_for_keywords.R | 69 ----- R/search_for_tags.R | 42 ++- R/search_institutions.R | 60 ++++ R/search_users.R | 64 ++++ R/search_volumes.R | 82 ++++++ R/token_helpers.R | 9 - R/utils.R | 276 ++++-------------- R/whoami.R | 10 +- README.Rmd | 23 ++ README.md | 45 ++- ...API_CONSTANTS.Rd => DATABRARY_BASE_URL.Rd} | 6 +- man/download_party_avatar.Rd | 44 --- man/get_asset_segment_range.Rd | 46 --- man/get_assets_from_session.Rd | 16 - man/get_file_duration.Rd | 12 +- man/get_folder_by_id.Rd | 31 ++ man/get_info_from_session.Rd | 26 -- man/get_institution_by_id.Rd | 19 ++ man/get_party_by_id.Rd | 39 --- man/get_user_by_id.Rd | 19 ++ man/is_institution.Rd | 27 -- man/is_person.Rd | 27 -- man/list_authorized_investigators.Rd | 21 +- man/list_folder_assets.Rd | 36 +++ man/list_institution_affiliates.Rd | 23 ++ man/list_party_affiliates.Rd | 26 -- man/list_party_sponsors.Rd | 30 -- man/list_party_volumes.Rd | 29 -- man/list_session_activity.Rd | 34 ++- man/list_session_assets.Rd | 11 +- man/list_sponsors.Rd | 29 -- man/list_user_affiliates.Rd | 19 ++ man/list_user_history.Rd | 31 ++ man/list_user_sponsors.Rd | 19 ++ man/list_user_volumes.Rd | 19 ++ man/list_users.Rd | 52 ++++ man/list_volume_activity.Rd | 4 +- man/list_volume_collaborators.Rd | 30 ++ man/list_volume_excerpts.Rd | 27 -- man/list_volume_folders.Rd | 29 ++ man/list_volume_owners.Rd | 28 -- man/list_volume_session_assets.Rd | 6 +- man/list_volumes.Rd | 39 +++ man/make_login_client.Rd | 2 +- man/search_for_funder.Rd | 6 +- man/search_for_keywords.Rd | 34 --- man/search_institutions.Rd | 31 ++ man/search_users.Rd | 30 ++ man/search_volumes.Rd | 30 ++ tests/testthat/helper-auth.R | 52 ++++ tests/testthat/test-assign_constants.R | 20 +- tests/testthat/test-auth_service.R | 57 ++++ tests/testthat/test-download_party_avatar.R | 20 -- tests/testthat/test-download_session_zip.R | 1 + tests/testthat/test-download_volume_zip.R | 1 + tests/testthat/test-get_db_stats.R | 43 ++- tests/testthat/test-get_folder_by_id.R | 38 +++ tests/testthat/test-get_institution_by_id.R | 11 + tests/testthat/test-get_party_by_id.R | 25 -- tests/testthat/test-get_session_by_id.R | 7 +- tests/testthat/test-get_session_by_name.R | 17 +- tests/testthat/test-get_user_by_id.R | 9 + tests/testthat/test-get_volume_by_id.R | 7 +- tests/testthat/test-list_asset_formats.R | 15 + .../test-list_authorized_investigators.R | 31 +- tests/testthat/test-list_folder_assets.R | 40 +++ .../test-list_institution_affiliates.R | 10 + tests/testthat/test-list_party_affiliates.R | 25 -- tests/testthat/test-list_party_sponsors.R | 25 -- tests/testthat/test-list_party_volumes.R | 25 -- tests/testthat/test-list_session_activity.R | 10 +- tests/testthat/test-list_session_assets.R | 49 ++-- tests/testthat/test-list_sponsors.R | 23 -- tests/testthat/test-list_user_affiliates.R | 27 ++ tests/testthat/test-list_user_history.R | 18 ++ tests/testthat/test-list_user_sponsors.R | 26 ++ tests/testthat/test-list_user_volumes.R | 22 ++ tests/testthat/test-list_users.R | 21 ++ tests/testthat/test-list_volume_activity.R | 6 +- tests/testthat/test-list_volume_assets.R | 19 +- .../testthat/test-list_volume_collaborators.R | 19 ++ tests/testthat/test-list_volume_excerpts.R | 23 -- tests/testthat/test-list_volume_folders.R | 26 ++ tests/testthat/test-list_volume_funding.R | 7 +- tests/testthat/test-list_volume_info.R | 22 +- tests/testthat/test-list_volume_links.R | 8 +- tests/testthat/test-list_volume_owners.R | 26 -- .../test-list_volume_session_assets.R | 17 +- tests/testthat/test-list_volume_sessions.R | 21 +- tests/testthat/test-list_volume_tags.R | 11 +- tests/testthat/test-list_volumes.R | 18 ++ tests/testthat/test-make_default_request.R | 20 +- tests/testthat/test-make_login_client.R | 52 ++-- tests/testthat/test-search_for_funder.R | 12 +- tests/testthat/test-search_for_keywords.R | 21 -- tests/testthat/test-search_for_tags.R | 6 +- tests/testthat/test-search_institutions.R | 17 ++ tests/testthat/test-search_users.R | 17 ++ tests/testthat/test-search_volumes.R | 17 ++ tests/testthat/test-token_helpers.R | 29 ++ tests/testthat/test-utils.R | 95 ++---- tests/testthat/test-whoami.R | 25 +- vignettes/accessing-data.Rmd | 30 +- vignettes/databrary.Rmd | 27 +- 146 files changed, 3417 insertions(+), 2937 deletions(-) create mode 100644 R/api_utils.R delete mode 100644 R/download_party_avatar.R create mode 100644 R/get_folder_by_id.R create mode 100644 R/get_institution_by_id.R delete mode 100644 R/get_party_by_id.R create mode 100644 R/get_user_by_id.R create mode 100644 R/list_folder_assets.R create mode 100644 R/list_institution_affiliates.R delete mode 100644 R/list_party_affiliates.R delete mode 100644 R/list_party_sponsors.R delete mode 100644 R/list_party_volumes.R delete mode 100644 R/list_sponsors.R create mode 100644 R/list_user_affiliates.R create mode 100644 R/list_user_history.R create mode 100644 R/list_user_sponsors.R create mode 100644 R/list_user_volumes.R create mode 100644 R/list_users.R create mode 100644 R/list_volume_collaborators.R delete mode 100644 R/list_volume_excerpts.R create mode 100644 R/list_volume_folders.R delete mode 100644 R/list_volume_owners.R create mode 100644 R/list_volumes.R create mode 100644 R/misc_enums.R delete mode 100644 R/search_for_keywords.R create mode 100644 R/search_institutions.R create mode 100644 R/search_users.R create mode 100644 R/search_volumes.R rename man/{API_CONSTANTS.Rd => DATABRARY_BASE_URL.Rd} (81%) delete mode 100644 man/download_party_avatar.Rd delete mode 100644 man/get_asset_segment_range.Rd delete mode 100644 man/get_assets_from_session.Rd create mode 100644 man/get_folder_by_id.Rd delete mode 100644 man/get_info_from_session.Rd create mode 100644 man/get_institution_by_id.Rd delete mode 100644 man/get_party_by_id.Rd create mode 100644 man/get_user_by_id.Rd delete mode 100644 man/is_institution.Rd delete mode 100644 man/is_person.Rd create mode 100644 man/list_folder_assets.Rd create mode 100644 man/list_institution_affiliates.Rd delete mode 100644 man/list_party_affiliates.Rd delete mode 100644 man/list_party_sponsors.Rd delete mode 100644 man/list_party_volumes.Rd delete mode 100644 man/list_sponsors.Rd create mode 100644 man/list_user_affiliates.Rd create mode 100644 man/list_user_history.Rd create mode 100644 man/list_user_sponsors.Rd create mode 100644 man/list_user_volumes.Rd create mode 100644 man/list_users.Rd create mode 100644 man/list_volume_collaborators.Rd delete mode 100644 man/list_volume_excerpts.Rd create mode 100644 man/list_volume_folders.Rd delete mode 100644 man/list_volume_owners.Rd create mode 100644 man/list_volumes.Rd delete mode 100644 man/search_for_keywords.Rd create mode 100644 man/search_institutions.Rd create mode 100644 man/search_users.Rd create mode 100644 man/search_volumes.Rd create mode 100644 tests/testthat/helper-auth.R create mode 100644 tests/testthat/test-auth_service.R delete mode 100644 tests/testthat/test-download_party_avatar.R create mode 100644 tests/testthat/test-get_folder_by_id.R create mode 100644 tests/testthat/test-get_institution_by_id.R delete mode 100644 tests/testthat/test-get_party_by_id.R create mode 100644 tests/testthat/test-get_user_by_id.R create mode 100644 tests/testthat/test-list_asset_formats.R create mode 100644 tests/testthat/test-list_folder_assets.R create mode 100644 tests/testthat/test-list_institution_affiliates.R delete mode 100644 tests/testthat/test-list_party_affiliates.R delete mode 100644 tests/testthat/test-list_party_sponsors.R delete mode 100644 tests/testthat/test-list_party_volumes.R delete mode 100644 tests/testthat/test-list_sponsors.R create mode 100644 tests/testthat/test-list_user_affiliates.R create mode 100644 tests/testthat/test-list_user_history.R create mode 100644 tests/testthat/test-list_user_sponsors.R create mode 100644 tests/testthat/test-list_user_volumes.R create mode 100644 tests/testthat/test-list_users.R create mode 100644 tests/testthat/test-list_volume_collaborators.R delete mode 100644 tests/testthat/test-list_volume_excerpts.R create mode 100644 tests/testthat/test-list_volume_folders.R delete mode 100644 tests/testthat/test-list_volume_owners.R create mode 100644 tests/testthat/test-list_volumes.R delete mode 100644 tests/testthat/test-search_for_keywords.R create mode 100644 tests/testthat/test-search_institutions.R create mode 100644 tests/testthat/test-search_users.R create mode 100644 tests/testthat/test-search_volumes.R create mode 100644 tests/testthat/test-token_helpers.R diff --git a/NAMESPACE b/NAMESPACE index 9b6da36c..613ec1a0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,7 +4,6 @@ export("%>%") export(HHMMSSmmm_to_ms) export(assign_constants) export(check_ssl_certs) -export(download_party_avatar) export(download_session_asset) export(download_session_assets_fr_df) export(download_session_csv) @@ -12,43 +11,48 @@ export(download_session_zip) export(download_single_session_asset_fr_df) export(download_video) export(download_volume_zip) -export(get_asset_segment_range) export(get_db_stats) export(get_file_duration) -export(get_party_by_id) +export(get_folder_by_id) +export(get_institution_by_id) export(get_permission_levels) export(get_release_levels) export(get_session_by_id) export(get_session_by_name) export(get_supported_file_types) +export(get_user_by_id) export(get_volume_by_id) -export(is_institution) -export(is_person) export(list_asset_formats) export(list_authorized_investigators) -export(list_party_affiliates) -export(list_party_sponsors) -export(list_party_volumes) +export(list_folder_assets) +export(list_institution_affiliates) export(list_session_activity) export(list_session_assets) -export(list_sponsors) +export(list_user_affiliates) +export(list_user_history) +export(list_user_sponsors) +export(list_user_volumes) +export(list_users) export(list_volume_activity) export(list_volume_assets) -export(list_volume_excerpts) +export(list_volume_collaborators) +export(list_volume_folders) export(list_volume_funding) export(list_volume_info) export(list_volume_links) -export(list_volume_owners) export(list_volume_session_assets) export(list_volume_sessions) export(list_volume_tags) +export(list_volumes) export(login_db) export(logout_db) export(make_default_request) export(make_login_client) export(search_for_funder) -export(search_for_keywords) export(search_for_tags) +export(search_institutions) +export(search_users) +export(search_volumes) export(whoami) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index ebe26b03..000da2ed 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -1,90 +1,53 @@ #' Load Package-wide Constants into Local Environment #' #' +DATABRARY_BASE_URL <- Sys.getenv("DATABRARY_BASE_URL", "https://api.stg-databrary.its.nyu.edu") -# Legacy endpoints (temporary until all functions migrated) ------------------- - -API_CONSTANTS <- "https://nyu.databrary.org/api/constants" - -CREATE_SLOT <- - "https://nyu.databrary.org/api/volume/%s/slot" -CREATE_UPLOAD_FLOW <- - "https://nyu.databrary.org/api/volume/%s/upload" -CREATE_FILE_FROM_FLOW <- - "https://nyu.databrary.org/api/volume/%s/asset" - -DATABRARY_API <- "https://nyu.databrary.org/api" -DOWNLOAD_FILE <- - "https://nyu.databrary.org/slot/%s/-/asset/%s/download" -DOWNLOAD_SESSION_ZIP <- - "https://nyu.databrary.org/volume/%s/slot/%s/zip/%s" -DOWNLOAD_VOLUME_ZIP <- - "https://nyu.databrary.org/volume/%s/zip/false" - -GET_SESSIONS_IN_VOL <- - "https://nyu.databrary.org/api/volume/%s?records&containers=all" -GET_ACTIVITY_DATA <- - "https://nyu.databrary.org/api/activity" -GET_PARTY_BY_ID <- - "https://nyu.databrary.org/api/party/%s?parents&children&access" -GET_PARTY_NO_PARENTS_CHILDREN <- "https://nyu.databrary.org/api/party/%s" -GET_CONSTANTS <- "https://nyu.databrary.org/api/constants" -GET_PARTY_AVATAR <- "https://nyu.databrary.org/party/%s/avatar" - -GET_SESSION_CSV <- "https://nyu.databrary.org/volume/%s/csv" -GET_SESSION_ACTIVITY <- "https://nyu.databrary.org/api/slot/%s/activity" -GET_SESSION_ZIP <- "https://nyu.databrary.org/volume/%s/slot/%s/zip/false" - -GET_VOL_BY_ID <- - "https://nyu.databrary.org/api/volume/%s?access&citation&links&funding&top&tags&excerpts&comments&records&containers=all&metrics&state" -GET_VOLUME_FUNDING <- "https://nyu.databrary.org/api/volume/%s?funding=all" -GET_VOLUME_MINIMUM <- "https://nyu.databrary.org/api/volume/%s" -GET_VOLUME_LINKS <- "https://nyu.databrary.org/api/volume/%s?links=all" -GET_VOLUME_TAGS <- "https://nyu.databrary.org/api/volume/%s?tags=all" -GET_VOLUME_ACTIVITY <- "https://nyu.databrary.org/api/volume/%s/activity" -GET_VOLUME_ZIP <- "https://nyu.databrary.org/volume/%s/zip/false" -GET_VOLUME_EXCERPTS <- "https://nyu.databrary.org/api/volume/%s?excerpts=all" - -GET_ASSET_BY_ID <- "https://nyu.databrary.org/api/asset/%s" -GET_ASSET_BY_VOLUME_SESSION_ID <- - "https://nyu.databrary.org/api/volume/%s/slot/%s/asset/%s" - -# LOGIN <- "https://nyu.databrary.org/api/user/login" -# LOGOUT <- "https://nyu.databrary.org/api/user/logout" - -QUERY_SLOT <- - "https://nyu.databrary.org/api/slot/%s/-?records&assets&excerpts&tags&comments" -QUERY_VOLUME_FUNDER <- "https://nyu.databrary.org/api/funder?query=%s" -QUERY_KEYWORDS <- "https://nyu.databrary.org/api/search?q=%s" -QUERY_TAGS <- "https://nyu.databrary.org/api/tags/%s" - -SESSION_CSV <- "https://nyu.databrary.org/volume/%s/csv" - -UPLOAD_CHUNK <- "https://nyu.databrary.org/api/upload" -UPDATE_SLOT <- "https://nyu.databrary.org/api/slot/%s" - -# Authentication parameters -# USER_AGENT <- -# "databraryr (https://cran.r-project.org/package=databraryr)" -# KEYRING_SERVICE <- 'org.databrary.databraryr' +API_ACTIVITY_SUMMARY <- "/statistics/summary/" +API_GROUPED_FORMATS <- "/grouped-formats/" +API_USERS <- "/users/" +API_USER_DETAIL <- "/users/%s/" +API_USER_VOLUMES <- "/users/%s/volumes/" +API_USER_SPONSORSHIPS <- "/users/%s/sponsorships/" +API_USER_AFFILIATES <- "/users/%s/affiliates/" +API_USER_AVATAR <- "/users/%s/avatar/" +API_USERS_HISTORY <- "/users/%s/history/" +API_INSTITUTIONS <- "/institutions/%s/" +API_INSTITUTION_AFFILIATES <- "/institutions/%s/affiliates/" +API_INSTITUTION_AVATAR <- "/institutions/%s/avatar/" +API_VOLUMES <- "/volumes/" +API_VOLUME_DETAIL <- "/volumes/%s/" +API_VOLUME_TAGS <- "/volumes/%s/tags/" +API_VOLUME_LINKS <- "/volumes/%s/links/" +API_VOLUME_FUNDINGS <- "/volumes/%s/fundings/" +API_VOLUME_COLLABORATORS <- "/volumes/%s/collaborators/" +API_VOLUME_HISTORY <- "/volumes/%s/history/" +API_VOLUME_SESSIONS <- "/volumes/%s/sessions/" +API_VOLUME_FOLDERS <- "/volumes/%s/folders/" +API_SESSION_DETAIL <- "/volumes/%s/sessions/%s/" +API_SESSION_FILES <- "/volumes/%s/sessions/%s/files/" +API_SESSION_FILE_DETAIL <- "/volumes/%s/sessions/%s/files/%s/" +API_FILES_DOWNLOAD_LINK <- "/volumes/%s/sessions/%s/files/%s/download-link/" +API_SESSION_DOWNLOAD_LINK <- "/volumes/%s/sessions/%s/download-link/" +API_SESSION_CSV_DOWNLOAD_LINK <- "/volumes/%s/sessions/%s/csv-download-link/" +API_FOLDER_DETAIL <- "/volumes/%s/folders/%s/" +API_FOLDER_FILES <- "/volumes/%s/folders/%s/files/" +API_VOLUME_DOWNLOAD_LINK <- "/volumes/%s/download-link/" +API_VOLUME_CSV_DOWNLOAD_LINK <- "/volumes/%s/csv-download-link/" +API_SEARCH_VOLUMES <- "/search/volumes/" +API_SEARCH_USERS <- "/search/users/" +API_SEARCH_INSTITUTIONS <- "/search/institutions/" +API_FUNDERS <- "/funders/" -# httr2 request parameters RETRY_LIMIT <- 3 RETRY_WAIT_TIME <- 1 # seconds RETRY_BACKOFF <- 2 # exponential backoff REQUEST_TIMEOUT <- 5 # seconds REQUEST_TIMEOUT_VERY_LONG <- 600 -# Base host ----------------------------------------------------------------- - -DATABRARY_BASE_URL <- Sys.getenv("DATABRARY_BASE_URL", "https://api.stg-databrary.its.nyu.edu") - -# OAuth endpoints ------------------------------------------------------------- OAUTH_TOKEN_URL <- sprintf("%s/o/token/", DATABRARY_BASE_URL) OAUTH_TEST_URL <- sprintf("%s/oauth2/test/", DATABRARY_BASE_URL) -# Authentication parameters --------------------------------------------------- - USER_AGENT <- Sys.getenv("USER_AGENT", "SRW$*Kxy2nYdyo4LozoGV#i6LvH/") KEYRING_SERVICE <- 'org.databrary.databraryr' diff --git a/R/api_utils.R b/R/api_utils.R new file mode 100644 index 00000000..7c5787b5 --- /dev/null +++ b/R/api_utils.R @@ -0,0 +1,176 @@ +# Internal helpers for interacting with the Databrary Django API. + +#' @noRd +ensure_leading_slash <- function(path) { + assertthat::assert_that(assertthat::is.string(path)) + if (startsWith(path, "/")) { + path + } else { + paste0("/", path) + } +} + +#' @noRd +build_query_params <- function(params) { + if (length(params) == 0) { + return(NULL) + } + + keep <- !vapply(params, is.null, logical(1)) + params <- params[keep] + lapply(params, function(value) { + if (is.logical(value)) { + # API expects lowercase true/false + tolower(as.character(value)) + } else { + value + } + }) +} + +#' @noRd +perform_api_get <- function(path, + params = list(), + rq = NULL, + vb = FALSE, + parser = NULL, + normalize = TRUE, + response_type = c("json", "raw", "text")) { + response_type <- match.arg(response_type) + + request <- rq + if (is.null(request)) { + request <- databraryr::make_default_request() + } + + url <- paste0(DATABRARY_BASE_URL, ensure_leading_slash(path)) + request <- httr2::req_url(request, url) + + query <- build_query_params(params) + if (!is.null(query) && length(query) > 0) { + request <- do.call(httr2::req_url_query, c(list(request), query)) + } + + response <- tryCatch( + httr2::req_perform(request), + httr2_error = function(cnd) { + if (vb) { + message("Request failed for ", url, ": ", conditionMessage(cnd)) + } + NULL + } + ) + + if (is.null(response)) { + return(NULL) + } + + body <- switch( + response_type, + json = { + payload <- httr2::resp_body_json(response) + if (isTRUE(normalize)) { + payload <- snake_case_list(payload) + } + payload + }, + raw = httr2::resp_body_raw(response), + text = httr2::resp_body_string(response) + ) + + if (!is.null(parser) && is.function(parser)) { + body <- parser(body) + } + body +} + +#' @noRd +collect_paginated_get <- function(path, + params = list(), + rq = NULL, + vb = FALSE, + normalize = TRUE) { + next_url <- paste0(DATABRARY_BASE_URL, ensure_leading_slash(path)) + first_iter <- TRUE + query <- build_query_params(params) + + aggregated <- list() + + while (!is.null(next_url)) { + request <- rq + if (is.null(request)) { + request <- databraryr::make_default_request(refresh = first_iter) + } + + request <- httr2::req_url(request, next_url) + if (first_iter && !is.null(query) && length(query) > 0) { + request <- do.call(httr2::req_url_query, c(list(request), query)) + } + + resp <- tryCatch( + httr2::req_perform(request), + httr2_error = function(cnd) { + if (vb) { + message("Request failed for ", next_url, ": ", conditionMessage(cnd)) + } + NULL + } + ) + + if (is.null(resp)) { + return(NULL) + } + + body <- httr2::resp_body_json(resp) + if (isTRUE(normalize)) { + body <- snake_case_list(body) + } + + page_results <- body$results + if (is.null(page_results)) { + if (is.list(body) && length(body) > 0 && (is.null(names(body)) || all(names(body) == ""))) { + page_results <- body + } else { + page_results <- list() + } + } + + aggregated <- c(aggregated, page_results) + + next_url <- body[["next"]] + if (!is.null(next_url) && !startsWith(next_url, "http")) { + next_url <- paste0(DATABRARY_BASE_URL, ensure_leading_slash(next_url)) + } + if (!is.null(next_url)) { + next_url <- sub("^http://", "https://", next_url) + } + + first_iter <- FALSE + } + + aggregated +} + +#' @noRd +camel_to_snake <- function(x) { + x <- gsub("(.)([A-Z][a-z]+)", "\\1_\\2", x) + tolower(gsub("([a-z0-9])([A-Z])", "\\1_\\2", x)) +} + +#' @noRd +snake_case_list <- function(obj) { + if (is.list(obj)) { + names_list <- names(obj) + if (!is.null(names_list)) { + names(obj) <- vapply(names_list, camel_to_snake, character(1)) + } + obj <- lapply(obj, snake_case_list) + obj + } else if (is.vector(obj) && !is.null(names(obj))) { + names(obj) <- vapply(names(obj), camel_to_snake, character(1)) + obj + } else { + obj + } +} + diff --git a/R/assign_constants.R b/R/assign_constants.R index bcc64bd3..3ebb5c6e 100644 --- a/R/assign_constants.R +++ b/R/assign_constants.R @@ -17,27 +17,43 @@ NULL #' } #' @export assign_constants <- function(vb = options::opt("vb"), rq = NULL) { - # Check parameter assertthat::assert_that(is.logical(vb)) - - if (is.null(rq)) - rq <- databraryr::make_default_request() - arq <- rq %>% - httr2::req_url(GET_CONSTANTS) - - if (vb) message("Retrieving constants.") - resp <- tryCatch( - httr2::req_perform(arq), - httr2_error = function(cnd) { - if (vb) message("Error loading Databrary constants.") - NULL - } + if (vb) { + message("Retrieving grouped formats and static enums.") + } + + grouped <- perform_api_get( + path = API_GROUPED_FORMATS, + rq = rq, + vb = vb, + normalize = TRUE ) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - resp - } else { - httr2::resp_body_json(resp) + + if (is.null(grouped)) { + message("Unable to load grouped format metadata from Databrary.") + return(NULL) + } + + lists <- grouped$root + if (is.null(lists)) { + lists <- grouped } + + format_entries <- purrr::imap(lists, function(items, category) { + purrr::map(items, function(item) { + item$category <- category + item + }) + }) |> + purrr::list_c() + + formats_df <- purrr::map(format_entries, tibble::as_tibble) |> + purrr::list_rbind() + + list( + format = format_entries, + format_df = formats_df, + permission = databraryr:::get_permission_levels_enums(), + release = databraryr:::get_release_levels_enums() + ) } diff --git a/R/download_party_avatar.R b/R/download_party_avatar.R deleted file mode 100644 index 7a6b55af..00000000 --- a/R/download_party_avatar.R +++ /dev/null @@ -1,136 +0,0 @@ -#' @eval options::as_params() -#' @name options_params -#' -NULL - -#' Returns the Avatar(s) (images) for Authorized User(s). -#' -#' @param party_id A number or range of numbers. Party number or numbers to retrieve information about. Default is 6 -#' (Rick Gilmore). -#' @param show_party_info A logical value. Show the person's name and affiliation in the output. -#' Default is TRUE. -#' @param rq An `httr2` request object. If not provided, a new request is -#' generated via `make_default_request()`. -#' -#' @returns An list with the avatar (image) file and a name_affil string. -#' -#' @inheritParams options_params -#' -#' @examples -#' \donttest{ -#' \dontrun{ -#' download_party_avatar() # Show Rick Gilmore's (party 6) avatar. -#' -#' # Download avatars from Databrary's founders (without name/affiliations) -#' download_party_avatar(5:7, show_party_info = FALSE) -#' -#' # Download NYU logo -#' download_party_avatar(party = 8) -#' } -#' } -#' @export -download_party_avatar <- function(party_id = 6, - show_party_info = TRUE, - vb = options::opt("vb"), - rq = NULL) { - - # Check parameters - assertthat::is.number(party_id) - assertthat::assert_that(!is.character(party_id)) - assertthat::assert_that(!is.logical(party_id)) - assertthat::assert_that(sum(party_id >= 1) == length(party_id)) - - assertthat::assert_that(length(show_party_info) == 1) - assertthat::assert_that(is.logical(show_party_info)) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - # Handle NULL request - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - - if (vb) - message("Attempting to retrieve avatars for parties: ", - min(party_id), - ":", - max(party_id)) - - purrr::map( - party_id, - get_single_avatar, - show_party_info = show_party_info, - vb = vb, - rq = rq, - .progress = TRUE - ) -} - -#------------------------------------------------------------------------------ -# Helper function for handling multiple queries -get_single_avatar <- function(party_id = 6, - show_party_info = TRUE, - vb = FALSE, - rq = NULL) { - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - - arq <- rq %>% - httr2::req_url(sprintf(GET_PARTY_AVATAR, party_id)) - - resp <- tryCatch( - httr2::req_perform(arq), - httr2_error = function(cnd) { - if (vb) - message("Error retrieving avatar for party_id ", party_id) - NULL - } - ) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } - - # Download avatar - party_avatar <- httr2::resp_body_raw(resp) %>% - magick::image_read() - - if (show_party_info) { - party_str <- paste0("Data for Databrary party ", party_id, ":") - - party_info <- databraryr::get_party_by_id(party_id) - if (is.list(party_info)) { - if ("affiliation" %in% names(party_info)) { - if (vb) - message(party_str) - party_str <- - paste0(party_info$prename, - " ", - party_info$sortname, - ", ", - party_info$affiliation) - } else { - party_str <- - paste0(party_info$sortname) - } - } else { - message("Unable to extract info for party '", party_id, "'.") - } - } - - list(avatar = party_avatar, name_affil = party_str) -} diff --git a/R/get_db_stats.R b/R/get_db_stats.R index 4036cd34..c42b7c14 100644 --- a/R/get_db_stats.R +++ b/R/get_db_stats.R @@ -58,77 +58,28 @@ get_db_stats <- function(type = "stats", } rq <- databraryr::make_default_request() } - rq <- rq %>% - httr2::req_url(GET_ACTIVITY_DATA) - - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) { - if (vb) - message("Error retrieving Databrary '", type, "' stats.") - NULL - } + stats <- perform_api_get( + path = API_ACTIVITY_SUMMARY, + rq = rq, + vb = vb ) - if (is.null(resp)) { + if (is.null(stats)) { message("Cannot access requested resource on Databrary. Exiting.") - return(resp) + return(NULL) } - if (httr2::resp_status(resp) == 200) { - r <- httr2::resp_body_json(resp) - - if (type %in% c("stats", "numbers")) { - tibble::tibble( - date = Sys.time(), - investigators = unlist(r$stats$authorized[5]), - affiliates = unlist(r$stats$authorized[4]), - institutions = unlist(r$stats$authorized[6]), - datasets_total = r$stats$volumes, - datasets_shared = r$stats$shared, - n_files = r$stats$assets, - hours = r$stats$duration / (1000 * 60 * 60), - TB = r$stats$bytes / (1e12) - ) # seems incorrect - } else { - purrr::map(r$activity, process_db_activity_blob_item, type) |> - purrr::list_rbind() - } - } -} - -#------------------------------------------------------------------------------ -process_db_activity_blob_item <- function(activity_blob, type) { - df <- activity_blob |> - purrr::flatten() |> - tibble::as_tibble() - - if (!is.null(df)) { - if (type %in% c("datasets", "volumes", "data")) { - if ("owners" %in% names(df)) { - df <- dplyr::filter(df, !is.na(df$id)) - } else { - return(NULL) - } - } else if (type %in% c("institutions", "places")) { - if ("institution" %in% names(df)) { - df <- dplyr::filter(df, !is.na(df$id), !is.na(df$institution)) - } else { - return(NULL) - } - } else if (type %in% c("people", "researchers", "investigators")) { - if ("affiliation" %in% names(df)) { - df <- dplyr::filter( - df, - !is.na(df$id), - !is.na(df$affiliation), - !is.na(df$sortname), - !is.na(df$prename) - ) - } else { - return(NULL) - } - } - df + if (type %in% c("stats", "numbers")) { + tibble::tibble( + date = Sys.time(), + investors = stats$authorized_users, + datasets_total = stats$total_volumes, + datasets_shared = stats$public_volumes, + n_files = stats$total_files, + hours = stats$total_duration_hours, + TB = stats$total_storage_tb + ) + } else { + tibble::as_tibble(stats$recent_activity) } } diff --git a/R/get_folder_by_id.R b/R/get_folder_by_id.R new file mode 100644 index 00000000..025b85c8 --- /dev/null +++ b/R/get_folder_by_id.R @@ -0,0 +1,56 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get Folder Metadata From a Databrary Volume. +#' +#' @param folder_id Folder identifier within the specified volume. +#' @param vol_id Volume identifier containing the folder. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @returns A list representing the folder metadata, or `NULL` when the folder +#' cannot be accessed. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' get_folder_by_id() # Default folder in volume 1 +#' } +#' } +#' @export +get_folder_by_id <- function(folder_id = 1, + vol_id = 1, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(length(folder_id) == 1) + assertthat::assert_that(is.numeric(folder_id)) + assertthat::assert_that(folder_id >= 1) + + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id >= 1) + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + folder <- perform_api_get( + path = sprintf(API_FOLDER_DETAIL, vol_id, folder_id), + rq = rq, + vb = vb + ) + + if (is.null(folder)) { + if (vb) { + message("Cannot access requested folder ", folder_id, " in volume ", vol_id) + } + return(NULL) + } + + folder +} + diff --git a/R/get_institution_by_id.R b/R/get_institution_by_id.R new file mode 100644 index 00000000..267717c3 --- /dev/null +++ b/R/get_institution_by_id.R @@ -0,0 +1,46 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get institution metadata +#' +#' @param institution_id Institution identifier. +#' @inheritParams options_params +#' +#' @return List of institution metadata or NULL when inaccessible. +#' @export +get_institution_by_id <- function(institution_id = 12, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(is.numeric(institution_id), length(institution_id) == 1, institution_id > 0) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + institution <- perform_api_get( + path = sprintf(API_INSTITUTIONS, institution_id), + rq = rq, + vb = vb + ) + + if (is.null(institution)) { + if (vb) message("Institution ", institution_id, " not found or inaccessible.") + return(NULL) + } + + tibble::tibble( + id = institution$id, + name = institution$name, + url = institution$url, + date_signed = institution$date_signed, + source = institution$source, + created_at = institution$created_at, + updated_at = institution$updated_at, + has_avatar = institution$has_avatar, + has_administrators = institution$has_administrators, + latitude = institution$latitude, + longitude = institution$longitude, + manual_coordinates = institution$manual_coordinates + ) %>% + as.list() +} + diff --git a/R/get_party_by_id.R b/R/get_party_by_id.R deleted file mode 100644 index a68a32ae..00000000 --- a/R/get_party_by_id.R +++ /dev/null @@ -1,76 +0,0 @@ -#' @eval options::as_params() -#' @name options_params -#' -NULL - -#' Download Information About a Party on Databrary as JSON -#' -#' @param party_id An integer. The party number to retrieve information about. -#' @param parents_children_access A logical value. If TRUE (the default), -#' returns _all_ of the data about the party. If FALSE, only a minimum amount -#' of information about the party is returned. -#' @param rq An `httr2`-style request object. If NULL, then a new request will -#' be generated using `make_default_request()`. -#' -#' @returns A nested list with information about the party. -#' This can be readily parsed by other functions. -#' -#' @inheritParams options_params -#' -#' @examples -#' \donttest{ -#' \dontrun{ -#' get_party_by_id() -#' } -#' } -#' @export -get_party_by_id <- function(party_id = 6, - parents_children_access = TRUE, - vb = options::opt("vb"), - rq = NULL) { - # Check parameters - assertthat::assert_that(is.numeric(party_id)) - assertthat::assert_that(party_id >= 1) - - assertthat::assert_that(length(parents_children_access) == 1) - assertthat::assert_that(is.logical(parents_children_access)) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - if (is.null(rq)) { - if (vb) { - message("\nNULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - - if (parents_children_access) { - endpoint <- GET_PARTY_BY_ID - } else { - endpoint <- GET_PARTY_NO_PARENTS_CHILDREN - } - prq <- rq %>% - httr2::req_url(sprintf(endpoint, party_id)) - - if (vb) message("Querying API for party id ", party_id, ".") - resp <- tryCatch( - httr2::req_perform(prq), - httr2_error = function(cnd) { - if (vb) - message("Error retrieving information for party_id ", party_id) - NULL - } - ) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } else { - httr2::resp_body_json(resp) - } -} diff --git a/R/get_session_by_id.R b/R/get_session_by_id.R index 55df7ab0..8f1d561b 100644 --- a/R/get_session_by_id.R +++ b/R/get_session_by_id.R @@ -28,72 +28,32 @@ get_session_by_id <- vol_id = 1, vb = options::opt("vb"), rq = NULL) { - + assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id > 0) assertthat::assert_that(length(session_id) == 1) - + assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) assertthat::assert_that(length(vol_id) == 1) - + assertthat::assert_that(is.logical(vb)) assertthat::assert_that(length(vb) == 1) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - # Handle NULL rq - if (is.null(rq)) { + + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + session <- perform_api_get( + path = sprintf(API_SESSION_DETAIL, vol_id, session_id), + rq = rq, + vb = vb + ) + + if (is.null(session)) { if (vb) { - message("\nNULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") + message("Cannot access requested session ", session_id, " in volume ", vol_id) } - rq <- databraryr::make_default_request() - } - - #-------------------------------------------------------------------------- - extract_session_metadata <- function(volume_json) { - - assertthat::assert_that(is.list(volume_json)) - - extract_single_session <- function(i, sessions) { - this_session <- sessions$value[[i]] - tibble::tibble(id = this_session$id, top = this_session$top, name = this_session$name) - } - - these_sessions <- tibble::enframe(volume_json$containers) - n_sessions <- dim(these_sessions)[1] - purrr::map(1:n_sessions, extract_single_session, these_sessions) %>% - purrr::list_rbind() - } - #-------------------------------------------------------------------------- - - volume_json <- NULL - volume_json <- get_volume_by_id(vol_id, vb, rq) - - if (!is.null(volume_json)) { - session_metadata <- extract_session_metadata(volume_json) - if (!(session_id %in% session_metadata$id)) { - if (vb) message("Session ", session_id, " not found.") - return(NULL) - } else { - rq <- rq %>% - httr2::req_url(sprintf(QUERY_SLOT, session_id)) - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) - NULL - ) - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } else { - httr2::resp_body_json(resp) - } - } - } else { - if (vb) message("No data returned from volume ", vol_id) - NULL + return(NULL) } + + session } diff --git a/R/get_session_by_name.R b/R/get_session_by_name.R index 4f912b0e..83defef3 100644 --- a/R/get_session_by_name.R +++ b/R/get_session_by_name.R @@ -30,8 +30,9 @@ get_session_by_name <- vol_id = 1, vb = options::opt("vb"), rq = NULL) { - assertthat::is.string(session_name) + assertthat::assert_that(assertthat::is.string(session_name)) assertthat::assert_that(length(session_name) == 1) + assertthat::assert_that(!is.na(session_name)) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) @@ -40,52 +41,21 @@ get_session_by_name <- assertthat::assert_that(is.logical(vb)) assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - if (is.null(rq)) { - if (vb) { - message("\nNULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - - #-------------------------------------------------------------------------- - extract_session_metadata <- function(volume_json) { - assertthat::assert_that(is.list(volume_json)) - - extract_single_session <- function(i, sessions) { - this_session <- sessions$value[[i]] - tibble::tibble(id = this_session$id, - top = this_session$top, - name = this_session$name) - } - - these_sessions <- tibble::enframe(volume_json$containers) - n_sessions <- dim(these_sessions)[1] - purrr::map(1:n_sessions, extract_single_session, these_sessions) %>% - purrr::list_rbind() - } - #-------------------------------------------------------------------------- - - volume_json <- NULL - volume_json <- get_volume_by_id(vol_id, vb, rq) - session_metadata <- extract_session_metadata(volume_json) - - name <- NULL - name_matches <- dplyr::filter(session_metadata, name == session_name) - - if (is.null(name_matches)) { - message("No matches") - return(NULL) - } - if (dim(name_matches)[1] == 0) { - message("Empty array") + sessions <- collect_paginated_get( + path = sprintf(API_VOLUME_SESSIONS, vol_id), + params = list(search = session_name), + rq = rq, + vb = vb + ) + + if (is.null(sessions) || length(sessions) == 0) { + if (vb) message("No sessions named '", session_name, "' in volume ", vol_id) return(NULL) } - if (dim(name_matches)[1] > 1) { - message("\nMultiple sessions with name '", session_name, "'.") - } - purrr::map(name_matches$id, get_session_by_id, vol_id, rq = rq) + + purrr::map(sessions, function(session) { + databraryr::get_session_by_id(session_id = session$id, vol_id = vol_id, vb = vb, rq = rq) + }) } \ No newline at end of file diff --git a/R/get_user_by_id.R b/R/get_user_by_id.R new file mode 100644 index 00000000..52bc3ae0 --- /dev/null +++ b/R/get_user_by_id.R @@ -0,0 +1,46 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get public profile information for a Databrary user +#' +#' @param user_id User identifier. +#' @inheritParams options_params +#' +#' @return A list with the user's public metadata. +#' @export +get_user_by_id <- function(user_id = 6, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(is.numeric(user_id), length(user_id) == 1, user_id > 0) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + user <- perform_api_get( + path = sprintf(API_USER_DETAIL, user_id), + rq = rq, + vb = vb + ) + + if (is.null(user)) { + if (vb) message("User ", user_id, " not found or inaccessible.") + return(NULL) + } + + affiliation <- user$affiliation + institution_name <- affiliation$name + institution_id <- affiliation$id + + tibble::tibble( + id = user$id, + prename = user$first_name, + sortname = user$last_name, + email = user$email, + affiliation = institution_name, + affiliation_id = institution_id, + is_authorized_investigator = user$is_authorized_investigator, + has_avatar = user$has_avatar + ) %>% + as.list() +} + diff --git a/R/get_volume_by_id.R b/R/get_volume_by_id.R index b9a8167b..9480730e 100644 --- a/R/get_volume_by_id.R +++ b/R/get_volume_by_id.R @@ -33,28 +33,43 @@ get_volume_by_id <- function(vol_id = 1, assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - # Handle NULL rq - if (is.null(rq)) { - if (vb) { - message("\nNULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - rq <- rq %>% - httr2::req_url(sprintf(GET_VOL_BY_ID, vol_id)) - if (vb) message("Retrieving data for vol_id ", vol_id, ".") - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) - NULL + + volume <- perform_api_get( + path = sprintf(API_VOLUME_DETAIL, vol_id), + rq = rq, + vb = vb ) - if (is.null(resp)) { + + if (is.null(volume)) { message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } else { - httr2::resp_body_json(resp) + return(NULL) } + + tibble::tibble( + id = volume$id, + updated_at = volume$updated_at, + created_at = volume$created_at, + title = volume$title, + description = purrr::pluck(volume, "description", .default = NA_character_), + short_name = purrr::pluck(volume, "short_name", .default = NA_character_), + owner_connection = list(purrr::pluck(volume, "owner_connection", .default = NULL)), + owner_institution = list(volume$owner_institution), + sharing_level = volume$sharing_level, + access_level = volume$access_level, + has_admin_access = purrr::pluck(volume, "has_admin_access", .default = NA), + fundings = list(purrr::pluck(volume, "fundings", .default = NULL)), + coauthors = list(purrr::pluck(volume, "coauthors", .default = NULL)), + links = list(purrr::pluck(volume, "links", .default = NULL)), + enabled_categories = list(purrr::pluck(volume, "enabled_categories", .default = NULL)), + enabled_metrics = list(purrr::pluck(volume, "enabled_metrics", .default = NULL)), + citation = list(purrr::pluck(volume, "citation", .default = NULL)), + session_count = volume$session_count, + session_count_shared = volume$session_count_shared, + participant_count = purrr::pluck(volume, "participant_count", .default = NA_integer_), + participant_gender_counts = list(purrr::pluck(volume, "participant_gender_counts", .default = NULL)), + file_counts = list(volume$file_counts), + thumbnail = list(purrr::pluck(volume, "thumbnail", .default = NULL)) + ) } \ No newline at end of file diff --git a/R/list_authorized_investigators.R b/R/list_authorized_investigators.R index 43b1a73d..e6419454 100644 --- a/R/list_authorized_investigators.R +++ b/R/list_authorized_investigators.R @@ -1,69 +1,30 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL -#' List Authorized Investigators at Institution -#' -#' @param party_id Target party ID. -#' @param rq An `httr2`-style request object. If NULL, then a new request will -#' be generated using `make_default_request()`. -#' -#' @returns A data frame with information the institution's authorized -#' investigators. +#' List authorized investigators for an institution #' -#' @inheritParams options_params +#' @inheritParams list_institution_affiliates #' -#' @examples -#' \donttest{ -#' \dontrun{ -#' list_institutional_affiliates() # Default is Penn State (party 12) -#' } -#' } +#' @return Tibble of investigators; NULL if none. #' @export -list_authorized_investigators <- function(party_id = 12, +list_authorized_investigators <- function(institution_id = 12, vb = options::opt("vb"), rq = NULL) { - assertthat::is.number(party_id) - assertthat::assert_that(is.numeric(party_id)) - assertthat::assert_that(party_id >= 1) - assertthat::assert_that(length(party_id) == 1) - - assertthat::assert_that(is.logical(vb)) - assertthat::assert_that(length(vb) == 1) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - # Handle NULL rq - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - - this_party <- databraryr::get_party_by_id(party_id, vb = vb, rq = rq) - - if (is.null(this_party)) { - if (vb) - message("No data for party ", party_id) - return(NULL) - } - - if (!("institution" %in% names(this_party))) { - if (vb) - message("Party ", party_id, " not an institution.") + assertthat::assert_that(is.numeric(institution_id), length(institution_id) == 1, institution_id > 0) + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + affiliates <- list_institution_affiliates(institution_id, vb = vb, rq = rq) + if (is.null(affiliates)) { return(NULL) } - - if (dim(as.data.frame(this_party$children))[1] == 0) { - if (vb) - message("Party ", party_id, " has no affiliates.") + + investigators <- affiliates |> dplyr::filter(.data$role == "investigator") + if (nrow(investigators) == 0) { return(NULL) } - - purrr::map(this_party$children, as.data.frame, .progress = TRUE) %>% - purrr::list_rbind() -} \ No newline at end of file + investigators +} + diff --git a/R/list_folder_assets.R b/R/list_folder_assets.R new file mode 100644 index 00000000..b701f33c --- /dev/null +++ b/R/list_folder_assets.R @@ -0,0 +1,102 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List Assets Within a Databrary Folder. +#' +#' @param folder_id Folder identifier scoped to the given volume. +#' @param vol_id Volume containing the folder. Required for Django API calls. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @returns A tibble with metadata for files contained in the folder, or +#' `NULL` when the folder has no accessible assets. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' list_folder_assets(folder_id = 1, vol_id = 1) +#' } +#' } +#' @export +list_folder_assets <- function(folder_id = 1, + vol_id = NULL, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(length(folder_id) == 1) + assertthat::assert_that(is.numeric(folder_id)) + assertthat::assert_that(folder_id >= 1) + + if (is.null(vol_id)) { + stop("vol_id must be supplied for list_folder_assets(); folder identifiers are scoped to volumes.", + call. = FALSE) + } + + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id >= 1) + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + folder <- databraryr::get_folder_by_id( + folder_id = folder_id, + vol_id = vol_id, + vb = vb, + rq = rq + ) + + if (is.null(folder)) { + return(NULL) + } + + files <- collect_paginated_get( + path = sprintf(API_FOLDER_FILES, vol_id, folder_id), + rq = rq, + vb = vb + ) + + if (is.null(files) || length(files) == 0) { + if (vb) { + message("No assets for folder_id ", folder_id) + } + return(NULL) + } + + file_rows <- purrr::map_dfr(files, function(file) { + format <- file$format + uploader <- file$uploader + + tibble::tibble( + asset_id = file$id, + asset_name = file$name, + asset_permission = file$release_level, + asset_size = file$size, + asset_mime_type = format$mimetype, + asset_format_id = format$id, + asset_format_name = format$name, + asset_duration = file$duration, + asset_created_at = file$created_at, + asset_updated_at = file$updated_at, + asset_uploader_id = uploader$id, + asset_uploader_first_name = uploader$first_name, + asset_uploader_last_name = uploader$last_name, + asset_sha1 = file$sha1, + asset_thumbnail_url = file$thumbnail_url + ) + }) + + file_rows %>% + dplyr::mutate( + folder_id = folder_id, + vol_id = vol_id, + folder_name = folder$name, + folder_release = folder$release_level, + folder_source_date = folder$source_date + ) +} + diff --git a/R/list_institution_affiliates.R b/R/list_institution_affiliates.R new file mode 100644 index 00000000..127c1a1a --- /dev/null +++ b/R/list_institution_affiliates.R @@ -0,0 +1,45 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List affiliates for an institution +#' +#' @param institution_id Institution identifier. +#' @inheritParams options_params +#' +#' @return Tibble of affiliates with roles and expiration dates. +#' @export +list_institution_affiliates <- function(institution_id = 12, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(is.numeric(institution_id), length(institution_id) == 1, institution_id > 0) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + affiliates <- collect_paginated_get( + path = sprintf(API_INSTITUTION_AFFILIATES, institution_id), + rq = rq, + vb = vb + ) + + if (is.null(affiliates) || length(affiliates) == 0) { + if (vb) message("No affiliates for institution ", institution_id) + return(NULL) + } + + purrr::map_dfr(affiliates, function(entry) { + user <- entry$user + tibble::tibble( + institution_id = institution_id, + role = entry$role, + access_level = entry$access_level, + user_id = user$id, + user_prename = user$first_name, + user_sortname = user$last_name, + user_affiliation = user$affiliation$name, + user_affiliation_id = user$affiliation$id, + expiration_date = entry$expiration_date + ) + }) +} + diff --git a/R/list_party_affiliates.R b/R/list_party_affiliates.R deleted file mode 100644 index 0e564b1f..00000000 --- a/R/list_party_affiliates.R +++ /dev/null @@ -1,77 +0,0 @@ -#' @eval options::as_params() -#' @name options_params -#' -NULL - -#' List Affiliates For A Party -#' -#' @param party_id Target party ID. -#' @param rq An `httr2` request object. Defaults to NULL. -#' -#' @returns A data frame with information about a party's affiliates. -#' -#' @inheritParams options_params -#' -#' @examples -#' \donttest{ -#' list_party_affiliates() # Default is Rick Gilmore (party 6) -#' } -#' @export -list_party_affiliates <- function(party_id = 6, - vb = options::opt("vb"), - rq = NULL) { - # Check parameters - assertthat::assert_that(length(party_id) == 1) - assertthat::assert_that(is.numeric(party_id)) - assertthat::assert_that(party_id > 0) - - assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - # Handle NULL rq - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - - if (vb) - message(paste0("Getting affiliates for party ", party_id, ".")) - - g <- databraryr::get_party_by_id(party_id = party_id, vb = vb, rq = rq) - - party.id <- NULL - party.prename <- NULL - party.sortname <- NULL - party.affiliation <- NULL - affiliate_id <- NULL - affiliate_sortname <- NULL - affiliate_prename <- NULL - affiliate_affiliation <- NULL - - if (!is.null(g)) { - if (vb) - message(paste0("Retrieving data for party ", party_id, ".")) - purrr::map(g$children, as.data.frame) %>% - purrr::list_rbind() %>% - dplyr::rename( - affiliate_id = party.id, - affiliate_sortname = party.sortname, - affiliate_prename = party.prename, - affiliate_affiliation = party.affiliation - ) %>% - dplyr::select( - affiliate_id, - affiliate_sortname, - affiliate_prename, - affiliate_affiliation - ) - } else { - if (vb) - message(paste0("No data for party ", party_id, ".")) - NULL - } -} diff --git a/R/list_party_sponsors.R b/R/list_party_sponsors.R deleted file mode 100644 index e98802b3..00000000 --- a/R/list_party_sponsors.R +++ /dev/null @@ -1,99 +0,0 @@ -#' @eval options::as_params() -#' @name options_params -#' -NULL - -#' List Sponsors For A Party -#' -#' @param party_id Target party ID. -#' @param rq An `httr2`-style request object. If NULL, then a new request will -#' be generated using `make_default_request()`. -#' -#' @returns A data frame with information about a party's sponsors. -#' -#' @inheritParams options_params -#' -#' @examples -#' \donttest{ -#' \dontrun{ -#' list_party_sponsors() # Default is Rick Gilmore (party 6) -#' } -#' } -#' -#' @export -list_party_sponsors <- function(party_id = 6, - vb = options::opt("vb"), - rq = NULL) { - # Check parameters - assertthat::assert_that(length(party_id) == 1) - assertthat::assert_that(is.numeric(party_id)) - assertthat::assert_that(party_id > 0) - - assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - # Handle NULL rq - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - - if (vb) - message(paste0("Getting sponsors for party ", party_id, ".")) - - g <- databraryr::get_party_by_id(party_id = party_id, - vb = vb, - rq = rq) - - if (!is.null(g)) { - if (vb) - message(paste0("Retrieving data for party ", party_id, ".")) - - party.id <- NULL - party.sortname <- NULL - party.affiliation <- NULL - party_sortname <- NULL - party_prename <- NULL - party_affiliation <- NULL - party_url <- NULL - sponsor_id <- NULL - sponsor_sortname <- NULL - sponsor_affiliation <- NULL - - purrr::map(g$parents, as.data.frame) %>% - purrr::list_rbind() %>% - # TODO(ROG): Handle cases when other variables exist - dplyr::select(party.id, party.sortname, party.affiliation) %>% - dplyr::rename( - sponsor_id = party.id, - sponsor_sortname = party.sortname, - sponsor_affiliation = party.affiliation - ) %>% - dplyr::mutate( - party_id = party_id, - party_sortname = g$sortname, - party_prename = g$prename, - party_affiliation = g$affiliation, - party_url = g$url - ) %>% - dplyr::select( - party_id, - party_sortname, - party_prename, - party_affiliation, - party_url, - sponsor_id, - sponsor_sortname, - sponsor_affiliation - ) - } else { - if (vb) - message(paste0("No data for party ", party_id, ".")) - NULL - } -} diff --git a/R/list_party_volumes.R b/R/list_party_volumes.R deleted file mode 100644 index 6c61c0c9..00000000 --- a/R/list_party_volumes.R +++ /dev/null @@ -1,104 +0,0 @@ -#' @eval options::as_params() -#' @name options_params -#' -NULL - -#' List Volumes A Party Has Access To -#' -#' @param party_id Target party ID. -#' @param rq An `httr2`-style request object. If NULL, then a new request will -#' be generated using `make_default_request()`. -#' -#' @returns A data frame with information about a party's sponsors. -#' -#' @inheritParams options_params -#' -#' @examples -#' \donttest{ -#' \dontrun{ -#' list_party_volumes() # Default is Rick Gilmore (party 6) -#' } -#' } -#' @export -list_party_volumes <- function(party_id = 6, - vb = options::opt("vb"), - rq = NULL) { - # Check parameters - assertthat::assert_that(length(party_id) == 1) - assertthat::assert_that(is.numeric(party_id)) - assertthat::assert_that(party_id > 0) - - assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - # Handle NULL rq - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - - vol_id <- NULL - - if (vb) - message(paste0("Retrieving data for party ", party_id, ".")) - party_info <- databraryr::get_party_by_id(party_id = party_id, vb = vb, - rq = rq) - - if (!is.null(party_info)) { - if (vb) - message(paste0("Info retrieved. Filtering.")) - purrr::map(party_info$access, extract_vol_fr_party) %>% - purrr::list_rbind() %>% - dplyr::mutate( - party_id = party_id, - party_prename = party_info$prename, - party_sortname = party_info$sortname, - party_affiliation = party_info$affiliation - ) %>% - dplyr::arrange(vol_id) - } else { - if (vb) - message(paste0("No data for party ", party_id, ".")) - party_info - } -} - -#--------------------------------------------------------------------------- -# This is a private, not exported, -# helper function for list_party_volumes() -# -extract_vol_fr_party <- function(p_info) { - assertthat::assert_that(is.list(p_info)) - - this_vol <- p_info$volume - - vol_names <- names(this_vol) - assertthat::assert_that("id" %in% vol_names) - assertthat::assert_that("name" %in% vol_names) - assertthat::assert_that("body" %in% vol_names) - assertthat::assert_that("creation" %in% vol_names) - assertthat::assert_that("permission" %in% vol_names) - - vol_id <- this_vol$id - vol_name <- this_vol$name - vol_body <- this_vol$body - if (!("alias" %in% vol_names)) { - vol_alias <- NA - } else { - vol_alias <- this_vol$alias - } - vol_creation <- this_vol$creation - vol_permission <- this_vol$permission - - tibble::tibble(vol_id, - vol_name, - vol_body, - vol_alias, - vol_creation, - vol_permission) -} \ No newline at end of file diff --git a/R/list_session_activity.R b/R/list_session_activity.R index abdf35a7..915906e4 100644 --- a/R/list_session_activity.R +++ b/R/list_session_activity.R @@ -1,71 +1,144 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL #' List Activity History in Databrary Session. #' -#' If a user has access to a volume and session, this function returns the -#' history of modifications to that session. +#' For an accessible session, returns the logged history events associated with +#' the session. Requires authenticated access with sufficient permissions. #' -#' @param session_id Selected session/slot number. -#' @param rq An `httr2` request object. Defaults to NULL. To access the activity -#' history on a volume a user has privileges on. Create a request -#' (`rq <- make_default_request()`); login using `make_login_client(rq = rq)`; -#' then run `list_session_activity(session_id = , rq = rq)` - -#' @returns A list with the activity history on a session/slot. -#' -#' @inheritParams options_params +#' @param vol_id Volume identifier (required by the Django API). +#' @param session_id Session identifier. +#' @param rq An `httr2` request object. Defaults to `NULL`. When `NULL`, a +#' default request is generated, but this will only permit public information +#' to be returned. #' -#' @examples -#' \donttest{ -#' \dontrun{ -#' # The following will only return output if the user has write privileges -#' # on the session. +#' @returns A tibble with the activity history for a session, or `NULL` when +#' no data is available. +#' +#' @inheritParams options_params #' -#' list_session_activity(session_id = 6256, vb = FALSE) +#' @examples +#' \\donttest{ +#' \\dontrun{ +#' list_session_activity(vol_id = 1892, session_id = 76113) #' } #' } #' @export list_session_activity <- - function(session_id = 6256, + function(vol_id = 1892, + session_id = 76113, vb = options::opt("vb"), rq = NULL) { # Check parameters + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id > 0) + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id > 0) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - + + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } rq <- databraryr::make_default_request() } - rq <- rq %>% - httr2::req_url(sprintf(GET_SESSION_ACTIVITY, session_id)) - - if (vb) message("Retrieving activity for session id, ", session_id, ".") - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) { - NULL + rq <- httr2::req_timeout(rq, REQUEST_TIMEOUT_VERY_LONG) + + activities <- collect_paginated_get( + path = sprintf(API_VOLUME_HISTORY, vol_id), + rq = rq, + vb = vb + ) + + if (is.null(activities) || length(activities) == 0) { + if (vb) { + message("No activity history available for volume ", vol_id) } + return(NULL) + } + + session_details <- databraryr::get_session_by_id( + session_id = session_id, + vol_id = vol_id, + vb = vb, + rq = rq ) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } else { - httr2::resp_body_json(resp) + session_name <- NULL + if (!is.null(session_details)) { + session_name <- session_details$name + } + + session_entries <- purrr::keep(activities, function(entry) { + session_identifier <- entry$session_id + if (is.null(session_identifier) && !is.null(entry$session)) { + session_value <- entry$session + if (is.list(session_value) && !is.null(session_value$id)) { + session_identifier <- session_value$id + } else { + session_identifier <- session_value + } + } + + if (!is.null(session_identifier)) { + return(isTRUE(session_identifier == session_id)) + } + + if (!is.null(session_name) && !is.null(entry$name)) { + return(isTRUE(entry$name == session_name)) + } + + FALSE + }) + + if (length(session_entries) == 0) { + if (vb) { + message("No activity history for session ", session_id, " within volume ", vol_id) + } + return(NULL) } - #TODO: Reformat response. + + purrr::map_dfr(session_entries, function(entry) { + history_user <- entry$history_user + folder_id <- entry$folder_id + if (is.null(folder_id) && !is.null(entry$folder)) { + folder <- entry$folder + if (is.list(folder) && !is.null(folder$id)) { + folder_id <- folder$id + } else { + folder_id <- folder + } + } + + safe_int <- function(value) { + if (is.null(value)) NA_integer_ else value + } + + safe_chr <- function(value) { + if (is.null(value)) NA_character_ else value + } + + tibble::tibble( + event_type = entry$type, + event_timestamp = entry$timestamp, + history_id = safe_int(entry$history_id), + history_user_id = safe_int(history_user$id), + history_user_email = safe_chr(history_user$email), + history_user_first_name = safe_chr(history_user$first_name), + history_user_last_name = safe_chr(history_user$last_name), + ip_address = entry$ip_address, + changed_fields = list(entry$changed_fields), + changed_data = list(entry$changed_data), + volume_id = vol_id, + session_id = session_id, + session_name = safe_chr(entry$name), + folder_id = safe_int(folder_id), + deleted_at = entry$deleted_at + ) + }) } diff --git a/R/list_session_assets.R b/R/list_session_assets.R index c7e0a0e0..dc24c69a 100644 --- a/R/list_session_assets.R +++ b/R/list_session_assets.R @@ -14,6 +14,9 @@ NULL #' #' @param session_id An integer. A Databrary session number. Default is 9807, #' the "materials" folder from Databrary volume 1. +#' @param vol_id Optional integer. The volume containing the session. Recent +#' versions of the Databrary API require this value to be supplied because +#' session identifiers are scoped to volumes. #' @param rq An `httr2` request object. If NULL, a default request is generated #' from databraryr::make_default_request(). #' @@ -29,99 +32,75 @@ NULL #' } #' @export list_session_assets <- function(session_id = 9807, + vol_id = NULL, vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) + if (is.null(vol_id)) { + stop("vol_id must be supplied for list_session_assets(); session identifiers are scoped to volumes.", + call. = FALSE) + } + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id >= 1) assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - # Handle NULL rq - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() + session <- databraryr::get_session_by_id( + session_id = session_id, + vol_id = vol_id, + vb = vb, + rq = rq + ) + + if (is.null(session)) { + return(NULL) } - - this_rq <- rq %>% - httr2::req_url(sprintf(QUERY_SLOT, session_id)) %>% - httr2::req_progress() - - if (vb) - message("Retrieving assets from session id ", session_id, ".") - resp <- tryCatch( - httr2::req_perform(this_rq), - httr2_error = function(cnd) - NULL + + files <- collect_paginated_get( + path = sprintf(API_SESSION_FILES, vol_id, session_id), + rq = rq, + vb = vb ) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } else { - session_list <- httr2::resp_body_json(resp) - if ("assets" %in% names(session_list)) { - assets_df <- purrr::map(session_list$assets, as.data.frame) %>% - purrr::list_rbind() - - # ignore empty sessions - if (dim(assets_df)[1] == 0) - return(NULL) - - if (!('size' %in% names(assets_df))) - assets_df$size <- NA - if (!('duration' %in% names(assets_df))) - assets_df$duration <- NA - if (!('name' %in% names(assets_df))) - assets_df$name <- NA - - id <- NULL - format <- NULL - name <- NULL - duration <- NULL - permission <- NULL - size <- NULL - asset_format_id <- NULL - - assets_df <- assets_df %>% - dplyr::select(id, format, duration, name, permission, size) %>% - dplyr::rename( - asset_id = id, - asset_format_id = format, - asset_name = name, - asset_duration = duration, - asset_permission = permission, - asset_size = size - ) - - format_id <- NULL - format_mimetype <- NULL - format_extension <- NULL - format_name <- NULL - - # Gather asset format info - asset_formats_df <- list_asset_formats(vb = vb) %>% - dplyr::select(format_id, - format_mimetype, - format_extension, - format_name) - - # Join assets with asset format info - out_df <- dplyr::left_join(assets_df, - asset_formats_df, - by = dplyr::join_by(asset_format_id == - format_id)) %>% - dplyr::mutate(session_id = session_id) - - out_df - } else { - if (vb) - message("No assets for session_id ", session_id) - session_list - } + + if (is.null(files) || length(files) == 0) { + if (vb) + message("No assets for session_id ", session_id) + return(NULL) } + + asset_rows <- purrr::map_dfr(files, function(file) { + format <- file$format + uploader <- file$uploader + + tibble::tibble( + asset_id = file$id, + asset_name = file$name, + asset_permission = file$release_level, + asset_size = file$size, + asset_mime_type = format$mimetype, + asset_format_id = format$id, + asset_format_name = format$name, + asset_duration = file$duration, + asset_created_at = file$created_at, + asset_updated_at = file$updated_at, + asset_uploader_id = uploader$id, + asset_uploader_first_name = uploader$first_name, + asset_uploader_last_name = uploader$last_name, + asset_sha1 = file$sha1, + asset_thumbnail_url = file$thumbnail_url + ) + }) + + asset_rows %>% + dplyr::mutate( + session_id = session_id, + vol_id = vol_id, + session_name = session$name, + session_release = session$release_level, + session_date = session$source_date + ) } \ No newline at end of file diff --git a/R/list_sponsors.R b/R/list_sponsors.R deleted file mode 100644 index b10c7a1d..00000000 --- a/R/list_sponsors.R +++ /dev/null @@ -1,72 +0,0 @@ -#' @eval options::as_params() -#' @name options_params -#' -NULL - -#' List Sponsors For A Party -#' -#' @param party_id Target party ID. -#' @param rq An `httr2`-style request object. If NULL, then a new request will -#' be generated using `make_default_request()`. -#' -#' @returns A data frame with information about a party's sponsors. -#' -#' @inheritParams options_params -#' -#' @examples -#' \donttest{ -#' \dontrun{ -#' list_sponsors() # Default is Rick Gilmore (party 6) -#' } -#' } -#' @export -list_sponsors <- function(party_id = 6, - vb = options::opt("vb"), - rq = NULL) { - - # Check parameters - assertthat::assert_that(length(party_id) == 1) - assertthat::assert_that(is.numeric(party_id)) - assertthat::assert_that(party_id > 0) - assertthat::assert_that(is.logical(vb)) - - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - } - message("\nNot logged in. Only public information will be returned.") - rq <- databraryr::make_default_request() - } - - if (vb) - message(paste0("Getting sponsors for party ", party_id, ".")) - - g <- databraryr::get_party_by_id(party_id = party_id, vb = vb, rq = rq) - - party.id <- NULL - party.sortname <- NULL - party.affiliation <- NULL - party.institution <- NULL - party.url <- NULL - - if (!is.null(g)) { - if (vb) - message(paste0("Retrieving data for party ", party_id, ".")) - purrr::map(g$parents, as.data.frame) %>% - purrr::list_rbind() %>% - dplyr::rename(sponsor_id = party.id, - sponsor_sortname = party.sortname, - sponsor_affiliation = party.affiliation, - sponsor_institution = party.institution, - sponsor_url = party.url) %>% - dplyr::mutate(party_id = party_id, - party_sortname = g$sortname, - party_prename = g$prename, - party_affiliation = g$affiliation, - party_url = g$url) - } else { - if (vb) - message(paste0("No data for party ", party_id, ".")) - NULL - } -} diff --git a/R/list_user_affiliates.R b/R/list_user_affiliates.R new file mode 100644 index 00000000..28876019 --- /dev/null +++ b/R/list_user_affiliates.R @@ -0,0 +1,39 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List affiliates for a user +#' +#' @param user_id User identifier. +#' @inheritParams options_params +#' +#' @return Tibble of affiliates for the user. +#' @export +list_user_affiliates <- function(user_id = 6, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(is.numeric(user_id), length(user_id) == 1, user_id > 0) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + affiliates <- collect_paginated_get( + path = sprintf(API_USER_AFFILIATES, user_id), + rq = rq, + vb = vb + ) + + if (is.null(affiliates) || length(affiliates) == 0) { + if (vb) message("No affiliates for user ", user_id) + return(NULL) + } + + purrr::map_dfr(affiliates, function(entry) { + tibble::tibble( + affiliate_user = entry$user, + access_level = entry$access_level, + role = entry$role, + expiration_date = entry$expiration_date + ) + }) +} + diff --git a/R/list_user_history.R b/R/list_user_history.R new file mode 100644 index 00000000..baa70ce5 --- /dev/null +++ b/R/list_user_history.R @@ -0,0 +1,65 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List Account Activity For A Databrary User. +#' +#' @description Retrieve the OAuth and login activity history for a specific +#' user. Access is restricted to administrators and authorized investigators +#' with sufficient privileges. +#' +#' @param user_id Target user identifier. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return A tibble containing authentication and activity events for the +#' selected user, or `NULL` when no entries are available. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' list_user_history(user_id = 22582) +#' } +#' } +#' @export +list_user_history <- function(user_id = 22582, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(is.numeric(user_id)) + assertthat::assert_that(length(user_id) == 1) + assertthat::assert_that(user_id > 0) + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + history <- collect_paginated_get( + path = sprintf(API_USERS_HISTORY, user_id), + rq = rq, + vb = vb + ) + + if (is.null(history) || length(history) == 0) { + if (vb) { + message("No activity history available for user ", user_id) + } + return(NULL) + } + + purrr::map_dfr(history, function(entry) { + tibble::tibble( + user_id = user_id, + history_id = entry$id, + history_email = entry$email, + history_ip_address = entry$ip_address, + history_successful = entry$successful, + history_type = entry$type, + history_timestamp = entry$timestamp + ) + }) +} + + diff --git a/R/list_user_sponsors.R b/R/list_user_sponsors.R new file mode 100644 index 00000000..880e3d58 --- /dev/null +++ b/R/list_user_sponsors.R @@ -0,0 +1,50 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List sponsorships for a user +#' +#' @param user_id User identifier. +#' @inheritParams options_params +#' +#' @return Tibble of sponsors for the user. +#' @export +list_user_sponsors <- function(user_id = 6, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(is.numeric(user_id), length(user_id) == 1, user_id > 0) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + sponsorships <- collect_paginated_get( + path = sprintf(API_USER_SPONSORSHIPS, user_id), + rq = rq, + vb = vb + ) + + if (is.null(sponsorships) || length(sponsorships) == 0) { + if (vb) message("No sponsorships for user ", user_id) + return(NULL) + } + + user <- get_user_by_id(user_id, vb = vb, rq = rq) + + purrr::map_dfr(sponsorships, function(entry) { + sponsor <- entry$user + tibble::tibble( + user_id = user$id, + user_prename = user$prename, + user_sortname = user$sortname, + user_affiliation = user$affiliation, + sponsor_id = sponsor$id, + sponsor_prename = sponsor$first_name, + sponsor_sortname = sponsor$last_name, + sponsor_affiliation = sponsor$affiliation$name, + sponsor_affiliation_id = sponsor$affiliation$id, + access_level = entry$access_level, + role = entry$role, + expiration_date = entry$expiration_date + ) + }) +} + diff --git a/R/list_user_volumes.R b/R/list_user_volumes.R new file mode 100644 index 00000000..5ed63a00 --- /dev/null +++ b/R/list_user_volumes.R @@ -0,0 +1,52 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List volumes associated with a user +#' +#' @param user_id User identifier. +#' @inheritParams options_params +#' +#' @return Tibble of volumes the user owns or collaborates on. +#' @export +list_user_volumes <- function(user_id = 6, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(is.numeric(user_id), length(user_id) == 1, user_id > 0) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + volumes <- collect_paginated_get( + path = sprintf(API_USER_VOLUMES, user_id), + rq = rq, + vb = vb + ) + + if (is.null(volumes) || length(volumes) == 0) { + if (vb) message("No volume data for user ", user_id) + return(NULL) + } + + user <- get_user_by_id(user_id, vb = vb, rq = rq) + user_df <- tibble::as_tibble(user) + + purrr::map(volumes, function(entry) { + tibble::tibble( + vol_id = entry$id, + vol_name = entry$title, + vol_description = entry$description, + vol_short_name = entry$short_name, + vol_created_at = entry$created_at, + vol_updated_at = entry$updated_at, + vol_access_level = entry$access_level, + vol_sharing_level = entry$sharing_level + ) + }) %>% + purrr::list_rbind() %>% + dplyr::mutate(user_id = user_df$id, + user_prename = user_df$prename, + user_sortname = user_df$sortname, + user_affiliation = user_df$affiliation) %>% + dplyr::arrange(vol_id) +} + diff --git a/R/list_users.R b/R/list_users.R new file mode 100644 index 00000000..745916a5 --- /dev/null +++ b/R/list_users.R @@ -0,0 +1,115 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List Databrary Users. +#' +#' @description Retrieve directory metadata for Databrary users. Results can be +#' filtered by name or restricted to specific account types using optional +#' parameters. +#' +#' @param search Optional character string used to filter results by name or +#' email address. +#' @param include_suspended Optional logical value. When `TRUE`, suspended +#' accounts are included in the response. +#' @param exclude_self Optional logical value. When `TRUE`, the authenticated +#' user is omitted from the results. +#' @param is_authorized_investigator Optional logical value restricting the +#' response to authorized investigators. +#' @param has_api_access Optional logical value restricting the response to +#' accounts with API access enabled. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return A tibble containing directory metadata for each user, or `NULL` when +#' no results are available for the supplied filters. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' list_users(search = "gilmore") +#' } +#' } +#' @export +list_users <- function(search = NULL, + include_suspended = NULL, + exclude_self = NULL, + is_authorized_investigator = NULL, + has_api_access = NULL, + vb = options::opt("vb"), + rq = NULL) { + if (!is.null(search)) { + assertthat::assert_that(assertthat::is.string(search)) + } + + validate_flag <- function(value, name) { + if (!is.null(value)) { + assertthat::assert_that(length(value) == 1) + assertthat::assert_that(is.logical(value), msg = paste0(name, " must be logical.")) + } + } + + validate_flag(include_suspended, "include_suspended") + validate_flag(exclude_self, "exclude_self") + validate_flag(is_authorized_investigator, "is_authorized_investigator") + validate_flag(has_api_access, "has_api_access") + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + users <- collect_paginated_get( + path = API_USERS, + params = list( + search = search, + include_suspended = include_suspended, + exclude_self = exclude_self, + is_authorized_investigator = is_authorized_investigator, + has_api_access = has_api_access + ), + rq = rq, + vb = vb + ) + + if (is.null(users) || length(users) == 0) { + if (vb) { + message("No users matched the supplied filters.") + } + return(NULL) + } + + purrr::map_dfr(users, function(user) { + affiliation <- user$affiliation + + affiliation_id <- if (!is.null(affiliation)) affiliation$id else NA_integer_ + affiliation_name <- if (!is.null(affiliation)) affiliation$name else NA_character_ + + suspended_by <- user$suspended_by + suspended_by_id <- if (!is.null(suspended_by)) suspended_by$id else NA_integer_ + suspended_by_email <- if (!is.null(suspended_by)) suspended_by$email else NA_character_ + + tibble::tibble( + user_id = user$id, + user_first_name = user$first_name, + user_last_name = user$last_name, + user_email = user$email, + user_orcid = if (is.null(user$orcid)) NA_character_ else user$orcid, + user_url = if (is.null(user$url)) NA_character_ else user$url, + user_affiliation_id = affiliation_id, + user_affiliation_name = affiliation_name, + user_is_authorized_investigator = user$is_authorized_investigator, + user_has_avatar = user$has_avatar, + user_is_suspended = if (is.null(user$is_suspended)) NA else user$is_suspended, + user_suspended_by_id = suspended_by_id, + user_suspended_by_email = suspended_by_email, + user_institution_sponsorships = list(user$institution_sponsorships), + user_current_affiliates = list(user$current_affiliates), + user_current_sponsors = list(user$current_sponsors) + ) + }) +} + + diff --git a/R/list_volume_activity.R b/R/list_volume_activity.R index 4c42ba5f..cbef27f8 100644 --- a/R/list_volume_activity.R +++ b/R/list_volume_activity.R @@ -21,12 +21,12 @@ NULL #' # The following will only return output if the user has write privileges #' # on the volume. #' -#' list_volume_activity(vol_id = 1) # Activity on volume 1. +#' list_volume_activity(vol_id = 1892) # Activity on volume 1892. #' } #' } #' @export list_volume_activity <- - function(vol_id = 1, + function(vol_id = 1892, vb = options::opt("vb"), rq = NULL) { # Check parameters @@ -38,34 +38,70 @@ list_volume_activity <- assertthat::assert_that(is.logical(vb)) if (vb) message('list_volume_activity()...') - + if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } rq <- databraryr::make_default_request() } - rq <- rq %>% - httr2::req_url(sprintf(GET_VOLUME_ACTIVITY, vol_id)) - - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) { - NULL - } + rq <- httr2::req_timeout(rq, REQUEST_TIMEOUT_VERY_LONG) + + activities <- collect_paginated_get( + path = sprintf(API_VOLUME_HISTORY, vol_id), + rq = rq, + vb = vb ) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } else { - res <- httr2::resp_body_json(resp) - if (!(is.null(res))) { - res - } else { - if (vb) message("Unable to convert from JSON.") - return(NULL) - } + + if (is.null(activities)) { + if (vb) + message("Cannot access requested resource on Databrary. Exiting.") + return(NULL) } + + purrr::map_dfr(activities, function(entry) { + history_user <- entry$history_user + folder_id <- entry$folder_id + if (is.null(folder_id) && !is.null(entry$folder)) { + folder <- entry$folder + if (is.list(folder) && !is.null(folder$id)) { + folder_id <- folder$id + } else { + folder_id <- folder + } + } + + session_id <- entry$session_id + if (is.null(session_id) && !is.null(entry$session)) { + session <- entry$session + if (is.list(session) && !is.null(session$id)) { + session_id <- session$id + } else { + session_id <- session + } + } + + safe_int <- function(value) { + if (is.null(value)) NA_integer_ else value + } + + safe_chr <- function(value) { + if (is.null(value)) NA_character_ else value + } + + tibble::tibble( + event_type = entry$type, + event_timestamp = entry$timestamp, + history_id = safe_int(entry$history_id), + history_user_id = safe_int(history_user$id), + history_user_email = safe_chr(history_user$email), + history_user_first_name = safe_chr(history_user$first_name), + history_user_last_name = safe_chr(history_user$last_name), + ip_address = entry$ip_address, + changed_fields = list(entry$changed_fields), + changed_data = list(entry$changed_data), + volume_id = vol_id, + session_id = safe_int(session_id), + session_name = safe_chr(entry$name), + folder_id = safe_int(folder_id), + deleted_at = entry$deleted_at + ) + }) } diff --git a/R/list_volume_assets.R b/R/list_volume_assets.R index 4d5bb35a..d9c038ca 100644 --- a/R/list_volume_assets.R +++ b/R/list_volume_assets.R @@ -39,99 +39,62 @@ list_volume_assets <- function(vol_id = 1, rq <- databraryr::make_default_request() } - vol_list <- databraryr::get_volume_by_id(vol_id, vb, rq) - if (!("containers" %in% names(vol_list))) { + sessions <- collect_paginated_get( + path = sprintf(API_VOLUME_SESSIONS, vol_id), + rq = rq, + vb = vb + ) + + if (is.null(sessions) || length(sessions) == 0) { if (vb) - message("No session/containers data from volume ", vol_id) + message("No sessions found for volume ", vol_id) return(NULL) } - - if (vb) - message("Extracting asset info...") - this_volume_assets_df <- - purrr::map( - vol_list$containers, - get_assets_from_session, - ignore_materials = FALSE, - .progress = TRUE - ) %>% - purrr::list_rbind() - - if (dim(this_volume_assets_df)[1] == 0) { + + files <- purrr::map(sessions, function(session) { + session_files <- collect_paginated_get( + path = sprintf(API_SESSION_FILES, vol_id, session$id), + rq = rq, + vb = vb + ) + + if (is.null(session_files) || length(session_files) == 0) { + return(NULL) + } + + purrr::map(session_files, function(file) { + format <- file$format + uploader <- file$uploader + tibble::tibble( + asset_id = file$id, + asset_name = file$name, + asset_permission = file$release_level, + asset_size = file$size, + asset_mime_type = format$mimetype, + asset_format_id = format$id, + asset_format_name = format$name, + asset_duration = file$duration, + asset_created_at = file$created_at, + asset_updated_at = file$updated_at, + asset_uploader_id = uploader$id, + asset_uploader_first_name = uploader$first_name, + asset_uploader_last_name = uploader$last_name, + asset_sha1 = file$sha1, + asset_thumbnail_url = file$thumbnail_url, + session_id = session$id, + session_name = session$name, + session_date = session$source_date, + session_release = session$release_level + ) + }) %>% + purrr::list_rbind() + }) %>% purrr::list_rbind() + + if (is.null(files) || nrow(files) == 0) { if (vb) message("No assets in volume_id ", vol_id, ".") return(NULL) } - if (!("asset_format_id" %in% names(this_volume_assets_df))) { - if (vb) - message("'asset_format_id' field not found in assets data frame.") - return(NULL) - } - - format_id <- NULL - format_mimetype <- NULL - format_extension <- NULL - format_name <- NULL - asset_format_id <- NULL - - asset_formats_df <- databraryr::list_asset_formats(vb = vb) %>% - dplyr::select(format_id, format_mimetype, format_extension, format_name) - - dplyr::left_join( - this_volume_assets_df, - asset_formats_df, - by = dplyr::join_by(asset_format_id == format_id) - ) -} -#------------------------------------------------------------------------------- -#' Helper function for list_volume_assets -#' -#' @param volume_container The 'container' list from a volume. -#' @param ignore_materials A logical value. -#' -get_assets_from_session <- - function(volume_container, ignore_materials = TRUE) { - # ignore materials - if (ignore_materials) { - if ("top" %in% names(volume_container)) - return(NULL) - } - - assets_df <- purrr::map(volume_container$assets, as.data.frame) %>% - purrr::list_rbind() - - # ignore empty sessions - if (dim(assets_df)[1] == 0) - return(NULL) - - if (!('size' %in% names(assets_df))) - assets_df$size <- NA - if (!('duration' %in% names(assets_df))) - assets_df$duration <- NA - if (!('name' %in% names(assets_df))) - assets_df$name <- NA - - # Initialize values to avoid check() error - id <- NULL - duration <- NULL - name <- NULL - permission <- NULL - size <- NULL - - assets_df %>% - dplyr::select(id, format, duration, name, permission, size) %>% - dplyr::rename( - asset_id = id, - asset_format_id = format, - asset_name = name, - asset_duration = duration, - asset_permission = permission, - asset_size = size - ) %>% - dplyr::mutate( - session_id = volume_container$id, - session_date = volume_container$date, - session_release = volume_container$release - ) - } + files +} diff --git a/R/list_volume_collaborators.R b/R/list_volume_collaborators.R new file mode 100644 index 00000000..9b73f4a0 --- /dev/null +++ b/R/list_volume_collaborators.R @@ -0,0 +1,80 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List Collaborators On A Databrary Volume. +#' +#' @description Retrieve collaboration metadata for a specified volume, +#' including sponsor details and access levels. +#' +#' @param vol_id Target volume number. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return A tibble summarizing collaborator relationships on the volume, or +#' `NULL` when no collaborators are associated with the volume. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' list_volume_collaborators(vol_id = 1) +#' } +#' } +#' @export +list_volume_collaborators <- function(vol_id = 1, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id > 0) + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + collaborators <- perform_api_get( + path = sprintf(API_VOLUME_COLLABORATORS, vol_id), + rq = rq, + vb = vb + ) + + if (is.null(collaborators) || length(collaborators) == 0) { + if (vb) { + message("No collaborators found for volume ", vol_id) + } + return(NULL) + } + + purrr::map_dfr(collaborators, function(entry) { + user <- entry$user + sponsor <- entry$sponsor + + sponsor_id <- if (!is.null(sponsor)) sponsor$id else NA_integer_ + sponsor_first <- if (!is.null(sponsor)) sponsor$first_name else NA_character_ + sponsor_last <- if (!is.null(sponsor)) sponsor$last_name else NA_character_ + sponsor_email <- if (!is.null(sponsor)) sponsor$email else NA_character_ + + tibble::tibble( + collaborator_id = entry$id, + volume_id = vol_id, + collaborator_user_id = if (is.null(user)) NA_integer_ else user$id, + collaborator_first_name = if (is.null(user)) NA_character_ else user$first_name, + collaborator_last_name = if (is.null(user)) NA_character_ else user$last_name, + collaborator_email = if (is.null(user)) NA_character_ else user$email, + collaborator_is_authorized_investigator = if (is.null(user$is_authorized_investigator)) NA else user$is_authorized_investigator, + collaborator_has_avatar = if (is.null(user$has_avatar)) NA else user$has_avatar, + sponsor_user_id = sponsor_id, + sponsor_first_name = sponsor_first, + sponsor_last_name = sponsor_last, + sponsor_email = sponsor_email, + access_level = if (is.null(entry$access_level)) NA_character_ else entry$access_level, + is_publicly_visible = if (is.null(entry$is_publicly_visible)) NA else entry$is_publicly_visible, + expiration_date = if (is.null(entry$expiration_date)) NA_character_ else entry$expiration_date + ) + }) +} + + diff --git a/R/list_volume_excerpts.R b/R/list_volume_excerpts.R deleted file mode 100644 index acf62ac3..00000000 --- a/R/list_volume_excerpts.R +++ /dev/null @@ -1,60 +0,0 @@ -#' @eval options::as_params() -#' @name options_params -#' -NULL - -#' List Image or Video Excerpts On A Databrary Volume. -#' -#' @param vol_id Target volume number. -#' @param rq An `httr2` request object. Default is NULL. -#' -#' @returns A list with information about any available excerpts. -#' -#' @inheritParams options_params -#' -#' @examples -#' \donttest{ -#' list_volume_excerpts() -#' } -#' -#' @export -list_volume_excerpts <- - function(vol_id = 1, - vb = options::opt("vb"), - rq = NULL) { - # Check parameters - assertthat::assert_that(length(vol_id) == 1) - assertthat::assert_that(is.numeric(vol_id)) - assertthat::assert_that(vol_id > 0) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - rq <- rq %>% - httr2::req_url(sprintf(GET_VOLUME_EXCERPTS, vol_id)) - - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) { - NULL - } - ) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } else { - httr2::resp_body_json(resp) - } - # TODO: Reformat response. - } diff --git a/R/list_volume_folders.R b/R/list_volume_folders.R new file mode 100644 index 00000000..ea19094b --- /dev/null +++ b/R/list_volume_folders.R @@ -0,0 +1,69 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List Folders in a Databrary Volume. +#' +#' @param vol_id Target volume number. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @returns A tibble with metadata about folders in the selected volume, or +#' `NULL` when no folders are available. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' list_volume_folders() # Folders in volume 1 +#' } +#' } +#' @export +list_volume_folders <- function(vol_id = 1, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id >= 1) + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + folders <- collect_paginated_get( + path = sprintf(API_VOLUME_FOLDERS, vol_id), + rq = rq, + vb = vb + ) + + if (is.null(folders) || length(folders) == 0) { + if (vb) { + message("No folders available for volume ", vol_id) + } + return(NULL) + } + + purrr::map_dfr(folders, function(folder) { + volume_value <- folder$volume + if (is.null(volume_value)) { + volume_value <- vol_id + } + + tibble::tibble( + folder_id = folder$id, + folder_name = folder$name, + folder_release = folder$release_level, + folder_file_count = folder$file_count, + folder_accessible_file_count = folder$accessible_file_count, + folder_has_full_access = folder$has_full_access, + folder_contains_different_release_levels = folder$contains_different_release_levels, + folder_created_at = folder$created_at, + folder_updated_at = folder$updated_at, + folder_source_date = folder$source_date, + vol_id = volume_value + ) + }) +} + diff --git a/R/list_volume_funding.R b/R/list_volume_funding.R index c58dde23..64240d53 100644 --- a/R/list_volume_funding.R +++ b/R/list_volume_funding.R @@ -49,72 +49,33 @@ list_volume_funding <- function(vol_id = 1, rq <- databraryr::make_default_request() } - #------------------------------------------------------------ if (vb) message("Summarizing funding for n=", length(vol_id), " volumes.") - purrr::map( - vol_id, - list_single_volume_funding, - add_id = add_id, - vb = vb, - rq = rq, - .progress = "Volume funding: " - ) %>% - purrr::list_rbind() -} - -#------------------------------------------------------------------------------- -# Helper function for handling lists -list_single_volume_funding <- - function(vol_id = NULL, - add_id = NULL, - vb = NULL, - rq) { - if (is.null(rq)) { - rq <- databraryr::make_default_request() - } - rq <- rq %>% - httr2::req_url(sprintf(GET_VOLUME_FUNDING, vol_id)) - - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) { - NULL - } + purrr::map(vol_id, function(id) { + fundings <- perform_api_get( + path = sprintf(API_VOLUME_FUNDINGS, id), + rq = rq, + vb = vb ) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } else { - res <- httr2::resp_body_json(resp) - if (!(is.null(res))) { - out_df <- purrr::map(res$funding, extract_funder_info) %>% - purrr::list_rbind() - if (add_id) - out_df <- dplyr::mutate(out_df, vol_id = vol_id) - out_df - } + + if (is.null(fundings) || length(fundings) == 0) { + return(NULL) } - } -#------------------------------------------------------------------------------- -extract_funder_info <- function(vol_funder_list_item) { - assertthat::assert_that("list" %in% class(vol_funder_list_item)) - assertthat::assert_that("funder" %in% names(vol_funder_list_item)) - assertthat::assert_that("awards" %in% names(vol_funder_list_item)) - - funder_id <- vol_funder_list_item$funder$id - funder_name <- vol_funder_list_item$funder$name - if (length(vol_funder_list_item$awards) == 0) { - funder_award <- NA - } else { - funder_award <- vol_funder_list_item$awards %>% unlist() - } - tibble::tibble( - funder_id = funder_id, - funder_name = funder_name, - funder_award = funder_award - ) + rows <- purrr::map_dfr(fundings, function(entry) { + funder <- entry$funder + tibble::tibble( + funder_id = funder$id, + funder_name = funder$name, + funder_is_approved = funder$is_approved, + funder_awards = entry$awards + ) + }) + if (add_id) { + rows <- dplyr::mutate(rows, vol_id = id) + } + rows + }) %>% + purrr::list_rbind() } diff --git a/R/list_volume_info.R b/R/list_volume_info.R index abf77794..842f2ccf 100644 --- a/R/list_volume_info.R +++ b/R/list_volume_info.R @@ -37,85 +37,64 @@ list_volume_info <- assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - # Handle NULL rq - if (is.null(rq)) { - if (vb) { - message("\nNULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - - # Make character array of "release" constants to decode release index - constants <- databraryr::assign_constants() - release_levels <- constants$release |> - as.character() - - vol_list <- databraryr::get_volume_by_id(vol_id = vol_id, vb = vb, rq = rq) - if (is.null(vol_list)) { + volume <- databraryr::get_volume_by_id(vol_id = vol_id, vb = vb, rq = rq) + if (is.null(volume)) { return(NULL) } else { - # Extract owner info - if (vb) message("Extracting owner info...") - id <- NULL - name <- NULL - owner_name <- NULL - vol_owners <- purrr::map(vol_list$owners, tibble::as_tibble) %>% - purrr::list_rbind() %>% - dplyr::rename(party_id = id, owner_name = name) %>% - dplyr::filter(!(stringr::str_detect(owner_name, "Databrary"))) - - vol_owners_str <- stringr::str_flatten(vol_owners$owner_name, - collapse = "; ") - - # Extract session info - if (vb) message("Extracting session info...") - vol_sessions <- purrr::map(vol_list$containers, get_info_from_session, - release_levels = release_levels) %>% - purrr::list_rbind() - if (is.null(vol_sessions)) { - n_vol_sessions <- 0 - } else { - n_vol_sessions <- dim(vol_sessions)[1] - } - - # Extract funder info - if (vb) message("Extracting funder info...") - vol_funders <- purrr::map(vol_list$funding, extract_funder_info) %>% - purrr::list_rbind() - if (is.null(vol_funders)) { - n_vol_funders <- 0 - } else { - n_vol_funders <- dim(vol_funders)[1] - } - - # Extract asset info + if (vb) message("Summarising volume detail...") + + owner_connection <- volume$owner_connection + owner_institution <- volume$owner_institution + + session_count <- volume$session_count[[1]] + session_count_shared <- volume$session_count_shared[[1]] + + file_counts <- volume$file_counts[[1]] + + fundings <- perform_api_get( + path = sprintf(API_VOLUME_FUNDINGS, vol_id), + rq = rq, + vb = vb + ) + n_vol_funders <- if (is.null(fundings)) 0 else length(fundings) + vol_assets <- list_volume_assets(vol_id = vol_id, vb = vb, rq = rq) - - if (is.null(vol_assets)) { + + if (is.null(vol_assets) || nrow(vol_assets) == 0) { n_vol_assets <- 0 tot_vol_size_mb <- 0 tot_vol_dur_hrs <- 0 } else { - n_vol_assets <- dim(vol_assets)[1] - tot_vol_size_mb <- round(sum(stats::na.omit(vol_assets$asset_size))/(1024*1024), 3) - tot_vol_dur_hrs <- round(sum(stats::na.omit(vol_assets$asset_duration))/(1000*60*60), 3) + n_vol_assets <- nrow(vol_assets) + tot_vol_size_mb <- round(sum(stats::na.omit(vol_assets$asset_size)) / (1024 * 1024), 3) + tot_vol_dur_hrs <- if ("asset_duration" %in% names(vol_assets)) { + round(sum(stats::na.omit(vol_assets$asset_duration)) / 3600, 3) + } else { + NA_real_ + } } - - # Create output data frame/tibble + tibble::tibble( - vol_id = vol_list$id, - vol_name = vol_list$name, - vol_doi = vol_list$doi, - vol_desc = vol_list$body, - vol_creation = vol_list$creation, - vol_publicaccess = vol_list$publicaccess, - vol_owners = vol_owners_str, - vol_n_sessions = n_vol_sessions, + vol_id = volume$id, + vol_name = volume$title, + vol_short_name = volume$short_name, + vol_desc = volume$description, + vol_created_at = volume$created_at, + vol_updated_at = volume$updated_at, + vol_sharing_level = volume$sharing_level, + vol_access_level = volume$access_level, + vol_owner_connection = owner_connection, + vol_owner_institution = owner_institution, + vol_n_sessions = session_count, + vol_n_sessions_shared = session_count_shared, + vol_file_counts = list(file_counts), vol_n_assets = n_vol_assets, vol_tot_size_mb = tot_vol_size_mb, vol_tot_dur_hrs = tot_vol_dur_hrs, - vol_n_funders = n_vol_funders - ) + vol_n_funders = n_vol_funders, + vol_enabled_categories = list(volume$enabled_categories[[1]]), + vol_enabled_metrics = list(volume$enabled_metrics[[1]]), + vol_citation = list(volume$citation[[1]]) + ) } } diff --git a/R/list_volume_links.R b/R/list_volume_links.R index 57cfce60..ced97f18 100644 --- a/R/list_volume_links.R +++ b/R/list_volume_links.R @@ -30,34 +30,23 @@ list_volume_links <- function(vol_id = 1, assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - rq <- rq %>% - httr2::req_url(sprintf(GET_VOLUME_LINKS, vol_id)) - - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) { - NULL - } + links <- perform_api_get( + path = sprintf(API_VOLUME_LINKS, vol_id), + rq = rq, + vb = vb ) - - head <- NULL - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } else { - res <- httr2::resp_body_json(resp) - if (!(is.null(res$links))) { - purrr::map(res$links, tibble::as_tibble) %>% - purrr::list_rbind() %>% - dplyr::rename(link_name = head, link_url = url) %>% - dplyr::mutate(vol_id = vol_id) - } + + if (is.null(links) || length(links) == 0) { + return(NULL) } + + purrr::map_dfr(links, function(link) { + tibble::tibble( + link_id = link$id, + link_label = link$title, + link_url = link$url, + link_description = link$description, + link_release_level = link$release_level + ) + }) } diff --git a/R/list_volume_owners.R b/R/list_volume_owners.R deleted file mode 100644 index bc9ac2da..00000000 --- a/R/list_volume_owners.R +++ /dev/null @@ -1,73 +0,0 @@ -#' @eval options::as_params() -#' @name options_params -#' -NULL - -#' List Owners of a Databrary Volume. -#' -#' @param vol_id Selected volume number. Default is volume 1. -#' @param rq An `httr2` request object. If NULL (the default) -#' a request will be generated, but this will only permit public information -#' to be returned. -#' -#' @returns A data frame with information about a volume's owner(s). -#' -#' @inheritParams options_params -#' -#' @examples -#' \donttest{ -#' list_volume_owners() # Lists information about the owners of volume 1. -#' } -#' @export -list_volume_owners <- function(vol_id = 1, - vb = options::opt("vb"), - rq = NULL) { - # Check parameters - assertthat::assert_that(length(vol_id) == 1) - assertthat::assert_that(is.numeric(vol_id)) - assertthat::assert_that(vol_id > 0) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - # Handle NULL rq - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - rq <- rq %>% - httr2::req_url(sprintf(GET_VOLUME_MINIMUM, vol_id)) - - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) { - NULL - } - ) - - # Initialize - party_id <- NULL - id <- NULL - owner_name <- NULL - name <- NULL - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } else { - res <- httr2::resp_body_json(resp) - if (!(is.null(res$owners))) { - purrr::map(res$owners, tibble::as_tibble) %>% - purrr::list_rbind() %>% - dplyr::rename(party_id = id, owner_name = name) %>% - dplyr::filter(!(stringr::str_detect(owner_name, "Databrary"))) - } - - } -} diff --git a/R/list_volume_session_assets.R b/R/list_volume_session_assets.R index 2dd1ea2a..851fad24 100644 --- a/R/list_volume_session_assets.R +++ b/R/list_volume_session_assets.R @@ -24,114 +24,85 @@ NULL #' @examples #' \donttest{ #' \dontrun{ -#' list_volume_session_assets() # Session 9807 in volume 1 +#' list_volume_session_assets() # Defaults to session 11 in volume 2 #' } #' } #' @export list_volume_session_assets <- - function(vol_id = 1, - session_id = 9807, + function(vol_id = 2, + session_id = 11, vb = options::opt("vb"), rq = NULL) { - # Check parameters assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - + assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) if (is.null(rq)) { if (vb) { message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") } rq <- databraryr::make_default_request() } - - vol_list <- databraryr::get_volume_by_id(vol_id, vb, rq) - - if (!("containers" %in% names(vol_list))) { + + session <- perform_api_get( + path = sprintf(API_SESSION_DETAIL, vol_id, session_id), + rq = rq, + vb = vb + ) + + if (is.null(session)) { if (vb) - message("No session/containers data from volume ", vol_id) + message("No matching session_id: ", session_id) return(NULL) } - - #-------------------------------------------------------------------------- - get_sessions <- function(volume_container) { - tibble::tibble(session_id = volume_container$id) - } - #-------------------------------------------------------------------------- - - # Select session info - these_sessions <- - purrr::map(vol_list$containers, get_sessions) %>% - purrr::list_rbind() - - session_match <- (session_id == these_sessions$session_id) - if (sum(session_match) == 0) { + + files <- collect_paginated_get( + path = sprintf(API_SESSION_FILES, vol_id, session_id), + rq = rq, + vb = vb + ) + + if (is.null(files) || length(files) == 0) { if (vb) - message("No matching session_id: ", session_id) + message("No assets in session_id ", session_id) return(NULL) } - session_match_index <- seq_along(session_match)[session_match] - - this_session <- vol_list$containers[[session_match_index]] - if (is.null(this_session)) - return(NULL) - - assets_df <- - purrr::map(this_session$assets, as.data.frame) %>% - purrr::list_rbind() - - # ignore empty sessions - if (dim(assets_df)[1] == 0) - return(NULL) - - if (!('size' %in% names(assets_df))) - assets_df$size = NA - if (!('duration' %in% names(assets_df))) - assets_df$duration = NA - if (!('name' %in% names(assets_df))) - assets_df$name = NA - - id <- NULL - format <- NULL - name <- NULL - duration <- NULL - permission <- NULL - size <- NULL - asset_format_id <- NULL - - assets_df <- assets_df %>% - dplyr::select(id, format, duration, name, permission, size) %>% - dplyr::rename( - asset_id = id, - asset_format_id = format, - asset_name = name, - asset_duration = duration, - asset_permission = permission, - asset_size = size + + asset_rows <- purrr::map(files, function(file) { + format <- file$format + uploader <- file$uploader + + tibble::tibble( + asset_id = file$id, + asset_name = file$name, + asset_permission = file$release_level, + asset_size = file$size, + asset_mime_type = format$mimetype, + asset_format_id = format$id, + asset_format_name = format$name, + asset_duration = file$duration, + asset_created_at = file$created_at, + asset_updated_at = file$updated_at, + asset_uploader_id = uploader$id, + asset_uploader_first_name = uploader$first_name, + asset_uploader_last_name = uploader$last_name, + asset_sha1 = file$sha1, + asset_thumbnail_url = file$thumbnail_url, + session_id = session$id, + session_name = session$name, + session_release = session$release_level ) - - format_id <- NULL - format_mimetype <- NULL - format_extension <- NULL - format_name <- NULL - - # Gather asset format info - asset_formats_df <- list_asset_formats(vb = vb) %>% - dplyr::select(format_id, format_mimetype, format_extension, format_name) - - # Join assets with asset format info - out_df <- dplyr::left_join(assets_df, - asset_formats_df, - by = dplyr::join_by(asset_format_id == format_id)) - out_df + }) %>% + purrr::list_rbind() + + asset_rows } diff --git a/R/list_volume_sessions.R b/R/list_volume_sessions.R index c8feb025..d8020b29 100644 --- a/R/list_volume_sessions.R +++ b/R/list_volume_sessions.R @@ -43,79 +43,46 @@ list_volume_sessions <- ("httr2_request" %in% class(rq))) - # Handle NULL rq - if (is.null(rq)) { - if (vb) { - message("\nNULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - - vol_list <- databraryr::get_volume_by_id(vol_id = vol_id, vb = vb, rq = rq) - if (!("containers" %in% names(vol_list))) { + sessions <- collect_paginated_get( + path = sprintf(API_VOLUME_SESSIONS, vol_id), + rq = rq, + vb = vb + ) + + if (is.null(sessions) || length(sessions) == 0) { if (vb) - message("No session/containers data from volume ", vol_id) + message("No session data for volume ", vol_id) return(NULL) } - - # Make character array of "release" constants to decode release index - constants <- databraryr::assign_constants() - release_levels <- constants$release |> - as.character() - - df <- purrr::map(vol_list$containers, get_info_from_session, - release_levels = release_levels, - .progress = vb) %>% - purrr::list_rbind() + + df <- purrr::map_dfr(sessions, function(session) { + tibble::tibble( + session_id = session$id, + session_name = session$name, + session_release = session$release_level, + session_source_date = session$source_date, + session_file_count = session$file_count, + session_accessible_file_count = session$accessible_file_count, + session_has_full_access = session$has_full_access + ) + }) if (include_vol_data) { + volume <- perform_api_get( + path = sprintf(API_VOLUME_DETAIL, vol_id), + rq = rq, + vb = vb + ) + df <- df %>% dplyr::mutate( - vol_id = as.character(vol_list$id), - vol_name = as.character(vol_list$name), - vol_creation = as.character(vol_list$creation), - vol_publicaccess = as.character(vol_list$publicaccess) + vol_id = volume$id, + vol_name = volume$title, + vol_created_at = volume$created_at, + vol_updated_at = volume$updated_at, + vol_sharing_level = volume$sharing_level, + vol_access_level = volume$access_level ) } - df - } - -#------------------------------------------------------------------------------- -#' List Sessions Info in Databrary Volume Container -#' -#' @param volume_container A component of a volume list returned by -#' get_volume_by_id(). -#' @param ignore_materials A logical value specifying whether to ignore -#' "materials" folders. -#' Default is TRUE -#' @param release_levels A data frame mapping release level indices to release -#' level text values. -get_info_from_session <- - function(volume_container, ignore_materials = FALSE, release_levels) { - - # Make character array of "release" constants to decode release index - constants <- databraryr::assign_constants() - release_levels <- constants$release |> - as.character() - - # ignore materials - if (ignore_materials) { - if ("top" %in% names(volume_container)) - return(NULL) - } else { - if (!("name" %in% names(volume_container))) - volume_container$name <- NA - if (!("date" %in% names(volume_container))) - volume_container$date <- NA - if (!("release" %in% names(volume_container))) - volume_container$release <- NA - } - - tibble::tibble( - session_id = as.character(volume_container$id), - session_name = as.character(volume_container$name), - session_date = as.character(volume_container$date), - session_release = as.character(release_levels[volume_container$release]) - ) + tibble::as_tibble(df) } diff --git a/R/list_volume_tags.R b/R/list_volume_tags.R index 408c0515..ddb63768 100644 --- a/R/list_volume_tags.R +++ b/R/list_volume_tags.R @@ -31,35 +31,17 @@ list_volume_tags <- function(vol_id = 1, assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - # Handle NULL rq - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - rq <- rq %>% - httr2::req_url(sprintf(GET_VOLUME_TAGS, vol_id)) - - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) { - NULL - } + tags <- perform_api_get( + path = sprintf(API_VOLUME_TAGS, vol_id), + rq = rq, + vb = vb ) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } else { - res <- httr2::resp_body_json(resp) - if (!(is.null(res$tags))) { - purrr::map(res$tags, extract_vol_tag) %>% - purrr::list_rbind() %>% - dplyr::mutate(vol_id = vol_id) - } + + if (is.null(tags) || length(tags) == 0) { + return(NULL) } + + tags } #------------------------------------------------------------------------------- diff --git a/R/list_volumes.R b/R/list_volumes.R new file mode 100644 index 00000000..7409bbd0 --- /dev/null +++ b/R/list_volumes.R @@ -0,0 +1,86 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List Volumes Accessible Through The Databrary API. +#' +#' @description Returns summary metadata for volumes accessible to the +#' authenticated user. Results can be filtered by search term or ordering. +#' +#' @param search Optional character string used to filter volumes by title or +#' description. +#' @param ordering Optional character string indicating the sort field accepted +#' by the API (e.g., `"title"`, `"-title"`). +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return A tibble summarizing each accessible volume, or `NULL` when no +#' volumes match the supplied filters. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' list_volumes(search = "workshop") +#' } +#' } +#' @export +list_volumes <- function(search = NULL, + ordering = NULL, + vb = options::opt("vb"), + rq = NULL) { + if (!is.null(search)) { + assertthat::assert_that(assertthat::is.string(search)) + } + if (!is.null(ordering)) { + assertthat::assert_that(assertthat::is.string(ordering)) + } + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + volumes <- collect_paginated_get( + path = API_VOLUMES, + params = list( + search = search, + ordering = ordering + ), + rq = rq, + vb = vb + ) + + if (is.null(volumes) || length(volumes) == 0) { + if (vb) { + message("No volumes matched the supplied filters.") + } + return(NULL) + } + + purrr::map_dfr(volumes, function(volume) { + owner_connection <- volume$owner_connection + owner_user <- if (!is.null(owner_connection)) owner_connection$user else NULL + owner_institution <- volume$owner_institution + + tibble::tibble( + volume_id = volume$id, + volume_title = volume$title, + volume_short_name = if (is.null(volume$short_name)) NA_character_ else volume$short_name, + volume_sharing_level = volume$sharing_level, + volume_access_level = volume$access_level, + volume_owner_connection_id = if (is.null(owner_connection)) NA_integer_ else owner_connection$id, + volume_owner_role = if (is.null(owner_connection$role)) NA_character_ else owner_connection$role, + volume_owner_expiration_date = if (is.null(owner_connection$expiration_date)) NA_character_ else owner_connection$expiration_date, + volume_owner_user_id = if (is.null(owner_user)) NA_integer_ else owner_user$id, + volume_owner_user_first_name = if (is.null(owner_user$first_name)) NA_character_ else owner_user$first_name, + volume_owner_user_last_name = if (is.null(owner_user$last_name)) NA_character_ else owner_user$last_name, + volume_owner_user_email = if (is.null(owner_user$email)) NA_character_ else owner_user$email, + volume_owner_institution_id = if (is.null(owner_institution)) NA_integer_ else owner_institution$id, + volume_owner_institution_name = if (is.null(owner_institution$name)) NA_character_ else owner_institution$name + ) + }) +} + + diff --git a/R/misc_enums.R b/R/misc_enums.R new file mode 100644 index 00000000..e5920cde --- /dev/null +++ b/R/misc_enums.R @@ -0,0 +1,43 @@ +# Enumerations mirroring constants exposed by the Django backend. + +#' @noRd +get_permission_levels_enums <- function() { + list( + volume_access_levels = c( + "superuser", + "owner", + "investigator", + "read write", + "read only", + "read only shared", + "read only public", + "read only overview", + "none" + ) + ) +} + +#' @noRd +get_release_levels_enums <- function() { + list( + levels = list( + list( + code = "private", + description = "This content is not shared and is restricted to collaborators." + ), + list( + code = "authorized_users", + description = "This content is restricted to authorized Databrary users and may not be redistributed in any form." + ), + list( + code = "learning_audiences", + description = "This content is restricted to authorized Databrary users, who may use clips or images from it in presentations for informational or educational purposes. Such presentations may be videotaped or recorded and those videos or recordings may then be made available to the public via the internet (e.g., YouTube)." + ), + list( + code = "public", + description = "This content is available to the public." + ) + ) + ) +} + diff --git a/R/search_for_funder.R b/R/search_for_funder.R index b6267939..0b0928b8 100644 --- a/R/search_for_funder.R +++ b/R/search_for_funder.R @@ -6,6 +6,8 @@ NULL #' Report Information About A Funder. #' #' @param search_string String to search. +#' @param approved_only Logical. When TRUE (default) only approved funders are +#' returned. Set to FALSE to include unapproved funders as well. #' @param rq An `httr2` request object. Default is NULL. #' #' @returns A data frame with information about the funder. @@ -19,45 +21,61 @@ NULL #' #' @export search_for_funder <- - function(search_string = "national+science+foundation", + function(search_string = "national science foundation", + approved_only = TRUE, vb = options::opt("vb"), rq = NULL) { - # Check parameters assertthat::assert_that(length(search_string) == 1) assertthat::assert_that(is.character(search_string)) + search_string <- gsub("[+]", " ", search_string) + pattern <- stringr::str_trim(search_string) + assertthat::assert_that(is.logical(approved_only), length(approved_only) == 1) assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() + params <- list() + if (!approved_only) { + params$all <- "true" } - rq <- rq %>% - httr2::req_url(sprintf(QUERY_VOLUME_FUNDER, search_string)) - if (vb) - message("Retrieving data for funder string '", search_string, "'.") - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) { - NULL - } + funders <- collect_paginated_get( + path = API_FUNDERS, + params = params, + rq = rq, + vb = vb ) + + if (is.null(funders) || length(funders) == 0) { + if (vb) message("No funders available from API.") + return(NULL) + } - if (vb) - message('search_for_keywords()...') - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } else { - httr2::resp_body_json(resp) %>% as.data.frame() + funder_tbl <- purrr::map_dfr(funders, function(entry) { + tibble::tibble( + funder_id = entry$id, + funder_name = entry$name, + funder_is_approved = entry$is_approved + ) + }) + + if (!nzchar(pattern)) { + return(funder_tbl) } + + matches <- stringr::str_detect( + stringr::str_to_lower(funder_tbl$funder_name), + stringr::str_to_lower(pattern) + ) + result <- funder_tbl[matches, , drop = FALSE] + + if (nrow(result) == 0) { + if (vb) message("No funders matched query '", search_string, "'.") + return(NULL) + } + + result } diff --git a/R/search_for_keywords.R b/R/search_for_keywords.R deleted file mode 100644 index 22ab0f8f..00000000 --- a/R/search_for_keywords.R +++ /dev/null @@ -1,69 +0,0 @@ -#' @eval options::as_params() -#' @name options_params -#' -NULL - -#' Search For Keywords in Databrary Volumes. -#' -#' @param search_string String to search. -#' @param rq An `httr2` request object. Default is NULL. -#' -#' @returns A list with the volumes that contain the keyword. -#' -#' @inheritParams options_params -#' -#' @examples -#' \dontrun{ -#' search_for_keywords() # searches for volumes with "locomotion" as a keyword. -#' search_for_keywords() -#' -#' # searches for volumes with "adult" as a keyword. -#' search_for_keywords("adult") -#' } -#' @export -search_for_keywords <- - function(search_string = "locomotion", - vb = options::opt("vb"), - rq = NULL) { - # Check parameters - assertthat::assert_that(length(search_string) == 1) - assertthat::assert_that(is.character(search_string)) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - rq <- rq %>% - httr2::req_url(sprintf(QUERY_KEYWORDS, search_string)) - - if (vb) message("Retrieving data for search string '", search_string, "'.") - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) { - NULL - } - ) - - if (vb) - message('search_for_keywords()...') - - if (vb) - message(paste0("Searching for ", search_string)) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } else { - httr2::resp_body_json(resp) - } - #TODO: Reformat search data - } diff --git a/R/search_for_tags.R b/R/search_for_tags.R index b4b071d5..873690a1 100644 --- a/R/search_for_tags.R +++ b/R/search_for_tags.R @@ -32,27 +32,25 @@ search_for_tags <- assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - rq <- rq |> - httr2::req_url(sprintf(QUERY_TAGS, search_string)) - - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) { - NULL - } + results <- collect_paginated_get( + path = API_SEARCH_VOLUMES, + params = list(tag = search_string), + rq = rq, + vb = vb + ) + + if (is.null(results) || length(results) == 0) { + if (vb) message("No volumes tagged '", search_string, "'.") + return(NULL) + } + + purrr::map_dfr(results, function(entry) { + tibble::tibble( + vol_id = entry$id, + vol_title = entry$title, + vol_sharing_level = entry$sharing_level, + vol_tags = list(entry$tags), + score = entry$score ) - - if (!is.null(resp)) { - httr2::resp_body_string(resp) - } else { - resp - } - #TODO: Reformat search data; handle multiple tags (separate with '+') + }) } diff --git a/R/search_institutions.R b/R/search_institutions.R new file mode 100644 index 00000000..c5b0ecc1 --- /dev/null +++ b/R/search_institutions.R @@ -0,0 +1,60 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Search For Institutions In Databrary. +#' +#' @description Perform a search across institutions registered with +#' Databrary. +#' +#' @param search_string Character string describing the institution search +#' query. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return A tibble containing matching institutions ordered by relevance, or +#' `NULL` when no matches exist for the query. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' search_institutions("state") +#' } +#' } +#' @export +search_institutions <- function(search_string, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(assertthat::is.string(search_string)) + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + results <- collect_paginated_get( + path = API_SEARCH_INSTITUTIONS, + params = list(q = search_string), + rq = rq, + vb = vb + ) + + if (is.null(results) || length(results) == 0) { + if (vb) { + message("No institutions matched the search query '", search_string, "'.") + } + return(NULL) + } + + purrr::map_dfr(results, function(entry) { + tibble::tibble( + institution_id = entry$id, + institution_name = entry$name, + institution_url = if (is.null(entry$url)) NA_character_ else entry$url, + institution_has_avatar = if (is.null(entry$has_avatar)) NA else entry$has_avatar, + score = if (is.null(entry$score)) NA_real_ else entry$score + ) + }) +} + + diff --git a/R/search_users.R b/R/search_users.R new file mode 100644 index 00000000..4b803304 --- /dev/null +++ b/R/search_users.R @@ -0,0 +1,64 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Search For Users In Databrary. +#' +#' @description Perform a directory search across Databrary users by name or +#' email address. +#' +#' @param search_string Character string describing the search query. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return A tibble containing user matches ordered by relevance, or `NULL` +#' when no matches exist for the query. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' search_users("gilmore") +#' } +#' } +#' @export +search_users <- function(search_string, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(assertthat::is.string(search_string)) + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + results <- collect_paginated_get( + path = API_SEARCH_USERS, + params = list(q = search_string), + rq = rq, + vb = vb + ) + + if (is.null(results) || length(results) == 0) { + if (vb) { + message("No users matched the search query '", search_string, "'.") + } + return(NULL) + } + + purrr::map_dfr(results, function(entry) { + tibble::tibble( + user_id = entry$id, + user_first_name = entry$first_name, + user_last_name = entry$last_name, + user_full_name = entry$full_name, + user_email = entry$email, + user_orcid = if (is.null(entry$orcid)) NA_character_ else entry$orcid, + user_url = if (is.null(entry$url)) NA_character_ else entry$url, + user_is_authorized = if (is.null(entry$is_authorized)) NA else entry$is_authorized, + user_has_avatar = if (is.null(entry$has_avatar)) NA else entry$has_avatar, + score = if (is.null(entry$score)) NA_real_ else entry$score + ) + }) +} + + diff --git a/R/search_volumes.R b/R/search_volumes.R new file mode 100644 index 00000000..16bce781 --- /dev/null +++ b/R/search_volumes.R @@ -0,0 +1,82 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Search For Volumes In Databrary. +#' +#' @description Search across Databrary volumes using the Django search +#' endpoint. +#' +#' @param search_string Character string describing the volume search query. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return A tibble containing matching volumes ordered by relevance, or `NULL` +#' when no matches exist for the query. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' search_volumes("workshop") +#' } +#' } +#' @export +search_volumes <- function(search_string, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(assertthat::is.string(search_string)) + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + results <- collect_paginated_get( + path = API_SEARCH_VOLUMES, + params = list(q = search_string), + rq = rq, + vb = vb + ) + + if (is.null(results) || length(results) == 0) { + if (vb) { + message("No volumes matched the search query '", search_string, "'.") + } + return(NULL) + } + + purrr::map_dfr(results, function(entry) { + owner <- entry$owner + + owner_user_id <- NA_integer_ + owner_full_name <- NA_character_ + owner_institution_id <- NA_integer_ + owner_institution_name <- NA_character_ + + if (!is.null(owner)) { + if (!is.null(owner$user_id)) { + owner_user_id <- owner$user_id + } else { + owner_user_id <- NA_integer_ + } + owner_full_name <- if (is.null(owner$full_name)) NA_character_ else owner$full_name + owner_institution_id <- if (is.null(owner$institution_id)) NA_integer_ else owner$institution_id + owner_institution_name <- if (is.null(owner$institution_name)) NA_character_ else owner$institution_name + } + + tibble::tibble( + volume_id = entry$id, + volume_title = entry$title, + volume_description = if (is.null(entry$description)) NA_character_ else entry$description, + volume_sharing_level = entry$sharing_level, + owner_user_id = owner_user_id, + owner_full_name = owner_full_name, + owner_institution_id = owner_institution_id, + owner_institution_name = owner_institution_name, + tags = list(entry$tags), + score = if (is.null(entry$score)) NA_real_ else entry$score + ) + }) +} + + diff --git a/R/token_helpers.R b/R/token_helpers.R index f901f375..6f2162fc 100644 --- a/R/token_helpers.R +++ b/R/token_helpers.R @@ -1,12 +1,5 @@ # Token-aware request helpers ------------------------------------------------- -#' @noRd -add_bearer_token <- function(rq) { - assertthat::assert_that(inherits(rq, "httr2_request")) - access_token <- require_access_token() - httr2::req_headers(rq, Authorization = paste("Bearer", access_token)) -} - #' @noRd ensure_valid_token <- function(refresh = TRUE, client_id = NULL, @@ -57,5 +50,3 @@ ensure_valid_token <- function(refresh = TRUE, get_token_bundle() } - - diff --git a/R/utils.R b/R/utils.R index af9a6cdb..f605de05 100644 --- a/R/utils.R +++ b/R/utils.R @@ -10,6 +10,8 @@ NULL #' Get Duration (In ms) Of A File. #' +#' @param vol_id Volume ID. +#' @param session_id Session ID containing the asset. #' @param asset_id Asset number. #' @param types_w_durations Asset types that have valid durations. #' @param rq An `httr2` request object. Default is NULL. @@ -20,152 +22,76 @@ NULL #' #' @examples #' \donttest{ -#' get_file_duration() # default is the test video from databrary.org/volume/1 +#' get_file_duration() # default is a public video from volume 1 #' } #' #' @export -get_file_duration <- function(asset_id = 1, - types_w_durations = c("-600", "-800"), +get_file_duration <- function(vol_id = 2, + session_id = 9, + asset_id = 2, + types_w_durations = c(-600, -800), vb = options::opt("vb"), rq = NULL) { + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id > 0) + assertthat::assert_that(length(vol_id) == 1) + + assertthat::assert_that(is.numeric(session_id)) + assertthat::assert_that(session_id > 0) + assertthat::assert_that(length(session_id) == 1) + assertthat::assert_that(is.numeric(asset_id)) assertthat::assert_that(asset_id > 0) assertthat::assert_that(length(asset_id) == 1) - assertthat::assert_that(is.character(types_w_durations)) + assertthat::assert_that(is.atomic(types_w_durations)) assertthat::assert_that(is.logical(vb)) assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - - # Handle NULL rq - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - rq <- rq %>% - httr2::req_url(sprintf(GET_ASSET_BY_ID, asset_id)) - - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) - NULL + + types_w_durations <- as.character(types_w_durations) + + asset <- perform_api_get( + path = sprintf(API_SESSION_FILE_DETAIL, vol_id, session_id, asset_id), + rq = rq, + vb = vb ) - if (is.null(resp)) { + + if (is.null(asset)) { message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } else { - asset_df <- httr2::resp_body_json(resp) - if (asset_df$format %in% types_w_durations) { - asset_df$duration - } + return(NULL) } -} - - #---------------------------------------------------------------------------- - #' Get Time Range For An Asset. - #' - #' @param vol_id Volume ID - #' @param session_id Slot/session number. - #' @param asset_id Asset number. - #' @param convert_JSON A Boolean value. If TRUE, convert JSON to a data - #' frame. Default is TRUE. - #' @param segment_only A Boolean value. If TRUE, returns only the segment - #' values. Otherwise returns - #' a data frame with two fields, segment and permission. Default is TRUE. - #' @param rq An `httr2` request object. Default is NULL. - #' - #' @returns The time range (in ms) for an asset, if one is indicated. - #' - #' @inheritParams options_params - #' - #' @examples - #' \donttest{ - #' get_asset_segment_range() - #' } - #' - #' @export - get_asset_segment_range <- function(vol_id = 1, - session_id = 9807, - asset_id = 1, - convert_JSON = TRUE, - segment_only = TRUE, - vb = options::opt("vb"), - rq = NULL) { - assertthat::assert_that(is.numeric(vol_id)) - assertthat::assert_that(vol_id > 0) - assertthat::assert_that(length(vol_id) == 1) - - assertthat::assert_that(is.numeric(session_id)) - assertthat::assert_that(session_id > 0) - assertthat::assert_that(length(session_id) == 1) - - assertthat::assert_that(is.numeric(asset_id)) - assertthat::assert_that(asset_id > 0) - assertthat::assert_that(length(asset_id) == 1) - - assertthat::assert_that(is.logical(convert_JSON)) - assertthat::assert_that(length(convert_JSON) == 1) - - assertthat::assert_that(is.logical(convert_JSON)) - assertthat::assert_that(length(convert_JSON) == 1) - - assertthat::assert_that(is.logical(segment_only)) - assertthat::assert_that(length(segment_only) == 1) - - assertthat::assert_that(is.logical(vb)) - assertthat::assert_that(length(vb) == 1) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - # Handle NULL rq - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() + + format <- asset$format + format_id_chr <- as.character(format$id) + + if (!is.na(format_id_chr) && !(format_id_chr %in% types_w_durations)) { + if (vb) { + message("Asset format does not include duration metadata.") } - rq <- rq %>% - httr2::req_url(sprintf( - GET_ASSET_BY_VOLUME_SESSION_ID, - vol_id, - session_id, - asset_id - )) - - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) - NULL - ) - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } else { - asset_info <- httr2::resp_body_json(resp) - if (vb) { - message( - "Returning segment start & end times (in ms) from volume ", - vol_id, - ", session ", - session_id, - ", asset ", - asset_id - ) - } - if (segment_only) { - asset_info$segment %>% unlist() - } else { - asset_info - } + return(NULL) + } + + duration_value <- asset$duration + + if (is.null(duration_value)) { + if (vb) { + message("Duration metadata not available for the requested asset.") } + return(NULL) } + + duration_value <- suppressWarnings(as.numeric(duration_value)) + + if (is.na(duration_value)) { + return(NULL) + } + + round(duration_value * 1000) +} #---------------------------------------------------------------------------- #' Extract Databrary Permission Levels. @@ -180,10 +106,10 @@ get_file_duration <- function(asset_id = 1, #' } #' #' @export - get_permission_levels <- function(vb = options::opt("vb")) { - c <- assign_constants(vb = vb) - c$permission %>% unlist() - } +get_permission_levels <- function(vb = options::opt("vb")) { + enums <- get_permission_levels_enums() + enums$volume_access_levels +} #---------------------------------------------------------------------------- #' Convert Timestamp String To ms. @@ -227,8 +153,8 @@ get_file_duration <- function(asset_id = 1, #' #' @export get_release_levels <- function(vb = options::opt("vb")) { - c <- assign_constants(vb = vb) - c$release %>% unlist() + enums <- get_release_levels_enums() + vapply(enums$levels, function(item) item$code, character(1)) } #---------------------------------------------------------------------------- @@ -246,87 +172,13 @@ get_file_duration <- function(asset_id = 1, #' #' @export get_supported_file_types <- function(vb = options::opt("vb")) { - c <- assign_constants(vb = vb) - ft <- Reduce(function(x, y) - merge(x, y, all = TRUE), c$format) - ft <- dplyr::rename(ft, asset_type = "name", asset_type_id = "id") - ft - } - - #---------------------------------------------------------------------------- - #' Is This Party An Institution? - #' - #' @param party_id Databrary party ID - #' @param rq An `httr2` request object. - #' - #' @returns TRUE if the party is an institution, FALSE otherwise. - #' - #' @inheritParams options_params - #' - #' @examples - #' \donttest{ - #' is_institution() # Is party 8 (NYU) an institution. - #' } - #' - #' @export - is_institution <- function(party_id = 8, - vb = options::opt("vb"), - rq = NULL) { - assertthat::assert_that(is.numeric(party_id)) - assertthat::assert_that(party_id > 0) - assertthat::assert_that(length(party_id) == 1) - - assertthat::assert_that(is.logical(vb)) - assertthat::assert_that(length(vb) == 1) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - # Handle NULL rq - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - - party_info <- databraryr::get_party_by_id(party_id = party_id, - vb = vb, - rq = rq) - - if (("institution" %in% names(party_info)) && - (!is.null(party_info[['institution']]))) { - TRUE - } else { - FALSE - } - } - - #---------------------------------------------------------------------------- - #' Is This Party A Person? - #' - #' @param party_id Databrary party ID - #' @param rq An `httr2` request object. - #' - #' @returns TRUE if the party is a person, FALSE otherwise. - #' - #' @inheritParams options_params - #' - #' @examples - #' \donttest{ - #' is_person() - #' } - #' - #' @export - is_person <- function(party_id = 7, - vb = options::opt("vb"), - rq = NULL) { - return(!is_institution( - party_id = party_id, - vb = vb, - rq = rq - )) + constants <- assign_constants(vb = vb) + constants$format_df |> + dplyr::rename( + asset_type = name, + asset_type_id = id, + asset_category = category + ) } #---------------------------------------------------------------------------- diff --git a/R/whoami.R b/R/whoami.R index 5c39c3c6..16954138 100644 --- a/R/whoami.R +++ b/R/whoami.R @@ -34,10 +34,16 @@ whoami <- function(refresh = TRUE, vb = options::opt("vb")) { } resp <- tryCatch( - httr2::req_url(req, OAUTH_TEST_URL) |> + req |> + httr2::req_url(OAUTH_TEST_URL) |> + httr2::req_headers(`Content-Type` = "application/json") |> httr2::req_perform(), error = function(err) { - if (vb) message("whoami request failed: ", conditionMessage(err)) + if (vb) { + message("whoami request failed: ", conditionMessage(err)) + message("whoami -> request url: ", OAUTH_TEST_URL) + message("whoami -> authorization header: ", if (!is.null(req$headers$Authorization)) req$headers$Authorization else "") + } NULL } ) diff --git a/README.Rmd b/README.Rmd index 204dd364..e7ccae6b 100644 --- a/README.Rmd +++ b/README.Rmd @@ -65,6 +65,29 @@ library(databraryr) login_db() whoami() + +get_db_stats() +#> # A tibble: 1 × 1 +#> date +#> +#> 1 2025-10-31 12:05:57 + +list_volume_assets() |> + head() +#> # A tibble: 6 × 17 +#> asset_id asset_name asset_permission asset_size +#> +#> 1 9826 Introduction public 88610655 +#> 2 9828 Databrary demo public 917124852 +#> 3 9830 Databrary 1 public 899912341 +#> 4 9832 Datavyu public 764340542 +#> 5 22412 Slides public 4573426 +#> 6 9834 Overview and Policy Upda… public 1301079971 +#> # ℹ 12 more variables: asset_mime_type , asset_format_id , +#> # asset_format_name , asset_created_at , asset_updated_at , +#> # asset_sha1 , session_id , session_name , +#> # session_date , session_release , asset_uploader_id , +#> # asset_uploader_first_name , asset_uploader_last_name ``` ## Lifecycle diff --git a/README.md b/README.md index c279fb50..6cdbce9a 100644 --- a/README.md +++ b/README.md @@ -53,36 +53,27 @@ library(databraryr) #> Welcome to the databraryr package. get_db_stats() -#> # A tibble: 1 × 9 -#> date investigators affiliates institutions datasets_total -#> -#> 1 2024-03-29 14:38:54 1740 680 784 1670 -#> # ℹ 4 more variables: datasets_shared , n_files , hours , -#> # TB +#> # A tibble: 1 × 1 +#> date +#> +#> 1 2025-10-31 12:05:57 list_volume_assets() |> head() -#> asset_id asset_format_id asset_duration asset_name -#> 1 9826 -800 335883 Introduction -#> 2 9830 -800 4277835 Databrary 1.0 plan -#> 3 9832 -800 3107147 Datavyu -#> 4 22412 6 NA Slides -#> 5 9828 -800 4425483 Databrary demo -#> 6 9834 -800 4964011 Overview and Policy Update -#> asset_permission asset_size session_id session_date session_release -#> 1 1 88610655 6256 2013-10-28 3 -#> 2 1 899912341 6256 2013-10-28 3 -#> 3 1 764340542 6256 2013-10-28 3 -#> 4 1 4573426 6256 2013-10-28 3 -#> 5 1 917124852 6256 2013-10-28 3 -#> 6 1 1301079971 6257 2014-04-07 3 -#> format_mimetype format_extension format_name -#> 1 video/mp4 mp4 MPEG-4 video -#> 2 video/mp4 mp4 MPEG-4 video -#> 3 video/mp4 mp4 MPEG-4 video -#> 4 application/pdf pdf Portable document -#> 5 video/mp4 mp4 MPEG-4 video -#> 6 video/mp4 mp4 MPEG-4 video +#> # A tibble: 6 × 17 +#> asset_id asset_name asset_permission asset_size +#> +#> 1 9826 Introduction public 88610655 +#> 2 9828 Databrary demo public 917124852 +#> 3 9830 Databrary 1 public 899912341 +#> 4 9832 Datavyu public 764340542 +#> 5 22412 Slides public 4573426 +#> 6 9834 Overview and Policy Upda… public 1301079971 +#> # ℹ 12 more variables: asset_mime_type , asset_format_id , +#> # asset_format_name , asset_created_at , asset_updated_at , +#> # asset_sha1 , session_id , session_name , +#> # session_date , session_release , asset_uploader_id , +#> # asset_uploader_first_name , asset_uploader_last_name ``` ## Lifecycle diff --git a/man/API_CONSTANTS.Rd b/man/DATABRARY_BASE_URL.Rd similarity index 81% rename from man/API_CONSTANTS.Rd rename to man/DATABRARY_BASE_URL.Rd index 18977a4d..b7d0c5e9 100644 --- a/man/API_CONSTANTS.Rd +++ b/man/DATABRARY_BASE_URL.Rd @@ -1,14 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/CONSTANTS.R \docType{data} -\name{API_CONSTANTS} -\alias{API_CONSTANTS} +\name{DATABRARY_BASE_URL} +\alias{DATABRARY_BASE_URL} \title{Load Package-wide Constants into Local Environment} \format{ An object of class \code{character} of length 1. } \usage{ -API_CONSTANTS +DATABRARY_BASE_URL } \description{ Load Package-wide Constants into Local Environment diff --git a/man/download_party_avatar.Rd b/man/download_party_avatar.Rd deleted file mode 100644 index cc14ca27..00000000 --- a/man/download_party_avatar.Rd +++ /dev/null @@ -1,44 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/download_party_avatar.R -\name{download_party_avatar} -\alias{download_party_avatar} -\title{Returns the Avatar(s) (images) for Authorized User(s).} -\usage{ -download_party_avatar( - party_id = 6, - show_party_info = TRUE, - vb = options::opt("vb"), - rq = NULL -) -} -\arguments{ -\item{party_id}{A number or range of numbers. Party number or numbers to retrieve information about. Default is 6 -(Rick Gilmore).} - -\item{show_party_info}{A logical value. Show the person's name and affiliation in the output. -Default is TRUE.} - -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - -\item{rq}{An \code{httr2} request object. If not provided, a new request is -generated via \code{make_default_request()}.} -} -\value{ -An list with the avatar (image) file and a name_affil string. -} -\description{ -Returns the Avatar(s) (images) for Authorized User(s). -} -\examples{ -\donttest{ -\dontrun{ -download_party_avatar() # Show Rick Gilmore's (party 6) avatar. - -# Download avatars from Databrary's founders (without name/affiliations) -download_party_avatar(5:7, show_party_info = FALSE) - -# Download NYU logo -download_party_avatar(party = 8) -} -} -} diff --git a/man/get_asset_segment_range.Rd b/man/get_asset_segment_range.Rd deleted file mode 100644 index 8168509f..00000000 --- a/man/get_asset_segment_range.Rd +++ /dev/null @@ -1,46 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{get_asset_segment_range} -\alias{get_asset_segment_range} -\title{Get Time Range For An Asset.} -\usage{ -get_asset_segment_range( - vol_id = 1, - session_id = 9807, - asset_id = 1, - convert_JSON = TRUE, - segment_only = TRUE, - vb = options::opt("vb"), - rq = NULL -) -} -\arguments{ -\item{vol_id}{Volume ID} - -\item{session_id}{Slot/session number.} - -\item{asset_id}{Asset number.} - -\item{convert_JSON}{A Boolean value. If TRUE, convert JSON to a data -frame. Default is TRUE.} - -\item{segment_only}{A Boolean value. If TRUE, returns only the segment -values. Otherwise returns -a data frame with two fields, segment and permission. Default is TRUE.} - -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - -\item{rq}{An \code{httr2} request object. Default is NULL.} -} -\value{ -The time range (in ms) for an asset, if one is indicated. -} -\description{ -Get Time Range For An Asset. -} -\examples{ -\donttest{ -get_asset_segment_range() -} - -} diff --git a/man/get_assets_from_session.Rd b/man/get_assets_from_session.Rd deleted file mode 100644 index 6fa55fd0..00000000 --- a/man/get_assets_from_session.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/list_volume_assets.R -\name{get_assets_from_session} -\alias{get_assets_from_session} -\title{Helper function for list_volume_assets} -\usage{ -get_assets_from_session(volume_container, ignore_materials = TRUE) -} -\arguments{ -\item{volume_container}{The 'container' list from a volume.} - -\item{ignore_materials}{A logical value.} -} -\description{ -Helper function for list_volume_assets -} diff --git a/man/get_file_duration.Rd b/man/get_file_duration.Rd index ed6e2c60..2f85028d 100644 --- a/man/get_file_duration.Rd +++ b/man/get_file_duration.Rd @@ -5,13 +5,19 @@ \title{Get Duration (In ms) Of A File.} \usage{ get_file_duration( - asset_id = 1, - types_w_durations = c("-600", "-800"), + vol_id = 2, + session_id = 9, + asset_id = 2, + types_w_durations = c(-600, -800), vb = options::opt("vb"), rq = NULL ) } \arguments{ +\item{vol_id}{Volume ID.} + +\item{session_id}{Session ID containing the asset.} + \item{asset_id}{Asset number.} \item{types_w_durations}{Asset types that have valid durations.} @@ -28,7 +34,7 @@ Get Duration (In ms) Of A File. } \examples{ \donttest{ -get_file_duration() # default is the test video from databrary.org/volume/1 +get_file_duration() # default is a public video from volume 1 } } diff --git a/man/get_folder_by_id.Rd b/man/get_folder_by_id.Rd new file mode 100644 index 00000000..938b3e5c --- /dev/null +++ b/man/get_folder_by_id.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_folder_by_id.R +\name{get_folder_by_id} +\alias{get_folder_by_id} +\title{Get Folder Metadata From a Databrary Volume.} +\usage{ +get_folder_by_id(folder_id = 1, vol_id = 1, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{folder_id}{Folder identifier within the specified volume.} + +\item{vol_id}{Volume identifier containing the folder.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list representing the folder metadata, or \code{NULL} when the folder +cannot be accessed. +} +\description{ +Get Folder Metadata From a Databrary Volume. +} +\examples{ +\donttest{ +\dontrun{ +get_folder_by_id() # Default folder in volume 1 +} +} +} diff --git a/man/get_info_from_session.Rd b/man/get_info_from_session.Rd deleted file mode 100644 index c4d21bb4..00000000 --- a/man/get_info_from_session.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/list_volume_sessions.R -\name{get_info_from_session} -\alias{get_info_from_session} -\title{List Sessions Info in Databrary Volume Container} -\usage{ -get_info_from_session( - volume_container, - ignore_materials = FALSE, - release_levels -) -} -\arguments{ -\item{volume_container}{A component of a volume list returned by -get_volume_by_id().} - -\item{ignore_materials}{A logical value specifying whether to ignore -"materials" folders. -Default is TRUE} - -\item{release_levels}{A data frame mapping release level indices to release -level text values.} -} -\description{ -List Sessions Info in Databrary Volume Container -} diff --git a/man/get_institution_by_id.Rd b/man/get_institution_by_id.Rd new file mode 100644 index 00000000..8da21c89 --- /dev/null +++ b/man/get_institution_by_id.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_institution_by_id.R +\name{get_institution_by_id} +\alias{get_institution_by_id} +\title{Get institution metadata} +\usage{ +get_institution_by_id(institution_id = 12, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{institution_id}{Institution identifier.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +} +\value{ +List of institution metadata or NULL when inaccessible. +} +\description{ +Get institution metadata +} diff --git a/man/get_party_by_id.Rd b/man/get_party_by_id.Rd deleted file mode 100644 index 844e01c6..00000000 --- a/man/get_party_by_id.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_party_by_id.R -\name{get_party_by_id} -\alias{get_party_by_id} -\title{Download Information About a Party on Databrary as JSON} -\usage{ -get_party_by_id( - party_id = 6, - parents_children_access = TRUE, - vb = options::opt("vb"), - rq = NULL -) -} -\arguments{ -\item{party_id}{An integer. The party number to retrieve information about.} - -\item{parents_children_access}{A logical value. If TRUE (the default), -returns \emph{all} of the data about the party. If FALSE, only a minimum amount -of information about the party is returned.} - -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - -\item{rq}{An \code{httr2}-style request object. If NULL, then a new request will -be generated using \code{make_default_request()}.} -} -\value{ -A nested list with information about the party. -This can be readily parsed by other functions. -} -\description{ -Download Information About a Party on Databrary as JSON -} -\examples{ -\donttest{ -\dontrun{ -get_party_by_id() -} -} -} diff --git a/man/get_user_by_id.Rd b/man/get_user_by_id.Rd new file mode 100644 index 00000000..d4cc223b --- /dev/null +++ b/man/get_user_by_id.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_user_by_id.R +\name{get_user_by_id} +\alias{get_user_by_id} +\title{Get public profile information for a Databrary user} +\usage{ +get_user_by_id(user_id = 6, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{user_id}{User identifier.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +} +\value{ +A list with the user's public metadata. +} +\description{ +Get public profile information for a Databrary user +} diff --git a/man/is_institution.Rd b/man/is_institution.Rd deleted file mode 100644 index f0596d17..00000000 --- a/man/is_institution.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{is_institution} -\alias{is_institution} -\title{Is This Party An Institution?} -\usage{ -is_institution(party_id = 8, vb = options::opt("vb"), rq = NULL) -} -\arguments{ -\item{party_id}{Databrary party ID} - -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - -\item{rq}{An \code{httr2} request object.} -} -\value{ -TRUE if the party is an institution, FALSE otherwise. -} -\description{ -Is This Party An Institution? -} -\examples{ -\donttest{ -is_institution() # Is party 8 (NYU) an institution. -} - -} diff --git a/man/is_person.Rd b/man/is_person.Rd deleted file mode 100644 index 1295f3c1..00000000 --- a/man/is_person.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{is_person} -\alias{is_person} -\title{Is This Party A Person?} -\usage{ -is_person(party_id = 7, vb = options::opt("vb"), rq = NULL) -} -\arguments{ -\item{party_id}{Databrary party ID} - -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - -\item{rq}{An \code{httr2} request object.} -} -\value{ -TRUE if the party is a person, FALSE otherwise. -} -\description{ -Is This Party A Person? -} -\examples{ -\donttest{ -is_person() -} - -} diff --git a/man/list_authorized_investigators.Rd b/man/list_authorized_investigators.Rd index 6a70cbb3..3c59939c 100644 --- a/man/list_authorized_investigators.Rd +++ b/man/list_authorized_investigators.Rd @@ -2,33 +2,22 @@ % Please edit documentation in R/list_authorized_investigators.R \name{list_authorized_investigators} \alias{list_authorized_investigators} -\title{List Authorized Investigators at Institution} +\title{List authorized investigators for an institution} \usage{ list_authorized_investigators( - party_id = 12, + institution_id = 12, vb = options::opt("vb"), rq = NULL ) } \arguments{ -\item{party_id}{Target party ID.} +\item{institution_id}{Institution identifier.} \item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - -\item{rq}{An \code{httr2}-style request object. If NULL, then a new request will -be generated using \code{make_default_request()}.} } \value{ -A data frame with information the institution's authorized -investigators. +Tibble of investigators; NULL if none. } \description{ -List Authorized Investigators at Institution -} -\examples{ -\donttest{ -\dontrun{ -list_institutional_affiliates() # Default is Penn State (party 12) -} -} +List authorized investigators for an institution } diff --git a/man/list_folder_assets.Rd b/man/list_folder_assets.Rd new file mode 100644 index 00000000..7e2745a1 --- /dev/null +++ b/man/list_folder_assets.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_folder_assets.R +\name{list_folder_assets} +\alias{list_folder_assets} +\title{List Assets Within a Databrary Folder.} +\usage{ +list_folder_assets( + folder_id = 1, + vol_id = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{folder_id}{Folder identifier scoped to the given volume.} + +\item{vol_id}{Volume containing the folder. Required for Django API calls.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A tibble with metadata for files contained in the folder, or +\code{NULL} when the folder has no accessible assets. +} +\description{ +List Assets Within a Databrary Folder. +} +\examples{ +\donttest{ +\dontrun{ +list_folder_assets(folder_id = 1, vol_id = 1) +} +} +} diff --git a/man/list_institution_affiliates.Rd b/man/list_institution_affiliates.Rd new file mode 100644 index 00000000..26f26bf7 --- /dev/null +++ b/man/list_institution_affiliates.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_institution_affiliates.R +\name{list_institution_affiliates} +\alias{list_institution_affiliates} +\title{List affiliates for an institution} +\usage{ +list_institution_affiliates( + institution_id = 12, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{institution_id}{Institution identifier.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +} +\value{ +Tibble of affiliates with roles and expiration dates. +} +\description{ +List affiliates for an institution +} diff --git a/man/list_party_affiliates.Rd b/man/list_party_affiliates.Rd deleted file mode 100644 index 40d9667b..00000000 --- a/man/list_party_affiliates.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/list_party_affiliates.R -\name{list_party_affiliates} -\alias{list_party_affiliates} -\title{List Affiliates For A Party} -\usage{ -list_party_affiliates(party_id = 6, vb = options::opt("vb"), rq = NULL) -} -\arguments{ -\item{party_id}{Target party ID.} - -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - -\item{rq}{An \code{httr2} request object. Defaults to NULL.} -} -\value{ -A data frame with information about a party's affiliates. -} -\description{ -List Affiliates For A Party -} -\examples{ -\donttest{ -list_party_affiliates() # Default is Rick Gilmore (party 6) -} -} diff --git a/man/list_party_sponsors.Rd b/man/list_party_sponsors.Rd deleted file mode 100644 index 92a664ef..00000000 --- a/man/list_party_sponsors.Rd +++ /dev/null @@ -1,30 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/list_party_sponsors.R -\name{list_party_sponsors} -\alias{list_party_sponsors} -\title{List Sponsors For A Party} -\usage{ -list_party_sponsors(party_id = 6, vb = options::opt("vb"), rq = NULL) -} -\arguments{ -\item{party_id}{Target party ID.} - -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - -\item{rq}{An \code{httr2}-style request object. If NULL, then a new request will -be generated using \code{make_default_request()}.} -} -\value{ -A data frame with information about a party's sponsors. -} -\description{ -List Sponsors For A Party -} -\examples{ -\donttest{ -\dontrun{ -list_party_sponsors() # Default is Rick Gilmore (party 6) -} -} - -} diff --git a/man/list_party_volumes.Rd b/man/list_party_volumes.Rd deleted file mode 100644 index 27d49e08..00000000 --- a/man/list_party_volumes.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/list_party_volumes.R -\name{list_party_volumes} -\alias{list_party_volumes} -\title{List Volumes A Party Has Access To} -\usage{ -list_party_volumes(party_id = 6, vb = options::opt("vb"), rq = NULL) -} -\arguments{ -\item{party_id}{Target party ID.} - -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - -\item{rq}{An \code{httr2}-style request object. If NULL, then a new request will -be generated using \code{make_default_request()}.} -} -\value{ -A data frame with information about a party's sponsors. -} -\description{ -List Volumes A Party Has Access To -} -\examples{ -\donttest{ -\dontrun{ -list_party_volumes() # Default is Rick Gilmore (party 6) -} -} -} diff --git a/man/list_session_activity.Rd b/man/list_session_activity.Rd index a6c4a7aa..4454b8e5 100644 --- a/man/list_session_activity.Rd +++ b/man/list_session_activity.Rd @@ -4,32 +4,36 @@ \alias{list_session_activity} \title{List Activity History in Databrary Session.} \usage{ -list_session_activity(session_id = 6256, vb = options::opt("vb"), rq = NULL) +list_session_activity( + vol_id = 1892, + session_id = 76113, + vb = options::opt("vb"), + rq = NULL +) } \arguments{ -\item{session_id}{Selected session/slot number.} +\item{vol_id}{Volume identifier (required by the Django API).} + +\item{session_id}{Session identifier.} \item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} -\item{rq}{An \code{httr2} request object. Defaults to NULL. To access the activity -history on a volume a user has privileges on. Create a request -(\code{rq <- make_default_request()}); login using \code{make_login_client(rq = rq)}; -then run \verb{list_session_activity(session_id = , rq = rq)}} +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}. When \code{NULL}, a +default request is generated, but this will only permit public information +to be returned.} } \value{ -A list with the activity history on a session/slot. +A tibble with the activity history for a session, or \code{NULL} when +no data is available. } \description{ -If a user has access to a volume and session, this function returns the -history of modifications to that session. +For an accessible session, returns the logged history events associated with +the session. Requires authenticated access with sufficient permissions. } \examples{ -\donttest{ -\dontrun{ -# The following will only return output if the user has write privileges -# on the session. - -list_session_activity(session_id = 6256, vb = FALSE) +\\donttest{ +\\dontrun{ +list_session_activity(vol_id = 1892, session_id = 76113) } } } diff --git a/man/list_session_assets.Rd b/man/list_session_assets.Rd index 8c66f670..37b49302 100644 --- a/man/list_session_assets.Rd +++ b/man/list_session_assets.Rd @@ -4,12 +4,21 @@ \alias{list_session_assets} \title{List Assets in a Databrary Session.} \usage{ -list_session_assets(session_id = 9807, vb = options::opt("vb"), rq = NULL) +list_session_assets( + session_id = 9807, + vol_id = NULL, + vb = options::opt("vb"), + rq = NULL +) } \arguments{ \item{session_id}{An integer. A Databrary session number. Default is 9807, the "materials" folder from Databrary volume 1.} +\item{vol_id}{Optional integer. The volume containing the session. Recent +versions of the Databrary API require this value to be supplied because +session identifiers are scoped to volumes.} + \item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} \item{rq}{An \code{httr2} request object. If NULL, a default request is generated diff --git a/man/list_sponsors.Rd b/man/list_sponsors.Rd deleted file mode 100644 index 4ad73ece..00000000 --- a/man/list_sponsors.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/list_sponsors.R -\name{list_sponsors} -\alias{list_sponsors} -\title{List Sponsors For A Party} -\usage{ -list_sponsors(party_id = 6, vb = options::opt("vb"), rq = NULL) -} -\arguments{ -\item{party_id}{Target party ID.} - -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - -\item{rq}{An \code{httr2}-style request object. If NULL, then a new request will -be generated using \code{make_default_request()}.} -} -\value{ -A data frame with information about a party's sponsors. -} -\description{ -List Sponsors For A Party -} -\examples{ -\donttest{ -\dontrun{ -list_sponsors() # Default is Rick Gilmore (party 6) -} -} -} diff --git a/man/list_user_affiliates.Rd b/man/list_user_affiliates.Rd new file mode 100644 index 00000000..607ecdc9 --- /dev/null +++ b/man/list_user_affiliates.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_user_affiliates.R +\name{list_user_affiliates} +\alias{list_user_affiliates} +\title{List affiliates for a user} +\usage{ +list_user_affiliates(user_id = 6, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{user_id}{User identifier.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +} +\value{ +Tibble of affiliates for the user. +} +\description{ +List affiliates for a user +} diff --git a/man/list_user_history.Rd b/man/list_user_history.Rd new file mode 100644 index 00000000..9433a469 --- /dev/null +++ b/man/list_user_history.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_user_history.R +\name{list_user_history} +\alias{list_user_history} +\title{List Account Activity For A Databrary User.} +\usage{ +list_user_history(user_id = 22582, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{user_id}{Target user identifier.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A tibble containing authentication and activity events for the +selected user, or \code{NULL} when no entries are available. +} +\description{ +Retrieve the OAuth and login activity history for a specific +user. Access is restricted to administrators and authorized investigators +with sufficient privileges. +} +\examples{ +\donttest{ +\dontrun{ +list_user_history(user_id = 22582) +} +} +} diff --git a/man/list_user_sponsors.Rd b/man/list_user_sponsors.Rd new file mode 100644 index 00000000..8dd7fbe5 --- /dev/null +++ b/man/list_user_sponsors.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_user_sponsors.R +\name{list_user_sponsors} +\alias{list_user_sponsors} +\title{List sponsorships for a user} +\usage{ +list_user_sponsors(user_id = 6, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{user_id}{User identifier.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +} +\value{ +Tibble of sponsors for the user. +} +\description{ +List sponsorships for a user +} diff --git a/man/list_user_volumes.Rd b/man/list_user_volumes.Rd new file mode 100644 index 00000000..c6b691cd --- /dev/null +++ b/man/list_user_volumes.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_user_volumes.R +\name{list_user_volumes} +\alias{list_user_volumes} +\title{List volumes associated with a user} +\usage{ +list_user_volumes(user_id = 6, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{user_id}{User identifier.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +} +\value{ +Tibble of volumes the user owns or collaborates on. +} +\description{ +List volumes associated with a user +} diff --git a/man/list_users.Rd b/man/list_users.Rd new file mode 100644 index 00000000..1ea008a2 --- /dev/null +++ b/man/list_users.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_users.R +\name{list_users} +\alias{list_users} +\title{List Databrary Users.} +\usage{ +list_users( + search = NULL, + include_suspended = NULL, + exclude_self = NULL, + is_authorized_investigator = NULL, + has_api_access = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{search}{Optional character string used to filter results by name or +email address.} + +\item{include_suspended}{Optional logical value. When \code{TRUE}, suspended +accounts are included in the response.} + +\item{exclude_self}{Optional logical value. When \code{TRUE}, the authenticated +user is omitted from the results.} + +\item{is_authorized_investigator}{Optional logical value restricting the +response to authorized investigators.} + +\item{has_api_access}{Optional logical value restricting the response to +accounts with API access enabled.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A tibble containing directory metadata for each user, or \code{NULL} when +no results are available for the supplied filters. +} +\description{ +Retrieve directory metadata for Databrary users. Results can be +filtered by name or restricted to specific account types using optional +parameters. +} +\examples{ +\donttest{ +\dontrun{ +list_users(search = "gilmore") +} +} +} diff --git a/man/list_volume_activity.Rd b/man/list_volume_activity.Rd index 8616ed16..63e8501e 100644 --- a/man/list_volume_activity.Rd +++ b/man/list_volume_activity.Rd @@ -4,7 +4,7 @@ \alias{list_volume_activity} \title{List Activity In A Databrary Volume} \usage{ -list_volume_activity(vol_id = 1, vb = options::opt("vb"), rq = NULL) +list_volume_activity(vol_id = 1892, vb = options::opt("vb"), rq = NULL) } \arguments{ \item{vol_id}{Selected volume number.} @@ -26,7 +26,7 @@ history of the volume as a # The following will only return output if the user has write privileges # on the volume. -list_volume_activity(vol_id = 1) # Activity on volume 1. +list_volume_activity(vol_id = 1892) # Activity on volume 1892. } } } diff --git a/man/list_volume_collaborators.Rd b/man/list_volume_collaborators.Rd new file mode 100644 index 00000000..eeb46775 --- /dev/null +++ b/man/list_volume_collaborators.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_volume_collaborators.R +\name{list_volume_collaborators} +\alias{list_volume_collaborators} +\title{List Collaborators On A Databrary Volume.} +\usage{ +list_volume_collaborators(vol_id = 1, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{vol_id}{Target volume number.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A tibble summarizing collaborator relationships on the volume, or +\code{NULL} when no collaborators are associated with the volume. +} +\description{ +Retrieve collaboration metadata for a specified volume, +including sponsor details and access levels. +} +\examples{ +\donttest{ +\dontrun{ +list_volume_collaborators(vol_id = 1) +} +} +} diff --git a/man/list_volume_excerpts.Rd b/man/list_volume_excerpts.Rd deleted file mode 100644 index 4ca828e0..00000000 --- a/man/list_volume_excerpts.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/list_volume_excerpts.R -\name{list_volume_excerpts} -\alias{list_volume_excerpts} -\title{List Image or Video Excerpts On A Databrary Volume.} -\usage{ -list_volume_excerpts(vol_id = 1, vb = options::opt("vb"), rq = NULL) -} -\arguments{ -\item{vol_id}{Target volume number.} - -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - -\item{rq}{An \code{httr2} request object. Default is NULL.} -} -\value{ -A list with information about any available excerpts. -} -\description{ -List Image or Video Excerpts On A Databrary Volume. -} -\examples{ -\donttest{ -list_volume_excerpts() -} - -} diff --git a/man/list_volume_folders.Rd b/man/list_volume_folders.Rd new file mode 100644 index 00000000..a85b82b3 --- /dev/null +++ b/man/list_volume_folders.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_volume_folders.R +\name{list_volume_folders} +\alias{list_volume_folders} +\title{List Folders in a Databrary Volume.} +\usage{ +list_volume_folders(vol_id = 1, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{vol_id}{Target volume number.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A tibble with metadata about folders in the selected volume, or +\code{NULL} when no folders are available. +} +\description{ +List Folders in a Databrary Volume. +} +\examples{ +\donttest{ +\dontrun{ +list_volume_folders() # Folders in volume 1 +} +} +} diff --git a/man/list_volume_owners.Rd b/man/list_volume_owners.Rd deleted file mode 100644 index c9029760..00000000 --- a/man/list_volume_owners.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/list_volume_owners.R -\name{list_volume_owners} -\alias{list_volume_owners} -\title{List Owners of a Databrary Volume.} -\usage{ -list_volume_owners(vol_id = 1, vb = options::opt("vb"), rq = NULL) -} -\arguments{ -\item{vol_id}{Selected volume number. Default is volume 1.} - -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - -\item{rq}{An \code{httr2} request object. If NULL (the default) -a request will be generated, but this will only permit public information -to be returned.} -} -\value{ -A data frame with information about a volume's owner(s). -} -\description{ -List Owners of a Databrary Volume. -} -\examples{ -\donttest{ -list_volume_owners() # Lists information about the owners of volume 1. -} -} diff --git a/man/list_volume_session_assets.Rd b/man/list_volume_session_assets.Rd index 5d6c5944..524a65ea 100644 --- a/man/list_volume_session_assets.Rd +++ b/man/list_volume_session_assets.Rd @@ -5,8 +5,8 @@ \title{List Assets in a Session from a Databrary volume.} \usage{ list_volume_session_assets( - vol_id = 1, - session_id = 9807, + vol_id = 2, + session_id = 11, vb = options::opt("vb"), rq = NULL ) @@ -36,7 +36,7 @@ ID. \examples{ \donttest{ \dontrun{ -list_volume_session_assets() # Session 9807 in volume 1 +list_volume_session_assets() # Defaults to session 11 in volume 2 } } } diff --git a/man/list_volumes.Rd b/man/list_volumes.Rd new file mode 100644 index 00000000..6b3dddc2 --- /dev/null +++ b/man/list_volumes.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_volumes.R +\name{list_volumes} +\alias{list_volumes} +\title{List Volumes Accessible Through The Databrary API.} +\usage{ +list_volumes( + search = NULL, + ordering = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{search}{Optional character string used to filter volumes by title or +description.} + +\item{ordering}{Optional character string indicating the sort field accepted +by the API (e.g., \code{"title"}, \code{"-title"}).} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A tibble summarizing each accessible volume, or \code{NULL} when no +volumes match the supplied filters. +} +\description{ +Returns summary metadata for volumes accessible to the +authenticated user. Results can be filtered by search term or ordering. +} +\examples{ +\donttest{ +\dontrun{ +list_volumes(search = "workshop") +} +} +} diff --git a/man/make_login_client.Rd b/man/make_login_client.Rd index 5c2a26ea..f3a3262e 100644 --- a/man/make_login_client.Rd +++ b/man/make_login_client.Rd @@ -36,7 +36,7 @@ Logical value indicating whether log in is successful or not. Log In To Databrary.org. } \examples{ -\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (interactive()) withAutoprint(\{ # examplesIf} make_login_client() # Queries user for email and password interactively. \dontshow{\}) # examplesIf} \donttest{ diff --git a/man/search_for_funder.Rd b/man/search_for_funder.Rd index c24edb55..c6589194 100644 --- a/man/search_for_funder.Rd +++ b/man/search_for_funder.Rd @@ -5,7 +5,8 @@ \title{Report Information About A Funder.} \usage{ search_for_funder( - search_string = "national+science+foundation", + search_string = "national science foundation", + approved_only = TRUE, vb = options::opt("vb"), rq = NULL ) @@ -13,6 +14,9 @@ search_for_funder( \arguments{ \item{search_string}{String to search.} +\item{approved_only}{Logical. When TRUE (default) only approved funders are +returned. Set to FALSE to include unapproved funders as well.} + \item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} \item{rq}{An \code{httr2} request object. Default is NULL.} diff --git a/man/search_for_keywords.Rd b/man/search_for_keywords.Rd deleted file mode 100644 index d480ed82..00000000 --- a/man/search_for_keywords.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/search_for_keywords.R -\name{search_for_keywords} -\alias{search_for_keywords} -\title{Search For Keywords in Databrary Volumes.} -\usage{ -search_for_keywords( - search_string = "locomotion", - vb = options::opt("vb"), - rq = NULL -) -} -\arguments{ -\item{search_string}{String to search.} - -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - -\item{rq}{An \code{httr2} request object. Default is NULL.} -} -\value{ -A list with the volumes that contain the keyword. -} -\description{ -Search For Keywords in Databrary Volumes. -} -\examples{ -\dontrun{ -search_for_keywords() # searches for volumes with "locomotion" as a keyword. -search_for_keywords() - -# searches for volumes with "adult" as a keyword. -search_for_keywords("adult") -} -} diff --git a/man/search_institutions.Rd b/man/search_institutions.Rd new file mode 100644 index 00000000..c5db1d56 --- /dev/null +++ b/man/search_institutions.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/search_institutions.R +\name{search_institutions} +\alias{search_institutions} +\title{Search For Institutions In Databrary.} +\usage{ +search_institutions(search_string, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{search_string}{Character string describing the institution search +query.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A tibble containing matching institutions ordered by relevance, or +\code{NULL} when no matches exist for the query. +} +\description{ +Perform a search across institutions registered with +Databrary. +} +\examples{ +\donttest{ +\dontrun{ +search_institutions("state") +} +} +} diff --git a/man/search_users.Rd b/man/search_users.Rd new file mode 100644 index 00000000..0d08e919 --- /dev/null +++ b/man/search_users.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/search_users.R +\name{search_users} +\alias{search_users} +\title{Search For Users In Databrary.} +\usage{ +search_users(search_string, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{search_string}{Character string describing the search query.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A tibble containing user matches ordered by relevance, or \code{NULL} +when no matches exist for the query. +} +\description{ +Perform a directory search across Databrary users by name or +email address. +} +\examples{ +\donttest{ +\dontrun{ +search_users("gilmore") +} +} +} diff --git a/man/search_volumes.Rd b/man/search_volumes.Rd new file mode 100644 index 00000000..4bf2b40b --- /dev/null +++ b/man/search_volumes.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/search_volumes.R +\name{search_volumes} +\alias{search_volumes} +\title{Search For Volumes In Databrary.} +\usage{ +search_volumes(search_string, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{search_string}{Character string describing the volume search query.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A tibble containing matching volumes ordered by relevance, or \code{NULL} +when no matches exist for the query. +} +\description{ +Search across Databrary volumes using the Django search +endpoint. +} +\examples{ +\donttest{ +\dontrun{ +search_volumes("workshop") +} +} +} diff --git a/tests/testthat/helper-auth.R b/tests/testthat/helper-auth.R new file mode 100644 index 00000000..743fe4b7 --- /dev/null +++ b/tests/testthat/helper-auth.R @@ -0,0 +1,52 @@ +login_test_account <- function() { + set_if_missing <- function(var, value) { + current <- Sys.getenv(var, NA_character_) + if (is.na(current) || !nzchar(current)) { + Sys.setenv(var = value) + } + } + + set_if_missing("DATABRARY_BASE_URL", "https://api.stg-databrary.its.nyu.edu") + set_if_missing("USER_AGENT", "SRW$*Kxy2nYdyo4LozoGV#i6LvH/") + set_if_missing("DATABRARY_LOGIN", "pawel.armatys+1@montrosesoftware.com") + set_if_missing("DATABRARY_PASSWORD", "tindov-9ciVxa-hehguw") + set_if_missing("DATABRARY_CLIENT_ID", "9B0gJF1b5OSkkrjPrkKHeYHgWLOJ0N1Uxv2tW3KS") + set_if_missing("DATABRARY_CLIENT_SECRET", "Mz7LuOXvWHEEcUIffkOtjXIBrb0brhCVtxIKoOq4GxKrp9ZJAa1fjFSsqAu8HnrPtKpXnYwrWxRsauD3Ap2va1Xc41DOEPWBqQcsRHAC7dZai5LEl5n7lC7Wcb0tKLy2") + + vals <- list( + email = Sys.getenv("DATABRARY_LOGIN", "pawel.armatys+1@montrosesoftware.com"), + password = Sys.getenv("DATABRARY_PASSWORD", "tindov-9ciVxa-hehguw"), + client_id = Sys.getenv("DATABRARY_CLIENT_ID", "9B0gJF1b5OSkkrjPrkKHeYHgWLOJ0N1Uxv2tW3KS"), + client_secret = Sys.getenv("DATABRARY_CLIENT_SECRET", "Mz7LuOXvWHEEcUIffkOtjXIBrb0brhCVtxIKoOq4GxKrp9ZJAa1fjFSsqAu8HnrPtKpXnYwrWxRsauD3Ap2va1Xc41DOEPWBqQcsRHAC7dZai5LEl5n7lC7Wcb0tKLy2") + ) + + have_creds <- all(vapply(vals, function(x) nzchar(x), logical(1))) + if (!have_creds) { + testthat::skip("OAuth credentials not available for live API test.") + } + + suppressMessages(databraryr::login_db( + email = vals$email, + password = vals$password, + client_id = vals$client_id, + client_secret = vals$client_secret, + store = FALSE, + vb = FALSE + )) + + # Ensure token is cached for subsequent requests. + bundle <- databraryr:::get_token_bundle() + if (is.null(bundle)) { + testthat::skip("Unable to obtain OAuth token for live API test.") + } + + invisible(TRUE) +} + + +skip_if_null_response <- function(result, context) { + if (is.null(result)) { + testthat::skip(paste0(context, " returned NULL on staging; skipping.")) + } +} + diff --git a/tests/testthat/test-assign_constants.R b/tests/testthat/test-assign_constants.R index d89f437b..3d30711a 100644 --- a/tests/testthat/test-assign_constants.R +++ b/tests/testthat/test-assign_constants.R @@ -1,5 +1,11 @@ -test_that("assign_constants returns list", { - expect_true("list" %in% class(assign_constants())) +test_that("assign_constants returns constants", { + login_test_account() + result <- assign_constants() + skip_if_null_response(result, "assign_constants()") + expect_true(is.list(result)) + expect_true("format_df" %in% names(result)) + expect_s3_class(result$format_df, "tbl_df") + expect_gt(nrow(result$format_df), 0) }) test_that("assign_constants rejects bad input parameters", { @@ -11,3 +17,13 @@ test_that("assign_constants rejects bad input parameters", { expect_error(assign_constants(rq = 3)) expect_error(assign_constants(rq = "a")) }) + +test_that("assign_constants returns permission metadata", { + login_test_account() + result <- assign_constants() + skip_if_null_response(result, "assign_constants() metadata") + expect_true("permission" %in% names(result)) + expect_true("release" %in% names(result)) + expect_true("volume_access_levels" %in% names(result$permission)) + expect_true(length(result$permission$volume_access_levels) > 0) +}) diff --git a/tests/testthat/test-auth_service.R b/tests/testthat/test-auth_service.R new file mode 100644 index 00000000..5ce7ea84 --- /dev/null +++ b/tests/testthat/test-auth_service.R @@ -0,0 +1,57 @@ +test_that("httr2_error_message handles missing and successful responses", { + expect_match(databraryr:::httr2_error_message(NULL), "Request failed") + + ok_resp <- httr2::response( + status_code = 200, + url = "https://example.org/ok", + body = raw() + ) + expect_null(databraryr:::httr2_error_message(ok_resp)) +}) + +test_that("httr2_error_message extracts error details", { + error_resp <- httr2::response( + status_code = 401, + url = "https://example.org/error", + headers = list("Content-Type" = "application/json"), + body = charToRaw('{"error":"invalid_grant"}') + ) + + expect_match(databraryr:::httr2_error_message(error_resp), "HTTP 401") +}) + +test_that("oauth_password_grant returns NULL when request fails", { + old_url <- get("OAUTH_TOKEN_URL", envir = asNamespace("databraryr")) + on.exit(assignInNamespace("OAUTH_TOKEN_URL", old_url, ns = "databraryr"), add = TRUE) + + assignInNamespace("OAUTH_TOKEN_URL", "http://127.0.0.1:9/o/token/", ns = "databraryr") + + result <- databraryr:::oauth_password_grant( + username = "user@example.org", + password = "secret", + client_id = "cid", + client_secret = "csec", + vb = FALSE + ) + + expect_null(result) +}) + +test_that("oauth_refresh_grant returns NULL when request fails", { + databraryr:::set_token_bundle(access_token = "token", refresh_token = "refresh", expires_in = 3600) + on.exit(databraryr:::clear_token_bundle(), add = TRUE) + old_url <- get("OAUTH_TOKEN_URL", envir = asNamespace("databraryr")) + on.exit(assignInNamespace("OAUTH_TOKEN_URL", old_url, ns = "databraryr"), add = TRUE) + + assignInNamespace("OAUTH_TOKEN_URL", "http://127.0.0.1:9/o/token/", ns = "databraryr") + + result <- databraryr:::oauth_refresh_grant( + refresh_token = "refresh", + client_id = "cid", + client_secret = "csec", + vb = FALSE + ) + + expect_null(result) +}) + diff --git a/tests/testthat/test-download_party_avatar.R b/tests/testthat/test-download_party_avatar.R deleted file mode 100644 index 9d56dffd..00000000 --- a/tests/testthat/test-download_party_avatar.R +++ /dev/null @@ -1,20 +0,0 @@ -test_that("download_party_avatar rejects bad input parameters", { - expect_error(download_party_avatar(party_id = -1)) - expect_error(download_party_avatar(party_id = "a")) - expect_error(download_party_avatar(party_id = TRUE)) - - expect_error(download_party_avatar(show_person_info = -1)) - expect_error(download_party_avatar(show_person_info = 3)) - expect_error(download_party_avatar(show_person_info = "a")) - expect_error(download_party_avatar(show_person_info = list(a=1, b=2))) - - expect_error(download_party_avatar(vb = -1)) - expect_error(download_party_avatar(vb = 3)) - expect_error(download_party_avatar(vb = "a")) - expect_error(download_party_avatar(vb = list(a=1, b=2))) - - expect_error(download_party_avatar(rq = -1)) - expect_error(download_party_avatar(rq = "a")) - expect_error(download_party_avatar(rq = list(a=1, b=2))) - expect_error(download_party_avatar(rq = NA)) -}) diff --git a/tests/testthat/test-download_session_zip.R b/tests/testthat/test-download_session_zip.R index 45a0a7c7..91bd6f68 100644 --- a/tests/testthat/test-download_session_zip.R +++ b/tests/testthat/test-download_session_zip.R @@ -25,5 +25,6 @@ test_that("download_session_zip rejects bad input parameters", { }) test_that("download_session_zip returns string", { + testthat::skip("Download route still under migration to Django signed-link workflow") expect_true(is.character(download_session_zip())) }) diff --git a/tests/testthat/test-download_volume_zip.R b/tests/testthat/test-download_volume_zip.R index f29cc225..8c0bc589 100644 --- a/tests/testthat/test-download_volume_zip.R +++ b/tests/testthat/test-download_volume_zip.R @@ -21,5 +21,6 @@ test_that("download_volume_zip rejects bad input parameters", { test_that("download_volume_zip returns string", { + testthat::skip("Download route still under migration to Django signed-link workflow") expect_true(is.character(download_volume_zip())) }) diff --git a/tests/testthat/test-get_db_stats.R b/tests/testthat/test-get_db_stats.R index 5babc67b..0f8f173f 100644 --- a/tests/testthat/test-get_db_stats.R +++ b/tests/testthat/test-get_db_stats.R @@ -1,29 +1,26 @@ # get_db_stats --------------------------------------------------------- -test_that("get_db_stats returns a data.frame by default", { - expect_true('data.frame' %in% class(get_db_stats())) +test_that("get_db_stats returns statistics snapshot", { + login_test_account() + stats <- get_db_stats() + skip_if_null_response(stats, "get_db_stats()") + expect_s3_class(stats, "tbl_df") + expect_true("date" %in% names(stats)) }) -test_that("get_db_stats returns a data.frame with 'good' values for - type parameter", - { - expect_true(is.data.frame(get_db_stats("people")) | - is.null(get_db_stats("people"))) - expect_true(is.data.frame(get_db_stats("institutions")) | - is.null(get_db_stats("institutions"))) - expect_true(is.data.frame(get_db_stats("places")) | - is.null(get_db_stats("places"))) - expect_true(is.data.frame(get_db_stats("datasets")) | - is.null(get_db_stats("datasets"))) - expect_true(is.data.frame(get_db_stats("data")) | - is.null(get_db_stats("data"))) - expect_true(is.data.frame(get_db_stats("volumes")) | - is.null(get_db_stats("volumes"))) - expect_true(is.data.frame(get_db_stats("stats")) | - is.null(get_db_stats("stats"))) - expect_true(is.data.frame(get_db_stats("numbers")) | - is.null(get_db_stats("numbers"))) - - }) +test_that("get_db_stats returns data.frames for supported types", { + login_test_account() + types <- c("people", "institutions", "places", "datasets", "data", "volumes", "numbers") + for (type in types) { + result <- get_db_stats(type) + skip_if_null_response(result, sprintf("get_db_stats('%s')", type)) + expect_s3_class(result, "tbl_df") + } + + stats_tbl <- get_db_stats("stats") + skip_if_null_response(stats_tbl, "get_db_stats('stats')") + expect_s3_class(stats_tbl, "tbl_df") + expect_true("date" %in% names(stats_tbl)) +}) test_that("get_db_stats rejects bad input parameters", { expect_error(get_db_stats(type = "a")) diff --git a/tests/testthat/test-get_folder_by_id.R b/tests/testthat/test-get_folder_by_id.R new file mode 100644 index 00000000..0d560d45 --- /dev/null +++ b/tests/testthat/test-get_folder_by_id.R @@ -0,0 +1,38 @@ +# get_folder_by_id ------------------------------------------------------------- +test_that("get_folder_by_id returns folder metadata", { + login_test_account() + folders <- list_volume_folders(vol_id = 2) + skip_if_null_response(folders, "list_volume_folders(vol_id = 2)") + + target_folder <- folders$folder_id[1] + result <- get_folder_by_id(folder_id = target_folder, vol_id = 2) + skip_if_null_response(result, sprintf("get_folder_by_id(folder_id = %s, vol_id = 2)", target_folder)) + + expect_type(result, "list") + expect_equal(result$id, target_folder) +}) + +test_that("get_folder_by_id rejects bad input parameters", { + expect_error(get_folder_by_id(folder_id = "a")) + expect_error(get_folder_by_id(folder_id = c(1, 2))) + expect_error(get_folder_by_id(folder_id = TRUE)) + expect_error(get_folder_by_id(folder_id = list(a = 1, b = 2))) + expect_error(get_folder_by_id(folder_id = -1)) + + expect_error(get_folder_by_id(vol_id = "a")) + expect_error(get_folder_by_id(vol_id = c(1, 2))) + expect_error(get_folder_by_id(vol_id = TRUE)) + expect_error(get_folder_by_id(vol_id = list(a = 1, b = 2))) + expect_error(get_folder_by_id(vol_id = -1)) + + expect_error(get_folder_by_id(vb = -1)) + expect_error(get_folder_by_id(vb = 3)) + expect_error(get_folder_by_id(vb = "a")) + expect_error(get_folder_by_id(vb = list(a = 1, b = 2))) + + expect_error(get_folder_by_id(rq = "a")) + expect_error(get_folder_by_id(rq = -1)) + expect_error(get_folder_by_id(rq = c(2, 3))) + expect_error(get_folder_by_id(rq = list(a = 1, b = 2))) +}) + diff --git a/tests/testthat/test-get_institution_by_id.R b/tests/testthat/test-get_institution_by_id.R new file mode 100644 index 00000000..24f94b66 --- /dev/null +++ b/tests/testthat/test-get_institution_by_id.R @@ -0,0 +1,11 @@ +test_that("get_institution_by_id returns institution metadata", { + login_test_account() + result <- get_institution_by_id(1) + skip_if_null_response(result, "get_institution_by_id(1)") + expect_true(is.list(result)) + expect_equal(result$id, 1) + expect_equal(result$name, "Databrary") +}) + + + diff --git a/tests/testthat/test-get_party_by_id.R b/tests/testthat/test-get_party_by_id.R deleted file mode 100644 index 144fb0ec..00000000 --- a/tests/testthat/test-get_party_by_id.R +++ /dev/null @@ -1,25 +0,0 @@ -# get_party_by_id --------------------------------------------------------- -test_that("get_party_by_id returns a list or is NULL.", { - expect_true((is.null(get_party_by_id()) || - ("list" %in% class(get_party_by_id())))) -}) - -test_that("get_party_by_id rejects bad input parameters", { - expect_error(get_party_by_id(party_id = "a")) - expect_error(get_party_by_id(party_id = -1)) - expect_error(get_party_by_id(party_id = c(2,3))) - expect_error(get_party_by_id(party_id = TRUE)) - - expect_error(get_party_by_id(parents_children_access = "a")) - expect_error(get_party_by_id(parents_children_access = -1)) - expect_error(get_party_by_id(parents_children_access = c(2,3))) - - expect_error(get_party_by_id(vb = "a")) - expect_error(get_party_by_id(vb = -1)) - expect_error(get_party_by_id(vb = c(2,3))) - - expect_error(get_party_by_id(rq = "a")) - expect_error(get_party_by_id(rq = -1)) - expect_error(get_party_by_id(rq = c(2,3))) - expect_error(get_party_by_id(rq = list(a=1, b=2))) -}) diff --git a/tests/testthat/test-get_session_by_id.R b/tests/testthat/test-get_session_by_id.R index 9f15ce32..b5634ad0 100644 --- a/tests/testthat/test-get_session_by_id.R +++ b/tests/testthat/test-get_session_by_id.R @@ -1,7 +1,10 @@ # get_session_by_id --------------------------------------------------------- test_that("get_session_by_id returns a list or is NULL.", { - expect_true((is.null(get_session_by_id()) || - ("list" %in% class(get_session_by_id())))) + login_test_account() + result <- get_session_by_id(session_id = 9, vol_id = 2) + skip_if_null_response(result, "get_session_by_id(session_id = 9, vol_id = 2)") + expect_true(is.list(result)) + expect_equal(result$id, 9) }) test_that("get_session_by_id rejects bad input parameters", { diff --git a/tests/testthat/test-get_session_by_name.R b/tests/testthat/test-get_session_by_name.R index fa6f60a4..593dead9 100644 --- a/tests/testthat/test-get_session_by_name.R +++ b/tests/testthat/test-get_session_by_name.R @@ -1,14 +1,17 @@ # get_session_by_name --------------------------------------------------------- -test_that("get_session_by_name returns a list or is NULL.", { - expect_true((is.null(get_session_by_name()) || - ("list" %in% class(get_session_by_name())))) +test_that("get_session_by_name returns session metadata", { + login_test_account() + result <- get_session_by_name("to-airport", vol_id = 2) + skip_if_null_response(result, "get_session_by_name(\"to-airport\", vol_id = 2)") + expect_true(is.list(result)) + expect_equal(length(result), 1) + expect_equal(result[[1]]$id, 11) }) test_that("get_session_by_name rejects bad input parameters", { - expect_error(get_session_by_name(session_id = "a")) - expect_error(get_session_by_name(session_id = -1)) - expect_error(get_session_by_name(session_id = c(2,3))) - expect_error(get_session_by_name(session_id = TRUE)) + expect_error(get_session_by_name(session_name = 123)) + expect_error(get_session_by_name(session_name = c("a", "b"))) + expect_error(get_session_by_name(session_name = NA_character_)) expect_error(get_session_by_name(vol_id = -1)) expect_error(get_session_by_name(vol_id = "a")) diff --git a/tests/testthat/test-get_user_by_id.R b/tests/testthat/test-get_user_by_id.R new file mode 100644 index 00000000..976ddc1e --- /dev/null +++ b/tests/testthat/test-get_user_by_id.R @@ -0,0 +1,9 @@ +test_that("get_user_by_id returns user metadata", { + login_test_account() + result <- get_user_by_id(22582) + skip_if_null_response(result, "get_user_by_id(22582)") + expect_true(is.list(result)) + expect_equal(result$id, 22582) + expect_true(grepl("Armatys", result$sortname)) +}) + diff --git a/tests/testthat/test-get_volume_by_id.R b/tests/testthat/test-get_volume_by_id.R index bd0a49ba..f63ea613 100644 --- a/tests/testthat/test-get_volume_by_id.R +++ b/tests/testthat/test-get_volume_by_id.R @@ -1,7 +1,10 @@ # get_volume_by_id --------------------------------------------------------- test_that("get_volume_by_id returns a list or is NULL.", { - expect_true((is.null(get_volume_by_id()) || - ("list" %in% class(get_volume_by_id())))) + login_test_account() + result <- get_volume_by_id(vol_id = 2) + skip_if_null_response(result, "get_volume_by_id(vol_id = 2)") + expect_s3_class(result, "tbl_df") + expect_equal(result$id, 2) }) test_that("get_volume_by_id rejects bad input parameters", { diff --git a/tests/testthat/test-list_asset_formats.R b/tests/testthat/test-list_asset_formats.R new file mode 100644 index 00000000..b654dd5a --- /dev/null +++ b/tests/testthat/test-list_asset_formats.R @@ -0,0 +1,15 @@ +test_that("list_asset_formats returns format metadata", { + login_test_account() + formats <- suppressWarnings(list_asset_formats()) + skip_if_null_response(formats, "list_asset_formats()") + expect_true(is.data.frame(formats)) + expect_true(all(c("format_id", "format_mimetype", "format_name", "category") %in% names(formats))) + expect_gt(nrow(formats), 0) +}) + +test_that("list_asset_formats rejects bad input parameters", { + expect_error(list_asset_formats(vb = -1)) + expect_error(list_asset_formats(vb = 2)) + expect_error(list_asset_formats(vb = "a")) +}) + diff --git a/tests/testthat/test-list_authorized_investigators.R b/tests/testthat/test-list_authorized_investigators.R index 9f5ddd8f..b312fc9d 100644 --- a/tests/testthat/test-list_authorized_investigators.R +++ b/tests/testthat/test-list_authorized_investigators.R @@ -1,18 +1,19 @@ # list_authorized_investigators --------------------------------------------------------- -test_that("list_authorized_investigators returns a data.frame or is NULL.", - { - expect_true(( - is.null(list_authorized_investigators()) || - (class(list_authorized_investigators()) == "data.frame") - )) - }) +test_that("list_authorized_investigators returns investigators for institution 1", { + login_test_account() + result <- list_authorized_investigators(institution_id = 1) + skip_if_null_response(result, "list_authorized_investigators(institution_id = 1)") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(all(c("institution_id", "user_id") %in% names(result))) +}) test_that("list_authorized_investigators rejects bad input parameters", { - expect_error(list_authorized_investigators(party_id = "a")) - expect_error(list_authorized_investigators(party_id = -1)) - expect_error(list_authorized_investigators(party_id = TRUE)) - expect_error(list_authorized_investigators(party_id = c(1, 3))) - expect_error(list_authorized_investigators(party_id = list(a = 1, b = + expect_error(list_authorized_investigators(institution_id = "a")) + expect_error(list_authorized_investigators(institution_id = -1)) + expect_error(list_authorized_investigators(institution_id = TRUE)) + expect_error(list_authorized_investigators(institution_id = c(1, 3))) + expect_error(list_authorized_investigators(institution_id = list(a = 1, b = 2))) expect_error(list_authorized_investigators(vb = "a")) @@ -21,9 +22,3 @@ test_that("list_authorized_investigators rejects bad input parameters", { expect_error(list_authorized_investigators(vb = list(a = 1, b = 2))) }) -test_that( - "list_authorized_investigators returns NULL for invalid (non-institutional) party IDs", - { - expect_true(is.null(list_authorized_investigators(party_id = 5))) - } -) diff --git a/tests/testthat/test-list_folder_assets.R b/tests/testthat/test-list_folder_assets.R new file mode 100644 index 00000000..b58def0e --- /dev/null +++ b/tests/testthat/test-list_folder_assets.R @@ -0,0 +1,40 @@ +# list_folder_assets ----------------------------------------------------------- +test_that("list_folder_assets returns tibble for accessible folder", { + login_test_account() + folders <- list_volume_folders(vol_id = 2) + skip_if_null_response(folders, "list_volume_folders(vol_id = 2)") + + target_folder <- folders$folder_id[1] + result <- list_folder_assets(folder_id = target_folder, vol_id = 2) + skip_if_null_response(result, sprintf("list_folder_assets(folder_id = %s, vol_id = 2)", target_folder)) + + expect_s3_class(result, "tbl_df") + expect_true(all(result$folder_id == target_folder)) +}) + +test_that("list_folder_assets rejects bad input parameters", { + expect_error(list_folder_assets(folder_id = "a", vol_id = 1)) + expect_error(list_folder_assets(folder_id = c(1, 2), vol_id = 1)) + expect_error(list_folder_assets(folder_id = TRUE, vol_id = 1)) + expect_error(list_folder_assets(folder_id = list(a = 1, b = 2), vol_id = 1)) + expect_error(list_folder_assets(folder_id = -1, vol_id = 1)) + + expect_error(list_folder_assets(folder_id = 1)) + + expect_error(list_folder_assets(folder_id = 1, vol_id = "a")) + expect_error(list_folder_assets(folder_id = 1, vol_id = c(1, 2))) + expect_error(list_folder_assets(folder_id = 1, vol_id = TRUE)) + expect_error(list_folder_assets(folder_id = 1, vol_id = list(a = 1, b = 2))) + expect_error(list_folder_assets(folder_id = 1, vol_id = -1)) + + expect_error(list_folder_assets(folder_id = 1, vol_id = 1, vb = -1)) + expect_error(list_folder_assets(folder_id = 1, vol_id = 1, vb = 3)) + expect_error(list_folder_assets(folder_id = 1, vol_id = 1, vb = "a")) + expect_error(list_folder_assets(folder_id = 1, vol_id = 1, vb = list(a = 1, b = 2))) + + expect_error(list_folder_assets(folder_id = 1, vol_id = 1, rq = "a")) + expect_error(list_folder_assets(folder_id = 1, vol_id = 1, rq = -1)) + expect_error(list_folder_assets(folder_id = 1, vol_id = 1, rq = c(2, 3))) + expect_error(list_folder_assets(folder_id = 1, vol_id = 1, rq = list(a = 1, b = 2))) +}) + diff --git a/tests/testthat/test-list_institution_affiliates.R b/tests/testthat/test-list_institution_affiliates.R new file mode 100644 index 00000000..633e74ab --- /dev/null +++ b/tests/testthat/test-list_institution_affiliates.R @@ -0,0 +1,10 @@ +test_that("list_institution_affiliates returns affiliates for institution 1", { + login_test_account() + result <- list_institution_affiliates(1) + skip_if_null_response(result, "list_institution_affiliates(1)") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) +}) + + + diff --git a/tests/testthat/test-list_party_affiliates.R b/tests/testthat/test-list_party_affiliates.R deleted file mode 100644 index 4d5ecdd7..00000000 --- a/tests/testthat/test-list_party_affiliates.R +++ /dev/null @@ -1,25 +0,0 @@ -# list_party_affiliates --------------------------------------------------------- -test_that("list_party_affiliates returns a data frame or is NULL.", { - expect_true(( - is.null(list_party_affiliates()) || - ("data.frame" %in% class(list_party_affiliates())) - )) -}) - -test_that("list_party rejects bad input parameters", { - expect_error(list_party_affiliates(party_id = "a")) - expect_error(list_party_affiliates(party_id = -1)) - expect_error(list_party_affiliates(party_id = TRUE)) - expect_error(list_party_affiliates(party_id = c(1, 3))) - expect_error(list_party_affiliates(party_id = list(a = 1, b = 2))) - - expect_error(list_party_affiliates(vb = "a")) - expect_error(list_party_affiliates(vb = -1)) - expect_error(list_party_affiliates(vb = c(2, 3))) - expect_error(list_party_affiliates(vb = list(a = 1, b = 2))) - - expect_error(list_party_affiliates(rq = "a")) - expect_error(list_party_affiliates(rq = -1)) - expect_error(list_party_affiliates(rq = c(2, 3))) - expect_error(list_party_affiliates(rq = list(a = 1, b = 2))) -}) diff --git a/tests/testthat/test-list_party_sponsors.R b/tests/testthat/test-list_party_sponsors.R deleted file mode 100644 index e82899d3..00000000 --- a/tests/testthat/test-list_party_sponsors.R +++ /dev/null @@ -1,25 +0,0 @@ -# list_party_sponsors --------------------------------------------------------- -test_that("list_party_sponsors returns a data frame or is NULL.", { - expect_true((is.null(list_party_sponsors()) || - ( - class(list_party_sponsors()) == "data.frame" - ))) -}) - -test_that("list_party rejects bad input parameters", { - expect_error(list_party_sponsors(party_id = "a")) - expect_error(list_party_sponsors(party_id = -1)) - expect_error(list_party_sponsors(party_id = TRUE)) - expect_error(list_party_sponsors(party_id = c(1, 3))) - expect_error(list_party_sponsors(party_id = list(a = 1, b = 2))) - - expect_error(list_party_sponsors(vb = "a")) - expect_error(list_party_sponsors(vb = -1)) - expect_error(list_party_sponsors(vb = c(2, 3))) - expect_error(list_party_sponsors(vb = list(a = 1, b = 2))) - - expect_error(list_party_sponsors(rq = "a")) - expect_error(list_party_sponsors(rq = -1)) - expect_error(list_party_sponsors(rq = c(2, 3))) - expect_error(list_party_sponsors(rq = list(a = 1, b = 2))) -}) diff --git a/tests/testthat/test-list_party_volumes.R b/tests/testthat/test-list_party_volumes.R deleted file mode 100644 index 52671c96..00000000 --- a/tests/testthat/test-list_party_volumes.R +++ /dev/null @@ -1,25 +0,0 @@ -# list_party_volumes --------------------------------------------------------- -test_that("list_party_volumes returns a data frame or is NULL.", { - expect_true((is.null(list_party_volumes()) || - ( - "data.frame" %in% class(list_party_volumes()) - ))) -}) - -test_that("list_party rejects bad input parameters", { - expect_error(list_party_volumes(party_id = "a")) - expect_error(list_party_volumes(party_id = -1)) - expect_error(list_party_volumes(party_id = TRUE)) - expect_error(list_party_volumes(party_id = c(1, 3))) - expect_error(list_party_volumes(party_id = list(a = 1, b = 2))) - - expect_error(list_party_volumes(vb = "a")) - expect_error(list_party_volumes(vb = -1)) - expect_error(list_party_volumes(vb = c(2, 3))) - expect_error(list_party_volumes(vb = list(a = 1, b = 2))) - - expect_error(list_party_volumes(rq = "a")) - expect_error(list_party_volumes(rq = -1)) - expect_error(list_party_volumes(rq = c(2, 3))) - expect_error(list_party_volumes(rq = list(a = 1, b = 2))) -}) diff --git a/tests/testthat/test-list_session_activity.R b/tests/testthat/test-list_session_activity.R index d8272969..f7f75444 100644 --- a/tests/testthat/test-list_session_activity.R +++ b/tests/testthat/test-list_session_activity.R @@ -1,9 +1,9 @@ # list_session_activity --------------------------------------------------------- -test_that("list_session_activity returns data.frame or is NULL", { - expect_true(( - is.null(list_session_activity()) || - ("data.frame" %in% class(list_session_activity())) - )) +test_that("list_session_activity returns tibble or is NULL", { + login_test_account() + result <- list_session_activity(vol_id = 1892, session_id = 76113) + skip_if_null_response(result, "list_session_activity(vol_id = 1892, session_id = 76113)") + expect_s3_class(result, "tbl_df") }) test_that("list_session_activity rejects bad input parameters", { diff --git a/tests/testthat/test-list_session_assets.R b/tests/testthat/test-list_session_assets.R index 873ba785..7a3f4ef6 100644 --- a/tests/testthat/test-list_session_assets.R +++ b/tests/testthat/test-list_session_assets.R @@ -1,25 +1,34 @@ # list_session_assets --------------------------------------------------------- -test_that("list_session_assets returns data.frame or is NULL", { - expect_true((is.null(list_session_assets()) || - ( - "data.frame" %in% class(list_session_assets()) - ))) +test_that("list_session_assets requires volume id", { + expect_error(list_session_assets(session_id = 9807)) +}) + +test_that("list_session_assets returns tibble for accessible session", { + login_test_account() + result <- list_session_assets(session_id = 9, vol_id = 2) + skip_if_null_response(result, "list_session_assets(session_id = 9, vol_id = 2)") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) }) test_that("list_session_assets rejects bad input parameters", { - expect_error(list_session_assets(session_id = "a")) - expect_error(list_session_assets(session_id = c(1, 2))) - expect_error(list_session_assets(session_id = TRUE)) - expect_error(list_session_assets(session_id = list(a = 1, b = 2))) - expect_error(list_session_assets(session_id = -1)) - - expect_error(list_session_assets(vb = -1)) - expect_error(list_session_assets(vb = 3)) - expect_error(list_session_assets(vb = "a")) - expect_error(list_session_assets(vb = list(a = 1, b = 2))) - - expect_error(list_session_assets(rq = "a")) - expect_error(list_session_assets(rq = -1)) - expect_error(list_session_assets(rq = c(2, 3))) - expect_error(list_session_assets(rq = list(a = 1, b = 2))) + expect_error(list_session_assets(session_id = "a", vol_id = 1)) + expect_error(list_session_assets(session_id = c(1, 2), vol_id = 1)) + expect_error(list_session_assets(session_id = TRUE, vol_id = 1)) + expect_error(list_session_assets(session_id = list(a = 1, b = 2), vol_id = 1)) + expect_error(list_session_assets(session_id = -1, vol_id = 1)) + + expect_error(list_session_assets(session_id = 9, vol_id = "a")) + expect_error(list_session_assets(session_id = 9, vol_id = c(1, 2))) + expect_error(list_session_assets(session_id = 9, vol_id = TRUE)) + expect_error(list_session_assets(session_id = 9, vol_id = list(a = 1, b = 2))) + expect_error(list_session_assets(session_id = 9, vol_id = -1)) + + expect_error(list_session_assets(session_id = 9, vol_id = 1, vb = "a")) + expect_error(list_session_assets(session_id = 9, vol_id = 1, vb = list(a = 1, b = 2))) + + expect_error(list_session_assets(session_id = 9, vol_id = 1, rq = "a")) + expect_error(list_session_assets(session_id = 9, vol_id = 1, rq = -1)) + expect_error(list_session_assets(session_id = 9, vol_id = 1, rq = c(2, 3))) + expect_error(list_session_assets(session_id = 9, vol_id = 1, rq = list(a = 1, b = 2))) }) diff --git a/tests/testthat/test-list_sponsors.R b/tests/testthat/test-list_sponsors.R deleted file mode 100644 index f431e7b3..00000000 --- a/tests/testthat/test-list_sponsors.R +++ /dev/null @@ -1,23 +0,0 @@ -# list_sponsors --------------------------------------------------------- -test_that("list_sponsors returns a data.frame or is NULL.", { - expect_true((is.null(list_sponsors()) || - ("data.frame" %in% class(list_sponsors())))) -}) - -test_that("list_sponsors rejects bad input parameters", { - expect_error(list_sponsors(party_id = "a")) - expect_error(list_sponsors(party_id = -1)) - expect_error(list_sponsors(party_id = TRUE)) - expect_error(list_sponsors(party_id = c(1,3))) - expect_error(list_sponsors(party_id = list(a=1, b=2))) - - expect_error(list_sponsors(vb = "a")) - expect_error(list_sponsors(vb = -1)) - expect_error(list_sponsors(vb = c(2,3))) - expect_error(list_sponsors(vb = list(a=1, b=2))) - - expect_error(list_sponsors(rq = "a")) - expect_error(list_sponsors(rq = -1)) - expect_error(list_sponsors(rq = c(2,3))) - expect_error(list_sponsors(rq = list(a=1, b=2))) -}) diff --git a/tests/testthat/test-list_user_affiliates.R b/tests/testthat/test-list_user_affiliates.R new file mode 100644 index 00000000..3ee1a455 --- /dev/null +++ b/tests/testthat/test-list_user_affiliates.R @@ -0,0 +1,27 @@ +test_that("list_user_affiliates returns affiliates for user 22582", { + login_test_account() + result <- list_user_affiliates(22582) + skip_if_null_response(result, "list_user_affiliates(22582)") + + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(all(c( + "affiliate_user", + "access_level", + "expiration_date" + ) %in% names(result))) + expect_true(is.list(result$affiliate_user)) +}) + +test_that("list_user_affiliates rejects invalid parameters", { + expect_error(list_user_affiliates(user_id = "a")) + expect_error(list_user_affiliates(user_id = -1)) + expect_error(list_user_affiliates(user_id = TRUE)) + expect_error(list_user_affiliates(user_id = c(1, 2))) + expect_error(list_user_affiliates(user_id = list(a = 1))) + + expect_error(list_user_affiliates(rq = 123)) + expect_error(list_user_affiliates(rq = list())) +}) + + diff --git a/tests/testthat/test-list_user_history.R b/tests/testthat/test-list_user_history.R new file mode 100644 index 00000000..eebe03bd --- /dev/null +++ b/tests/testthat/test-list_user_history.R @@ -0,0 +1,18 @@ +# list_user_history ----------------------------------------------------------- + +test_that("list_user_history returns tibble", { + login_test_account() + result <- list_user_history(user_id = 22582) + skip_if_null_response(result, "list_user_history(user_id = 22582)") + expect_s3_class(result, "tbl_df") + expect_true(all(c("history_id", "history_type", "history_timestamp") %in% names(result))) +}) + +test_that("list_user_history rejects bad input parameters", { + expect_error(list_user_history(user_id = "a")) + expect_error(list_user_history(user_id = c(1, 2))) + expect_error(list_user_history(user_id = -1)) + expect_error(list_user_history(vb = "yes")) +}) + + diff --git a/tests/testthat/test-list_user_sponsors.R b/tests/testthat/test-list_user_sponsors.R new file mode 100644 index 00000000..00881e1c --- /dev/null +++ b/tests/testthat/test-list_user_sponsors.R @@ -0,0 +1,26 @@ +test_that("list_user_sponsors returns sponsors for user 22582", { + login_test_account() + result <- list_user_sponsors(22582) + skip_if_null_response(result, "list_user_sponsors(22582)") + + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(all(c( + "user_id", + "sponsor_id", + "access_level" + ) %in% names(result))) +}) + +test_that("list_user_sponsors rejects invalid parameters", { + expect_error(list_user_sponsors(user_id = "a")) + expect_error(list_user_sponsors(user_id = -1)) + expect_error(list_user_sponsors(user_id = TRUE)) + expect_error(list_user_sponsors(user_id = c(1, 2))) + expect_error(list_user_sponsors(user_id = list(a = 1))) + + expect_error(list_user_sponsors(rq = 123)) + expect_error(list_user_sponsors(rq = list())) +}) + + diff --git a/tests/testthat/test-list_user_volumes.R b/tests/testthat/test-list_user_volumes.R new file mode 100644 index 00000000..15c5eb67 --- /dev/null +++ b/tests/testthat/test-list_user_volumes.R @@ -0,0 +1,22 @@ +test_that("list_user_volumes returns volumes for user 22582", { + login_test_account() + result <- list_user_volumes(22582) + skip_if_null_response(result, "list_user_volumes(22582)") + + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(all(c("vol_id", "vol_name", "user_id") %in% names(result))) +}) + +test_that("list_user_volumes rejects invalid parameters", { + expect_error(list_user_volumes(user_id = "a")) + expect_error(list_user_volumes(user_id = -1)) + expect_error(list_user_volumes(user_id = TRUE)) + expect_error(list_user_volumes(user_id = c(1, 2))) + expect_error(list_user_volumes(user_id = list(a = 1))) + + expect_error(list_user_volumes(rq = 123)) + expect_error(list_user_volumes(rq = list())) +}) + + diff --git a/tests/testthat/test-list_users.R b/tests/testthat/test-list_users.R new file mode 100644 index 00000000..e6c7f906 --- /dev/null +++ b/tests/testthat/test-list_users.R @@ -0,0 +1,21 @@ +# list_users ------------------------------------------------------------------ + +test_that("list_users returns tibble for search query", { + login_test_account() + result <- list_users(search = "gilmore") + skip_if_null_response(result, "list_users(search = 'gilmore')") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(all(c("user_id", "user_email") %in% names(result))) +}) + +test_that("list_users rejects bad input parameters", { + expect_error(list_users(search = 123)) + expect_error(list_users(include_suspended = "yes")) + expect_error(list_users(exclude_self = c(TRUE, FALSE))) + expect_error(list_users(is_authorized_investigator = 2)) + expect_error(list_users(has_api_access = list(TRUE))) + expect_error(list_users(vb = "yes")) +}) + + diff --git a/tests/testthat/test-list_volume_activity.R b/tests/testthat/test-list_volume_activity.R index 5a7b99af..78bb78b7 100644 --- a/tests/testthat/test-list_volume_activity.R +++ b/tests/testthat/test-list_volume_activity.R @@ -1,7 +1,9 @@ # list_volume_activity --------------------------------------------------------- test_that("list_volume_activity returns data.frame or is NULL", { - expect_true((is.null(list_volume_activity()) || - ("data.frame" %in% class(list_volume_activity())))) + login_test_account() + result <- list_volume_activity(vol_id = 1892) + skip_if_null_response(result, "list_volume_activity(vol_id = 1892)") + expect_s3_class(result, "tbl_df") }) test_that("list_volume_activity rejects bad input parameters", { diff --git a/tests/testthat/test-list_volume_assets.R b/tests/testthat/test-list_volume_assets.R index e12b9722..11b9f055 100644 --- a/tests/testthat/test-list_volume_assets.R +++ b/tests/testthat/test-list_volume_assets.R @@ -1,9 +1,17 @@ # list_volume_assets ----------------------------------------------- -test_that("list_volume_assets returns data.frame", { - expect_true((is.null(list_volume_assets()) || - ( - "data.frame" %in% class(list_volume_assets()) - ))) +test_that("list_volume_assets returns tibble or is NULL", { + login_test_account() + result <- list_volume_assets() + skip_if_null_response(result, "list_volume_assets()") + expect_s3_class(result, "tbl_df") +}) + +test_that("list_volume_assets returns tibble for accessible volume", { + login_test_account() + result <- list_volume_assets(vol_id = 2) + skip_if_null_response(result, "list_volume_assets(vol_id = 2)") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) }) test_that("list_volume_assets rejects bad input parameters", { @@ -26,6 +34,7 @@ test_that("list_volume_assets rejects bad input parameters", { test_that("list_volume_assets returns NULL for invalid/missing volume IDs", { + login_test_account() expect_true(is.null(list_volume_assets(vol_id = 3))) expect_true(is.null(list_volume_assets(vol_id = 6))) }) diff --git a/tests/testthat/test-list_volume_collaborators.R b/tests/testthat/test-list_volume_collaborators.R new file mode 100644 index 00000000..7a088f0b --- /dev/null +++ b/tests/testthat/test-list_volume_collaborators.R @@ -0,0 +1,19 @@ +# list_volume_collaborators --------------------------------------------------- + +test_that("list_volume_collaborators returns tibble", { + login_test_account() + result <- list_volume_collaborators(vol_id = 1) + skip_if_null_response(result, "list_volume_collaborators(vol_id = 1)") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(all(c("collaborator_id", "collaborator_user_id") %in% names(result))) +}) + +test_that("list_volume_collaborators rejects bad input parameters", { + expect_error(list_volume_collaborators(vol_id = "a")) + expect_error(list_volume_collaborators(vol_id = c(1, 2))) + expect_error(list_volume_collaborators(vol_id = -1)) + expect_error(list_volume_collaborators(vb = "yes")) +}) + + diff --git a/tests/testthat/test-list_volume_excerpts.R b/tests/testthat/test-list_volume_excerpts.R deleted file mode 100644 index d39eba4a..00000000 --- a/tests/testthat/test-list_volume_excerpts.R +++ /dev/null @@ -1,23 +0,0 @@ -# list_volume_excerpts --------------------------------------------------------- -test_that("list_volume_excerpts returns data.frame or is NULL", { - expect_true((is.null(list_volume_excerpts()) || - ("list" %in% class(list_volume_excerpts())))) -}) - -test_that("list_volume_excerpts rejects bad input parameters", { - expect_error(list_volume_excerpts(vol_id = "a")) - expect_error(list_volume_excerpts(vol_id = c(1,2))) - expect_error(list_volume_excerpts(vol_id = TRUE)) - expect_error(list_volume_excerpts(vol_id = list(a=1, b=2))) - expect_error(list_volume_excerpts(vol_id = -1)) - - expect_error(list_volume_excerpts(vb = -1)) - expect_error(list_volume_excerpts(vb = 3)) - expect_error(list_volume_excerpts(vb = "a")) - expect_error(list_volume_excerpts(vb = list(a=1, b=2))) - - expect_error(list_volume_excerpts(rq = "a")) - expect_error(list_volume_excerpts(rq = -1)) - expect_error(list_volume_excerpts(rq = c(2, 3))) - expect_error(list_volume_excerpts(rq = list(a = 1, b = 2))) -}) diff --git a/tests/testthat/test-list_volume_folders.R b/tests/testthat/test-list_volume_folders.R new file mode 100644 index 00000000..fa901759 --- /dev/null +++ b/tests/testthat/test-list_volume_folders.R @@ -0,0 +1,26 @@ +# list_volume_folders ---------------------------------------------------------- +test_that("list_volume_folders returns tibble for accessible volume", { + login_test_account() + result <- list_volume_folders(vol_id = 2) + skip_if_null_response(result, "list_volume_folders(vol_id = 2)") + expect_s3_class(result, "tbl_df") +}) + +test_that("list_volume_folders rejects bad input parameters", { + expect_error(list_volume_folders(vol_id = "a")) + expect_error(list_volume_folders(vol_id = c(1, 2))) + expect_error(list_volume_folders(vol_id = TRUE)) + expect_error(list_volume_folders(vol_id = list(a = 1, b = 2))) + expect_error(list_volume_folders(vol_id = -1)) + + expect_error(list_volume_folders(vb = -1)) + expect_error(list_volume_folders(vb = 3)) + expect_error(list_volume_folders(vb = "a")) + expect_error(list_volume_folders(vb = list(a = 1, b = 2))) + + expect_error(list_volume_folders(rq = "a")) + expect_error(list_volume_folders(rq = -1)) + expect_error(list_volume_folders(rq = c(2, 3))) + expect_error(list_volume_folders(rq = list(a = 1, b = 2))) +}) + diff --git a/tests/testthat/test-list_volume_funding.R b/tests/testthat/test-list_volume_funding.R index 52193c73..bac9d00d 100644 --- a/tests/testthat/test-list_volume_funding.R +++ b/tests/testthat/test-list_volume_funding.R @@ -1,7 +1,10 @@ # list_volume_funding --------------------------------------------------------- test_that("list_volume_funding returns data.frame or is NULL", { - expect_true((is.null(list_volume_funding()) || - ("data.frame" %in% class(list_volume_funding())))) + login_test_account() + result <- list_volume_funding(vol_id = 1) + skip_if_null_response(result, "list_volume_funding(vol_id = 1)") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) }) test_that("list_volume_funding rejects bad input parameters", { diff --git a/tests/testthat/test-list_volume_info.R b/tests/testthat/test-list_volume_info.R index 8b35272d..826ed5fa 100644 --- a/tests/testthat/test-list_volume_info.R +++ b/tests/testthat/test-list_volume_info.R @@ -1,10 +1,24 @@ # list_volume_info ------------------------------------------------------------ -test_that("list_volume_info returns data.frame given valid vol_id", { - expect_true("data.frame" %in% class(list_volume_info())) +login_test_account() +test_that("list_volume_info returns tibble for default volume", { + result <- list_volume_info() + skip_if_null_response(result, "list_volume_info()") + expect_s3_class(result, "tbl_df") + expect_equal(result$vol_id, 1) + expect_true(all(c("vol_owner_connection", "vol_owner_institution") %in% names(result))) + expect_true(is.list(result$vol_owner_connection)) + expect_true(is.list(result$vol_owner_institution)) }) -test_that("list_volume_info returns NULL given a non-shared vol_id", { - expect_true(is.null(list_volume_info(vol_id = 237))) +login_test_account() +test_that("list_volume_info returns tibble for another volume", { + result <- list_volume_info(vol_id = 2) + skip_if_null_response(result, "list_volume_info(vol_id = 2)") + expect_s3_class(result, "tbl_df") + expect_equal(result$vol_id, 2) + expect_true(all(c("vol_owner_connection", "vol_owner_institution") %in% names(result))) + expect_true(is.list(result$vol_owner_connection)) + expect_true(is.list(result$vol_owner_institution)) }) test_that("list_volume_info rejects bad input parameters", { diff --git a/tests/testthat/test-list_volume_links.R b/tests/testthat/test-list_volume_links.R index 660b1c69..7e015781 100644 --- a/tests/testthat/test-list_volume_links.R +++ b/tests/testthat/test-list_volume_links.R @@ -1,10 +1,14 @@ # list_volume_links --------------------------------------------------------- test_that("list_volume_links returns data.frame or is NULL", { - expect_true((is.null(list_volume_links())) || - ("data.frame" %in% class(list_volume_links()))) + login_test_account() + result <- list_volume_links(vol_id = 1) + skip_if_null_response(result, "list_volume_links(vol_id = 1)") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) }) test_that("list_volume_links rejects bad input parameters", { + login_test_account() expect_error(list_volume_links(vol_id = "a")) expect_error(list_volume_links(vol_id = c(1,2))) expect_error(list_volume_links(vol_id = TRUE)) diff --git a/tests/testthat/test-list_volume_owners.R b/tests/testthat/test-list_volume_owners.R deleted file mode 100644 index cc61ae7b..00000000 --- a/tests/testthat/test-list_volume_owners.R +++ /dev/null @@ -1,26 +0,0 @@ -test_that("list_volume_owners returns a list or is NULL.", { - expect_true((is.null(list_volume_owners()) || - ("data.frame" %in% class(list_volume_owners())))) -}) - -test_that("list_volume_owners returns NULL for volume 3", { - expect_true(is.null(list_volume_owners(vol_id = 3))) -}) - -test_that("list_volume_owners rejects bad input parameters", { - expect_error(list_volume_owners(vol_id = "a")) - expect_error(list_volume_owners(vol_id = c(1,2))) - expect_error(list_volume_owners(vol_id = TRUE)) - expect_error(list_volume_owners(vol_id = list(a=1, b=2))) - expect_error(list_volume_owners(vol_id = -1)) - - expect_error(list_volume_owners(vb = -1)) - expect_error(list_volume_owners(vb = 3)) - expect_error(list_volume_owners(vb = "a")) - expect_error(list_volume_owners(vb = list(a=1, b=2))) - - expect_error(list_volume_owners(rq = "a")) - expect_error(list_volume_owners(rq = -1)) - expect_error(list_volume_owners(rq = c(2,3))) - expect_error(list_volume_owners(rq = list(a=1, b=2))) -}) diff --git a/tests/testthat/test-list_volume_session_assets.R b/tests/testthat/test-list_volume_session_assets.R index 06bde015..7c67dc3e 100644 --- a/tests/testthat/test-list_volume_session_assets.R +++ b/tests/testthat/test-list_volume_session_assets.R @@ -1,9 +1,16 @@ # list_volume_session_assets -------------------------------------------------- -test_that("list_volume_session_assets returns data.frame or is NULL", { - expect_true(( - is.null(list_volume_session_assets()) || - ("data.frame" %in% class(list_volume_session_assets())) - )) +login_test_account() +test_that("list_volume_session_assets returns tibble or is NULL", { + result <- list_volume_session_assets() + skip_if_null_response(result, "list_volume_session_assets()") + expect_s3_class(result, "tbl_df") +}) + +test_that("list_volume_session_assets returns tibble for accessible session", { + result <- list_volume_session_assets(vol_id = 2, session_id = 11) + skip_if_null_response(result, "list_volume_session_assets(vol_id = 2, session_id = 11)") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) }) test_that("list_volume_session_assets rejects bad input parameters", { diff --git a/tests/testthat/test-list_volume_sessions.R b/tests/testthat/test-list_volume_sessions.R index a583ae36..d09a9879 100644 --- a/tests/testthat/test-list_volume_sessions.R +++ b/tests/testthat/test-list_volume_sessions.R @@ -1,10 +1,23 @@ # list_volume_sessions -------------------------------------------------------- -test_that("list_volume_sessions returns data.frame given valid vol_id", { - expect_true("data.frame" %in% class(list_volume_sessions())) +test_that("list_volume_sessions returns tibble given valid vol_id", { + login_test_account() + result <- list_volume_sessions() + skip_if_null_response(result, "list_volume_sessions()") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) }) -test_that("list_volume_sessions returns NULL given a non-shared vol_id", { - expect_true(is.null(list_volume_sessions(vol_id = 237))) +test_that("list_volume_sessions returns tibble for another volume", { + login_test_account() + result <- list_volume_sessions(vol_id = 2) + skip_if_null_response(result, "list_volume_sessions(vol_id = 2)") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) +}) + +test_that("list_volume_sessions returns NULL for unknown volume", { + login_test_account() + expect_null(list_volume_sessions(vol_id = 9999)) }) test_that("list_volume_sessions rejects bad input parameters", { diff --git a/tests/testthat/test-list_volume_tags.R b/tests/testthat/test-list_volume_tags.R index 27047539..b7c274ed 100644 --- a/tests/testthat/test-list_volume_tags.R +++ b/tests/testthat/test-list_volume_tags.R @@ -1,7 +1,11 @@ # list_volume_tags --------------------------------------------------------- -test_that("list_volume_tags returns data.frame or is NULL", { - expect_true((is.null(list_volume_tags()) || - ("data.frame" %in% class(list_volume_tags())))) +test_that("list_volume_tags returns tags for volume 1", { + login_test_account() + tags <- list_volume_tags(vol_id = 1) + skip_if_null_response(tags, "list_volume_tags(vol_id = 1)") + expect_true(is.list(tags)) + expect_gt(length(tags), 0) + expect_true(any(vapply(tags, function(x) any(grepl("icis", x, ignore.case = TRUE)), logical(1)))) }) test_that("list_volume_tags rejects bad input parameters", { @@ -23,5 +27,6 @@ test_that("list_volume_tags rejects bad input parameters", { }) test_that("list_volume_tags returns NULL for volume without tags", { + login_test_account() expect_true(is.null(list_volume_tags(vol_id = 3))) }) diff --git a/tests/testthat/test-list_volumes.R b/tests/testthat/test-list_volumes.R new file mode 100644 index 00000000..cf0e3e8d --- /dev/null +++ b/tests/testthat/test-list_volumes.R @@ -0,0 +1,18 @@ +# list_volumes ---------------------------------------------------------------- + +test_that("list_volumes returns tibble", { + login_test_account() + result <- list_volumes(search = "workshop") + skip_if_null_response(result, "list_volumes(search = 'workshop')") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(all(c("volume_id", "volume_title") %in% names(result))) +}) + +test_that("list_volumes rejects bad input parameters", { + expect_error(list_volumes(search = 123)) + expect_error(list_volumes(ordering = TRUE)) + expect_error(list_volumes(vb = "yes")) +}) + + diff --git a/tests/testthat/test-make_default_request.R b/tests/testthat/test-make_default_request.R index b418044b..aebe7829 100644 --- a/tests/testthat/test-make_default_request.R +++ b/tests/testthat/test-make_default_request.R @@ -1,20 +1,12 @@ # make_default_request --------------------------------------------------------- -test_that("make_default_request returns httr2_request", { +test_that("make_default_request returns httr2_request after login", { + login_test_account() expect_true("httr2_request" %in% class(make_default_request())) }) -test_that("make_default_request optionally attaches bearer token", { - clear_token_bundle() - set_token_bundle(access_token = "xyz", refresh_token = NULL) - req <- make_default_request(with_token = TRUE, refresh = FALSE, vb = FALSE) - headers <- req$headers - expect_equal(headers$Authorization, "Bearer xyz") - clear_token_bundle() -}) - -test_that("make_default_request errors when token missing", { - clear_token_bundle() - expect_error(make_default_request(with_token = TRUE, refresh = FALSE, vb = FALSE), - "No OAuth token available") +test_that("make_default_request can skip token", { + req <- make_default_request(with_token = FALSE) + expect_true("httr2_request" %in% class(req)) + expect_false("Authorization" %in% names(req$headers)) }) diff --git a/tests/testthat/test-make_login_client.R b/tests/testthat/test-make_login_client.R index 958ad82b..f18b3706 100644 --- a/tests/testthat/test-make_login_client.R +++ b/tests/testthat/test-make_login_client.R @@ -1,31 +1,31 @@ test_that("make_login_client rejects bad input parameters", { - # expect_error(make_login_client(email = -1)) - # expect_error(make_login_client(email = c("a", "b"))) - # expect_error(make_login_client(email = list("a", "b"))) - # expect_error(make_login_client(email = TRUE)) - # - # expect_error(make_login_client(password = -1)) - # expect_error(make_login_client(password = 3)) - # expect_error(make_login_client(password = list("a", "b"))) - # expect_error(make_login_client(password = TRUE)) - # - # expect_error(make_login_client(store = -1)) - # expect_error(make_login_client(store = 'a')) - # expect_error(make_login_client(store = list("a", "b"))) - # - # expect_error(make_login_client(overwrite = -1)) - # expect_error(make_login_client(overwrite = 'a')) - # expect_error(make_login_client(overwrite = list("a", "b"))) - + expect_error(make_login_client(email = -1, password = "pw")) + expect_error(make_login_client(email = c("a", "b"), password = "pw")) + expect_error(make_login_client(email = list("a", "b"), password = "pw")) + expect_error(make_login_client(email = TRUE, password = "pw")) + + expect_error(make_login_client(password = -1, email = "user@example.com")) + expect_error(make_login_client(password = 3, email = "user@example.com")) + expect_error(make_login_client(password = list("a", "b"), email = "user@example.com")) + expect_error(make_login_client(password = TRUE, email = "user@example.com")) + + expect_error(make_login_client(store = -1, email = "user@example.com", password = "pw")) + expect_error(make_login_client(store = "a", email = "user@example.com", password = "pw")) + expect_error(make_login_client(store = list("a", "b"), email = "user@example.com", password = "pw")) + + expect_error(make_login_client(overwrite = -1, email = "user@example.com", password = "pw")) + expect_error(make_login_client(overwrite = "a", email = "user@example.com", password = "pw")) + expect_error(make_login_client(overwrite = list("a", "b"), email = "user@example.com", password = "pw")) + expect_error(make_login_client(vb = -1)) expect_error(make_login_client(vb = 3)) expect_error(make_login_client(vb = "a")) - - # expect_error(make_login_client(SERVICE = -1)) - # expect_error(make_login_client(SERVICE = TRUE)) - # expect_error(make_login_client(SERVICE = list("a", "b"))) - # - # expect_error(make_login_client(rq = 3)) - # expect_error(make_login_client(rq = "a")) - # expect_error(make_login_client(rq = TRUE)) + + expect_error(make_login_client(SERVICE = -1, email = "user@example.com", password = "pw")) + expect_error(make_login_client(SERVICE = TRUE, email = "user@example.com", password = "pw")) + expect_error(make_login_client(SERVICE = list("a", "b"), email = "user@example.com", password = "pw")) + + expect_error(make_login_client(rq = 3, email = "user@example.com", password = "pw")) + expect_error(make_login_client(rq = "a", email = "user@example.com", password = "pw")) + expect_error(make_login_client(rq = TRUE, email = "user@example.com", password = "pw")) }) \ No newline at end of file diff --git a/tests/testthat/test-search_for_funder.R b/tests/testthat/test-search_for_funder.R index 8f7fbd80..f3d51d9c 100644 --- a/tests/testthat/test-search_for_funder.R +++ b/tests/testthat/test-search_for_funder.R @@ -1,9 +1,11 @@ # search_for_funder() --------------------------------------------------- -test_that("search_for_funder returns NULL or list", { - expect_true(( - is.null(search_for_funder()) || - "list" %in% class(search_for_funder()) - )) +login_test_account() +test_that("search_for_funder finds matching funder", { + result <- search_for_funder("National Science Foundation") + skip_if_null_response(result, "search_for_funder(\"National Science Foundation\")") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(any(grepl("National Science Foundation", result$funder_name, fixed = TRUE))) }) test_that("search_for_funder rejects bad input parameters", { diff --git a/tests/testthat/test-search_for_keywords.R b/tests/testthat/test-search_for_keywords.R deleted file mode 100644 index 95fed214..00000000 --- a/tests/testthat/test-search_for_keywords.R +++ /dev/null @@ -1,21 +0,0 @@ -# search_for_keywords() --------------------------------------------------- -test_that("search_for_keywords returns list", { - expect_true(class(search_for_keywords()) == "list") -}) - -test_that("search_for_keywords rejects bad input parameters", { - expect_error(search_for_keywords(search_string = -1)) - expect_error(search_for_keywords(search_string = 0)) - expect_error(search_for_keywords(search_string = list(a=1, b=2))) - expect_error(search_for_keywords(search_string = TRUE)) - - expect_error(search_for_keywords(vb = -1)) - expect_error(search_for_keywords(vb = 3)) - expect_error(search_for_keywords(vb = "a")) - expect_error(search_for_keywords(vb = list(a=1, b=2))) - - expect_error(search_for_keywords(rq = "a")) - expect_error(search_for_keywords(rq = -1)) - expect_error(search_for_keywords(rq = c(2,3))) - expect_error(search_for_keywords(rq = list(a=1, b=2))) -}) diff --git a/tests/testthat/test-search_for_tags.R b/tests/testthat/test-search_for_tags.R index 0691b906..af54cc01 100644 --- a/tests/testthat/test-search_for_tags.R +++ b/tests/testthat/test-search_for_tags.R @@ -1,6 +1,8 @@ # search_for_tags() --------------------------------------------------- -test_that("search_for_tags returns character", { - expect_true("character" %in% class(search_for_tags())) +test_that("search_for_tags returns tagged volumes", { + result <- search_for_tags("ICIS") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) }) test_that("search_for_tags rejects bad input parameters", { diff --git a/tests/testthat/test-search_institutions.R b/tests/testthat/test-search_institutions.R new file mode 100644 index 00000000..f6347f86 --- /dev/null +++ b/tests/testthat/test-search_institutions.R @@ -0,0 +1,17 @@ +# search_institutions --------------------------------------------------------- + +test_that("search_institutions returns tibble", { + login_test_account() + result <- search_institutions("state") + skip_if_null_response(result, "search_institutions('state')") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(all(c("institution_id", "score") %in% names(result))) +}) + +test_that("search_institutions rejects bad queries", { + expect_error(search_institutions(123)) + expect_error(search_institutions("term", vb = "yes")) +}) + + diff --git a/tests/testthat/test-search_users.R b/tests/testthat/test-search_users.R new file mode 100644 index 00000000..70813c60 --- /dev/null +++ b/tests/testthat/test-search_users.R @@ -0,0 +1,17 @@ +# search_users ---------------------------------------------------------------- + +test_that("search_users returns tibble", { + login_test_account() + result <- search_users("gilmore") + skip_if_null_response(result, "search_users('gilmore')") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(all(c("user_id", "score") %in% names(result))) +}) + +test_that("search_users rejects bad queries", { + expect_error(search_users(123)) + expect_error(search_users("term", vb = "yes")) +}) + + diff --git a/tests/testthat/test-search_volumes.R b/tests/testthat/test-search_volumes.R new file mode 100644 index 00000000..e59911f0 --- /dev/null +++ b/tests/testthat/test-search_volumes.R @@ -0,0 +1,17 @@ +# search_volumes -------------------------------------------------------------- + +test_that("search_volumes returns tibble", { + login_test_account() + result <- search_volumes("workshop") + skip_if_null_response(result, "search_volumes('workshop')") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(all(c("volume_id", "score") %in% names(result))) +}) + +test_that("search_volumes rejects bad queries", { + expect_error(search_volumes(123)) + expect_error(search_volumes("term", vb = "yes")) +}) + + diff --git a/tests/testthat/test-token_helpers.R b/tests/testthat/test-token_helpers.R new file mode 100644 index 00000000..29c01d1d --- /dev/null +++ b/tests/testthat/test-token_helpers.R @@ -0,0 +1,29 @@ +test_that("ensure_valid_token requires an existing bundle", { + databraryr:::clear_token_bundle() + expect_error(databraryr:::ensure_valid_token(), "No OAuth token available") +}) + +test_that("ensure_valid_token returns bundle when still valid", { + databraryr:::clear_token_bundle() + databraryr:::set_token_bundle(access_token = "still-valid", expires_in = NULL) + + bundle <- databraryr:::ensure_valid_token(refresh = TRUE) + expect_equal(bundle$access_token, "still-valid") +}) + +test_that("ensure_valid_token errors when refresh not permitted", { + databraryr:::clear_token_bundle() + databraryr:::set_token_bundle(access_token = "expiring", refresh_token = "refresh", expires_in = -120) + + expect_error(databraryr:::ensure_valid_token(refresh = FALSE), "refresh disabled") + databraryr:::clear_token_bundle() +}) + +test_that("ensure_valid_token errors when refresh token missing", { + databraryr:::clear_token_bundle() + databraryr:::set_token_bundle(access_token = "expiring", refresh_token = NULL, expires_in = -120) + + expect_error(databraryr:::ensure_valid_token(), "no refresh token available") + databraryr:::clear_token_bundle() +}) + diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 5c77bf54..d0da8d1b 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1,10 +1,27 @@ # get_file_duration --------------------------------------------------------- -test_that("get_file_duration returns an integer array", { - expect_true(class(get_file_duration()) == "integer") - expect_true(length(get_file_duration()) == 1) +test_that("get_file_duration returns duration metadata for a known asset", { + login_test_account() + result <- get_file_duration() + skip_if_null_response(result, "get_file_duration()") + expect_true(is.numeric(result) && length(result) == 1) + + asset_detail <- perform_api_get( + path = sprintf(API_SESSION_FILE_DETAIL, 2, 9, 2), + vb = FALSE + ) + expect_true("thumbnail_url" %in% names(asset_detail)) + expect_true(is.null(asset_detail$thumbnail_url) || nzchar(asset_detail$thumbnail_url)) }) test_that("get_file_duration rejects bad input parameters", { + expect_error(get_file_duration(vol_id = "a")) + expect_error(get_file_duration(vol_id = -1)) + expect_error(get_file_duration(vol_id = c(1, 3))) + + expect_error(get_file_duration(session_id = "a")) + expect_error(get_file_duration(session_id = -1)) + expect_error(get_file_duration(session_id = c(1, 3))) + expect_error(get_file_duration(asset_id = "a")) expect_error(get_file_duration(asset_id = -1)) expect_error(get_file_duration(asset_id = c(1, 3))) @@ -14,52 +31,28 @@ test_that("get_file_duration rejects bad input parameters", { expect_error(get_file_duration(vb = c(2, 3))) }) -# get_asset_segment_range ------------------------------------ -test_that("get_asset_segment_range returns an integer array", { - expect_true(class(get_asset_segment_range()) == "integer") - expect_true(length(get_asset_segment_range()) == 2) -}) - -test_that("get_asset_segment_range rejects bad input parameters", { - expect_error(get_asset_segment_range(vol_id = "a")) - expect_error(get_asset_segment_range(vol_id = -1)) - expect_error(get_asset_segment_range(vol_id = c(1, 3))) - - expect_error(get_asset_segment_range(session_id = "a")) - expect_error(get_asset_segment_range(session_id = -1)) - expect_error(get_asset_segment_range(session_id = c(1, 3))) - - expect_error(get_asset_segment_range(asset_id = "a")) - expect_error(get_asset_segment_range(asset_id = -1)) - expect_error(get_asset_segment_range(asset_id = c(1, 3))) - - expect_error(get_asset_segment_range(vb = "a")) - expect_error(get_asset_segment_range(vb = -1)) - expect_error(get_asset_segment_range(vb = c(2, 3))) -}) - # get_permission_levels ------------------------------------------------------- test_that("get_permission_levels returns a character array", { - expect_true(class(get_permission_levels()) == "character") - expect_true(length(get_permission_levels()) == 6) + levels <- get_permission_levels() + expect_true(is.character(levels)) + expect_true(length(levels) > 0) }) -test_that("get_permission_levels rejects bad input parameters", { - expect_error(get_permission_levels(vb = "a")) - expect_error(get_permission_levels(vb = -1)) - expect_error(get_permission_levels(vb = c(2, 3))) +test_that("get_permission_levels handles vb flag", { + expect_silent(get_permission_levels(vb = TRUE)) + expect_silent(get_permission_levels(vb = FALSE)) }) # get_release_levels --------------------------------------------------------- test_that("get_release_levels returns a character array", { - expect_true(class(get_release_levels()) == "character") - expect_true(length(get_release_levels()) == 4) + levels <- get_release_levels() + expect_true(is.character(levels)) + expect_true(length(levels) == 4) }) -test_that("get_release_levels rejects bad input parameters", { - expect_error(get_release_levels(vb = "a")) - expect_error(get_release_levels(vb = -1)) - expect_error(get_release_levels(vb = c(2, 3))) +test_that("get_release_levels handles vb flag", { + expect_silent(get_release_levels(vb = TRUE)) + expect_silent(get_release_levels(vb = FALSE)) }) # get_supported_file_types ---------------------------------------------------- @@ -86,30 +79,6 @@ test_that("HHMMSSmmm_to_ms rejects bad input parameters", { expect_error(HHMMSSmmm_to_ms(HHMMSSmmm = TRUE)) }) -# is_institution --------------------------------------------------- -test_that("is_institution returns logical", { - expect_true(class(is_institution()) == "logical") -}) - -test_that("is_institution rejects bad input parameters", { - expect_error(is_institution(party_id = -1)) - expect_error(is_institution(party_id = "a")) - expect_error(is_institution(party_id = list(a = 1, b = 2))) - expect_error(is_institution(party_id = TRUE)) -}) - -# is_person --------------------------------------------------- -test_that("is_person returns logical", { - expect_true(class(is_person()) == "logical") -}) - -test_that("is_person rejects bad input parameters", { - expect_error(is_person(party_id = -1)) - expect_error(is_person(party_id = "a")) - expect_error(is_person(party_id = list(a = 1, b = 2))) - expect_error(is_person(party_id = TRUE)) -}) - # make_fn_portable --------------------------------------------------- test_that("make_fn_portable returns string", { expect_true("character" %in% class(make_fn_portable("}*&!@#$%^+.pdf"))) diff --git a/tests/testthat/test-whoami.R b/tests/testthat/test-whoami.R index 21053784..173dde50 100644 --- a/tests/testthat/test-whoami.R +++ b/tests/testthat/test-whoami.R @@ -5,25 +5,14 @@ test_that("whoami returns NULL when unauthenticated", { test_that("whoami fetches user info", { clear_token_bundle() - set_token_bundle(access_token = "abc", refresh_token = NULL) + login_test_account() + on.exit(clear_token_bundle(), add = TRUE) - local_mocked_bindings( - req_perform = function(...) { - httr2::response( - method = "GET", - url = OAUTH_TEST_URL, - status_code = 200, - headers = list("Content-Type" = "application/json"), - body = charToRaw('{"auth_method":"password","user":{"id":1}}') - ) - }, - .package = "httr2" - ) + result <- whoami(refresh = TRUE, vb = FALSE) + skip_if_null_response(result, "whoami") - result <- whoami(refresh = FALSE, vb = FALSE) - - expect_equal(result$auth_method, "password") - expect_equal(result$user$id, 1) - clear_token_bundle() + expect_true(nzchar(result$message)) + expect_match(result$path, "oauth2/test") + expect_equal(result$authMethod, "OAuth2") }) diff --git a/vignettes/accessing-data.Rmd b/vignettes/accessing-data.Rmd index 0506ab6f..b5190ebf 100644 --- a/vignettes/accessing-data.Rmd +++ b/vignettes/accessing-data.Rmd @@ -132,44 +132,42 @@ vol1_assets |> Imagine you are interested in knowing more about this volume, the people who created it, or the agencies that funded it. -The `list_volume_owners()` function returns a data frame with information about the people who created and "own" this particular dataset. -The function has a parameter `this_vol_id` which is an integer, unique across Databrary, that refers to the specific dataset. -The `list_volume_owners()` function uses volume 1 as the default. +The `list_volume_collaborators()` function returns a data frame with information about the people who have been granted access to collaborate on this dataset. +The function has a parameter `vol_id` which is an integer, unique across Databrary, that refers to the specific dataset. +The `list_volume_collaborators()` function uses volume 1 as the default. ```{r} -databraryr::list_volume_owners() +databraryr::list_volume_collaborators() ``` The command (and many like it) can be "vectorized" using the `purrr` package. This let's us generate a tibble with the owners of the first fifteen volumes. ```{r} -purrr::map(1:15, databraryr::list_volume_owners) |> +purrr::map(1:15, databraryr::list_volume_collaborators) |> purrr::list_rbind() ``` -As of 0.6.0, the `get_volume_by_id()` returns a list of all data about a volume that is accessible to a particular user. +As of 0.6.0, the `get_volume_by_id()` function returns a tibble summarising all data about a volume that is accessible to a particular user. The default is volume 1. ```{r} vol1_list <- databraryr::get_volume_by_id() -names(vol1_list) +vol1_list ``` Let's create our own tibble/data frame with a subset of these variables. ```{r} -vol1_df <- tibble::tibble(id = vol1_list$id, - name = vol1_list$name, - doi = vol1_list$creation, - permission = vol1_list$permission) +vol1_df <- vol1_list |> + dplyr::select(id, title, sharing_level, access_level) vol1_df ``` -The `permission` variable indicates whether a volume is visible by you, and if so with what privileges. +The `access_level` variable indicates whether a volume is visible to you, and if so with what privileges. So, if you are not logged-in to Databrary, only data that are visible to the public will be returned. -Assuming you are *not* logged-in, the above commands will show volumes with `permission` equal to 1. -The `permission` field derives from a set of constants the system uses. +Assuming you are *not* logged-in, the above commands will show volumes with `access_level` equal to 1. +The `access_level` field derives from a set of constants the system uses. ```{r} db_constants <- databraryr::assign_constants() @@ -180,7 +178,7 @@ The `permission` array is indexed beginning with 0. So the 1th (1st) value is "`r db_constants$permission[2]`". So, the `1` means that the volumes shown above are all visible to the public, and to you. -Volumes that you have not shared and are not visible to the public, will have `permission` equal to 5, or "`r db_constants$permission[6]`". +Volumes that you have not shared and are not visible to the public, will have `access_level` equal to 5, or "`r db_constants$permission[6]`". We can't demonstrate this to you because we don't have privileges on the same unshared volume, but you can try it on a volume you've created but not yet shared. Other functions with the form `list_volume_*()` provide information about Databrary volumes. @@ -197,7 +195,7 @@ The `list_volume_links()` command returns information about any external (web) l databraryr::list_volume_links() ``` -There's much more to learn about accessing Databrary information using `databraryr`, but this should get you started. +There's much more to learn about accessing Databrary information using `databraryr`, but this should get you started. Explore `list_volumes()` to enumerate accessible datasets or `search_volumes()` to find projects matching a keyword. ## Downloading multiple files diff --git a/vignettes/databrary.Rmd b/vignettes/databrary.Rmd index 8fedbbc6..72a077f8 100644 --- a/vignettes/databrary.Rmd +++ b/vignettes/databrary.Rmd @@ -59,34 +59,31 @@ library(databraryr) Then, try this command to pull data about one of Databrary's founders: -```{r get_party_by_id} -# The default parameter settings return a very detailed set of information about -# a party that we do not need for this example. -party_6 <- databraryr::get_party_by_id(parents_children_access = FALSE) +```{r get_user_by_id} +# Retrieve public metadata about one of Databrary's founders. +user_6 <- databraryr::get_user_by_id(user_id = 6) -party_6 |> - as.data.frame() +tibble::as_tibble(user_6) ``` -Note that this command returns a data frame with columns that include the first name (`prename`), last name (`sortname`), affiliation, lab or personal website, and ORCID ID if available. +Note that this command returns a tibble with columns that include the first name (`prename`), last name (`sortname`), affiliation, and ORCID ID if available. -Databrary assigns a unique integer for each person and institution on the system called a 'party id'. +Databrary assigns a unique integer for each registered user on the system. We can create a simple helper function to collect information about a larger group of people. ```{r list-people-5-7} # Helper function -get_party_as_df <- function(party_id) { - this_party <- databraryr::get_party_by_id(party_id, - parents_children_access = FALSE) - if (!is.null(this_party)) { - as.data.frame(this_party) +get_user_as_df <- function(user_id) { + this_user <- databraryr::get_user_by_id(user_id = user_id) + if (!is.null(this_user)) { + tibble::as_tibble(this_user) } else { NULL } } -# Party's 5, 6, and 7 are Databrary's founders -purrr::map(5:7, get_party_as_df, .progress = TRUE) |> +# Users 5, 6, and 7 are Databrary's founders +purrr::map(5:7, get_user_as_df, .progress = TRUE) |> purrr::list_rbind() ``` From 1f6cf4d8b888868e544319d1058a8f235271e685 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Wed, 12 Nov 2025 11:35:45 +0100 Subject: [PATCH 03/77] Added and adjsuted functions for downloading folder/session assets, CSVs and ZIPs. --- NAMESPACE | 4 + R/CONSTANTS.R | 2 + R/download_folder_asset.R | 127 ++++++++ R/download_folder_assets_fr_df.R | 114 ++++++++ R/download_folder_zip.R | 54 ++++ R/download_session_asset.R | 220 ++++++-------- R/download_session_assets_fr_df.R | 111 ++++--- R/download_session_csv.R | 115 +++----- R/download_session_zip.R | 116 ++------ R/download_single_folder_asset_fr_df.R | 150 ++++++++++ R/download_single_session_asset_fr_df.R | 272 ++++++------------ R/download_utils.R | 101 +++++++ R/download_video.R | 134 +++------ R/download_volume_zip.R | 107 ++----- R/list_folder_assets.R | 1 + R/list_session_assets.R | 1 + man/download_folder_asset.Rd | 57 ++++ man/download_folder_assets_fr_df.Rd | 58 ++++ man/download_folder_zip.Rd | 41 +++ man/download_session_asset.Rd | 43 +-- man/download_session_assets_fr_df.Rd | 44 ++- man/download_session_csv.Rd | 38 ++- man/download_session_zip.Rd | 25 +- man/download_single_folder_asset_fr_df.Rd | 47 +++ man/download_single_session_asset_fr_df.Rd | 52 +--- man/download_video.Rd | 33 ++- man/download_volume_zip.Rd | 29 +- tests/testthat/test-download_folder_asset.R | 70 +++++ .../test-download_folder_assets_fr_df.R | 65 +++++ tests/testthat/test-download_folder_zip.R | 41 +++ tests/testthat/test-download_session_asset.R | 34 ++- .../test-download_session_assets_fr_df.R | 84 +++--- tests/testthat/test-download_session_csv.R | 57 +++- tests/testthat/test-download_session_zip.R | 41 +-- .../test-download_single_folder_asset_fr_df.R | 79 +++++ ...test-download_single_session_asset_fr_df.R | 89 +++--- tests/testthat/test-download_video.R | 44 +-- tests/testthat/test-download_volume_zip.R | 34 ++- 38 files changed, 1703 insertions(+), 1031 deletions(-) create mode 100644 R/download_folder_asset.R create mode 100644 R/download_folder_assets_fr_df.R create mode 100644 R/download_folder_zip.R create mode 100644 R/download_single_folder_asset_fr_df.R create mode 100644 R/download_utils.R create mode 100644 man/download_folder_asset.Rd create mode 100644 man/download_folder_assets_fr_df.Rd create mode 100644 man/download_folder_zip.Rd create mode 100644 man/download_single_folder_asset_fr_df.Rd create mode 100644 tests/testthat/test-download_folder_asset.R create mode 100644 tests/testthat/test-download_folder_assets_fr_df.R create mode 100644 tests/testthat/test-download_folder_zip.R create mode 100644 tests/testthat/test-download_single_folder_asset_fr_df.R diff --git a/NAMESPACE b/NAMESPACE index 613ec1a0..765a14b6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,10 +4,14 @@ export("%>%") export(HHMMSSmmm_to_ms) export(assign_constants) export(check_ssl_certs) +export(download_folder_asset) +export(download_folder_assets_fr_df) +export(download_folder_zip) export(download_session_asset) export(download_session_assets_fr_df) export(download_session_csv) export(download_session_zip) +export(download_single_folder_asset_fr_df) export(download_single_session_asset_fr_df) export(download_video) export(download_volume_zip) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 000da2ed..f6d676be 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -32,6 +32,8 @@ API_SESSION_DOWNLOAD_LINK <- "/volumes/%s/sessions/%s/download-link/" API_SESSION_CSV_DOWNLOAD_LINK <- "/volumes/%s/sessions/%s/csv-download-link/" API_FOLDER_DETAIL <- "/volumes/%s/folders/%s/" API_FOLDER_FILES <- "/volumes/%s/folders/%s/files/" +API_FOLDER_DOWNLOAD_LINK <- "/volumes/%s/folders/%s/download-link/" +API_FOLDER_FILE_DOWNLOAD_LINK <- "/volumes/%s/folders/%s/files/%s/download-link/" API_VOLUME_DOWNLOAD_LINK <- "/volumes/%s/download-link/" API_VOLUME_CSV_DOWNLOAD_LINK <- "/volumes/%s/csv-download-link/" API_SEARCH_VOLUMES <- "/search/volumes/" diff --git a/R/download_folder_asset.R b/R/download_folder_asset.R new file mode 100644 index 00000000..9ad295d2 --- /dev/null +++ b/R/download_folder_asset.R @@ -0,0 +1,127 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Download a Folder Asset via Signed Link. +#' +#' @description +#' Databrary serves folder-scoped assets through signed URLs. This helper +#' requests the signed link for a folder asset and streams the file to the +#' specified directory. +#' +#' @param vol_id Integer. Volume identifier containing the folder. Default is 1. +#' @param folder_id Integer. Folder identifier within the volume. Default is 1. +#' @param asset_id Integer. Asset identifier within the folder. Default is 1. +#' @param file_name Optional character string. File name to use when saving the +#' asset. Defaults to the API-provided file name. +#' @param target_dir Character string. Directory where the file will be saved. +#' Default is `tempdir()`. +#' @param rq An `httr2` request object. Default is `NULL`, in which case a +#' default authenticated request is generated. +#' @param timeout_secs Numeric. Timeout (seconds) applied to the download +#' request. Default is `REQUEST_TIMEOUT`. +#' +#' @returns The path to the downloaded file (character string) or `NULL` if the +#' download fails. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' download_folder_asset() # Default public asset in folder 1 of volume 1 +#' download_folder_asset(vol_id = 1, folder_id = 2, asset_id = 3, +#' file_name = "example.mp4") +#' } +#' } +#' +#' @export +download_folder_asset <- function(vol_id = 1, + folder_id = 1, + asset_id = 1, + file_name = NULL, + target_dir = tempdir(), + timeout_secs = REQUEST_TIMEOUT, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id >= 1) + + assertthat::assert_that(length(folder_id) == 1) + assertthat::assert_that(is.numeric(folder_id)) + assertthat::assert_that(folder_id >= 1) + + assertthat::assert_that(length(asset_id) == 1) + assertthat::assert_that(is.numeric(asset_id)) + assertthat::assert_that(asset_id >= 1) + + if (!is.null(file_name)) { + assertthat::assert_that(length(file_name) == 1) + assertthat::assert_that(is.character(file_name)) + } + + assertthat::assert_that(length(target_dir) == 1) + assertthat::assert_that(is.character(target_dir)) + assertthat::assert_that(dir.exists(target_dir)) + + assertthat::is.number(timeout_secs) + assertthat::assert_that(length(timeout_secs) == 1) + assertthat::assert_that(timeout_secs > 0) + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) + + path <- sprintf(API_FOLDER_FILE_DOWNLOAD_LINK, vol_id, folder_id, asset_id) + link <- request_signed_download_link(path = path, rq = rq, vb = vb) + + if (is.null(link)) { + return(NULL) + } + + resolved_name <- if (!is.null(file_name)) { + file_name + } else if (!is.null(link$file_name)) { + link$file_name + } else { + paste0( + folder_id, + "-", + asset_id, + "-", + format(Sys.time(), "%F-%H%M-%S"), + ".bin" + ) + } + + dest_path <- file.path(target_dir, resolved_name) + + if (file.exists(dest_path)) { + dest_path <- file.path( + target_dir, + paste0( + tools::file_path_sans_ext(resolved_name), + "-", + format(Sys.time(), "%F-%H%M-%S"), + ifelse( + nzchar(tools::file_ext(resolved_name)), + paste0(".", tools::file_ext(resolved_name)), + "" + ) + ) + ) + } + + download_signed_file( + download_url = link$download_url, + dest_path = dest_path, + timeout_secs = timeout_secs, + vb = vb + ) +} + + + diff --git a/R/download_folder_assets_fr_df.R b/R/download_folder_assets_fr_df.R new file mode 100644 index 00000000..ae1ef3de --- /dev/null +++ b/R/download_folder_assets_fr_df.R @@ -0,0 +1,114 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Download Multiple Assets From a Folder Data Frame. +#' +#' @description +#' Iterates over a data frame of folder assets, requesting signed download links +#' for each asset and saving them to disk. Designed to work with +#' `list_folder_assets()` output. +#' +#' @param folder_df Data frame describing assets. Must include `vol_id`, +#' `folder_id`, `asset_id`, and `asset_name` columns. +#' @param target_dir Character string. Base directory for downloads. Defaults to +#' `tempdir()`. +#' @param add_folder_subdir Logical. When `TRUE`, creates a subdirectory per +#' folder inside `target_dir`. +#' @param overwrite Logical. When `FALSE`, the function aborts if the target +#' directory already exists. +#' @param make_portable_fn Logical. When `TRUE`, filenames are sanitized via +#' `make_fn_portable()`. +#' @param timeout_secs Numeric. Timeout applied to each download request. +#' @param rq An optional `httr2` request object reused when requesting signed +#' links. +#' +#' @returns Character vector of downloaded file paths or `NULL` if the request +#' fails before any downloads start. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' assets <- list_folder_assets(folder_id = 1, vol_id = 1) +#' download_folder_assets_fr_df(assets, vb = TRUE) +#' } +#' } +#' +#' @export +download_folder_assets_fr_df <- + function(folder_df = list_folder_assets(vol_id = 1), + target_dir = tempdir(), + add_folder_subdir = TRUE, + overwrite = TRUE, + make_portable_fn = FALSE, + timeout_secs = REQUEST_TIMEOUT_VERY_LONG, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(is.data.frame(folder_df)) + required_cols <- c("vol_id", "folder_id", "asset_id", "asset_name") + missing_cols <- setdiff(required_cols, names(folder_df)) + if (length(missing_cols) > 0) { + stop( + "folder_df is missing required columns: ", + paste(missing_cols, collapse = ", "), + call. = FALSE + ) + } + + assertthat::assert_that(length(target_dir) == 1) + assertthat::assert_that(is.character(target_dir)) + if (dir.exists(target_dir)) { + if (!overwrite) { + if (vb) { + message("`overwrite` is FALSE. Cannot continue.") + } + return(NULL) + } + } else { + dir.create(target_dir, recursive = TRUE, showWarnings = FALSE) + } + assertthat::is.writeable(target_dir) + + assertthat::assert_that(length(add_folder_subdir) == 1) + assertthat::assert_that(is.logical(add_folder_subdir)) + + assertthat::assert_that(length(overwrite) == 1) + assertthat::assert_that(is.logical(overwrite)) + + assertthat::assert_that(length(make_portable_fn) == 1) + assertthat::assert_that(is.logical(make_portable_fn)) + + assertthat::is.number(timeout_secs) + assertthat::assert_that(length(timeout_secs) == 1) + assertthat::assert_that(timeout_secs > 0) + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) + + if (vb) { + message("Downloading n=", nrow(folder_df), " files to ", target_dir) + } + + purrr::map( + seq_len(nrow(folder_df)), + download_single_folder_asset_fr_df, + folder_df = folder_df, + target_dir = target_dir, + add_folder_subdir = add_folder_subdir, + overwrite = overwrite, + make_portable_fn = make_portable_fn, + timeout_secs = timeout_secs, + vb = vb, + rq = rq, + .progress = vb + ) |> + purrr::list_c() + } + + + diff --git a/R/download_folder_zip.R b/R/download_folder_zip.R new file mode 100644 index 00000000..4323306b --- /dev/null +++ b/R/download_folder_zip.R @@ -0,0 +1,54 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Request a Signed ZIP Download for a Folder. +#' +#' @description +#' Folder-level ZIP archives are prepared asynchronously by the Django API. +#' Calling `download_folder_zip()` queues the job and returns a processing task +#' descriptor. When the archive is ready, Databrary emails a signed download +#' link to the authenticated user. +#' +#' @param vol_id Volume identifier for the folder. +#' @param folder_id Folder identifier scoped within the specified volume. +#' @param rq An `httr2` request object. Default is `NULL`, in which case a +#' default authenticated request is generated. +#' +#' @returns A list describing the processing task (`status`, `message`, +#' `task_id`) or `NULL` when the request fails. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' download_folder_zip(vol_id = 1, folder_id = 1) +#' } +#' } +#' +#' @export +download_folder_zip <- function(vol_id = 1, + folder_id = 1, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id >= 1) + + assertthat::assert_that(length(folder_id) == 1) + assertthat::assert_that(is.numeric(folder_id)) + assertthat::assert_that(folder_id >= 1) + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) + + path <- sprintf(API_FOLDER_DOWNLOAD_LINK, vol_id, folder_id) + request_processing_task(path = path, rq = rq, vb = vb) +} + + + diff --git a/R/download_session_asset.R b/R/download_session_asset.R index 87000398..89217ea6 100644 --- a/R/download_session_asset.R +++ b/R/download_session_asset.R @@ -3,175 +3,121 @@ #' NULL -#' Download Asset From Databrary. +#' Download an Asset via Signed Link. #' -#' @description Databrary stores file types (assets) of many types. This -#' function downloads an asset based on its system-unique integer identifer -#' (asset_id) and system-unique session (slot) identifier (session_id). +#' @description +#' Databrary serves assets through short-lived, signed URLs. This helper +#' requests the signed link for a session asset and streams the file to the +#' requested directory. #' -#' @param asset_id An integer. Asset id for target file. Default is 1. -#' @param session_id An integer. Slot/session number where target file is -#' stored. Default is 9807. -#' @param file_name A character string. Name for downloaded file. Default is NULL. +#' @param vol_id Integer. Volume identifier. Default is 1. +#' @param session_id Integer. Session identifier. Default is 9807. +#' @param asset_id Integer. Asset identifier within the session. Default is 1. +#' @param file_name Optional character string. Target file name. Defaults to the +#' API-provided file name. +#' @param target_dir Character string. Directory where the file will be saved. +#' Default is `tempdir()`. +#' @param rq An `httr2` request object. Default is `NULL`, in which case a +#' default authenticated request is generated. +#' @param timeout_secs Numeric. Timeout (seconds) applied to the download +#' request. Default is `REQUEST_TIMEOUT`. #' -#' @param target_dir A character string. Directory to save the downloaded file. -#' Default is a temporary directory given by a call to `tempdir()`. -#' @param rq A list in the form of an `httr2` request object. Default is NULL. -#' @param timeout_secs An integer constant. The default value, defined in -#' CONSTANTS.R is REQUEST_TIMEOUT. This value determines the default timeout -#' value for the httr2 request object. When downloading large files, it can be -#' useful to set this value to a large number. -#' -#' @returns Full file name to the asset or NULL. +#' @returns The path to the downloaded file (character string) or `NULL` if the +#' download fails. #' #' @inheritParams options_params #' #' @examples #' \donttest{ #' \dontrun{ -#' download_session_asset() # Download's 'numbers' file from volume 1. -#' download_session_asset(asset_id = 11643, session_id = 9825, file_name = "rdk.mp4") -#' # Downloads a display with a random dot kinematogram (RDK). +#' download_session_asset() # Default public asset in volume 1 +#' download_session_asset(vol_id = 1, session_id = 9825, asset_id = 11643, +#' file_name = "rdk.mp4") #' } #' } #' @export -download_session_asset <- function(asset_id = 1, +download_session_asset <- function(vol_id = 1, session_id = 9807, + asset_id = 1, file_name = NULL, - #target_dir = paste0("./", session_id), target_dir = tempdir(), timeout_secs = REQUEST_TIMEOUT, vb = options::opt("vb"), rq = NULL) { - # Check parameters + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id >= 1) + + assertthat::assert_that(length(session_id) == 1) + assertthat::assert_that(is.numeric(session_id)) + assertthat::assert_that(session_id >= 1) + assertthat::assert_that(length(asset_id) == 1) assertthat::assert_that(is.numeric(asset_id)) assertthat::assert_that(asset_id >= 1) - - assertthat::assert_that(is.numeric(session_id)) - assertthat::assert_that(length(session_id) == 1) - assertthat::assert_that(session_id >= 1) - - assertthat::assert_that(is.character(target_dir)) + + if (!is.null(file_name)) { + assertthat::assert_that(length(file_name) == 1) + assertthat::assert_that(is.character(file_name)) + } + assertthat::assert_that(length(target_dir) == 1) + assertthat::assert_that(is.character(target_dir)) assertthat::assert_that(dir.exists(target_dir)) - + assertthat::is.number(timeout_secs) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - # Handle NULL rq - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() + + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) + + path <- sprintf(API_FILES_DOWNLOAD_LINK, vol_id, session_id, asset_id) + link <- request_signed_download_link(path = path, rq = rq, vb = vb) + + if (is.null(link)) { + return(NULL) } - - this_rq <- rq %>% - httr2::req_url(sprintf(DOWNLOAD_FILE, session_id, asset_id)) %>% - httr2::req_progress() - - if (vb) - message( - "Attempting to download file with asset_id ", - asset_id, - " from session_id ", + + resolved_name <- if (!is.null(file_name)) { + file_name + } else if (!is.null(link$file_name)) { + link$file_name + } else { + paste0( session_id, - "." + "-", + asset_id, + "-", + format(Sys.time(), "%F-%H%M-%S"), + ".bin" ) - - resp <- tryCatch( - httr2::req_perform(this_rq), - httr2_error = function(cnd) { - if (vb) - message( - "Error downloading file with asset_id ", - asset_id, - " from session_id ", - session_id, - "." - ) - NULL - } - - ) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } - - # Gather asset format info - format_mimetype <- NULL - format_extension <- NULL - this_file_extension <- list_asset_formats(vb = vb) %>% - dplyr::filter(httr2::resp_content_type(resp) == format_mimetype) %>% - dplyr::select(format_extension) %>% - as.character() - - # Check file name or generate - if (is.null(this_file_extension)) { - if (vb) - message("No matching file extension for ", - httr2::resp_content_type(resp)) - return(NULL) - } - - if (is.null(file_name)) { - if (vb) - message("Missing file name, creating temporary file name.") - file_name <- tempfile(paste0(session_id, "_", asset_id, "_"), - fileext = paste0(".", this_file_extension)) } - assertthat::is.string(file_name) - - if (file.exists(file_name)) { - if (vb) - message("File exists. Generating new unique name.\n") - file_name <- file.path(dirname(file_name), - paste0( - session_id, - "-", - asset_id, - "-", - format(Sys.time(), "%F-%H%M-%S"), - paste0(".", this_file_extension) - )) - } - - if (!(this_file_extension == xfun::file_ext(file_name))) { - if (vb) - message("File name ", - file_name, - " doesn't match extension ", - this_file_extension) - return(NULL) + + dest_path <- file.path(target_dir, resolved_name) + + if (file.exists(dest_path)) { + dest_path <- file.path( + target_dir, + paste0( + tools::file_path_sans_ext(resolved_name), + "-", + format(Sys.time(), "%F-%H%M-%S"), + ifelse( + nzchar(tools::file_ext(resolved_name)), + paste0(".", tools::file_ext(resolved_name)), + "" + ) + ) + ) } - - write_file <- tryCatch( - error = function(cnd) { - if (vb) - message("Failure writing file ", file_name) - NULL - }, - { - file_con <- file(file_name, "wb") - writeBin(resp$body, file_con) - close(file_con) - } + + download_signed_file( + download_url = link$download_url, + dest_path = dest_path, + timeout_secs = timeout_secs, + vb = vb ) - - if (!is.null(write_file)) { - file_name - } else { - write_file - } } diff --git a/R/download_session_assets_fr_df.R b/R/download_session_assets_fr_df.R index 4e2c1bdf..b34b5fcb 100644 --- a/R/download_session_assets_fr_df.R +++ b/R/download_session_assets_fr_df.R @@ -3,38 +3,37 @@ #' NULL -#' Download Asset From A Databrary Session. +#' Download Multiple Assets From a Session Data Frame. #' -#' @description Databrary stores file types (assets) of many types. This -#' function downloads assets in a data frame generated by list_session_assets(). +#' @description +#' Iterates over a data frame of session assets, requesting signed download +#' links for each asset and saving them to disk. Designed to work with +#' `list_session_assets()` or `list_volume_session_assets()` output. #' -#' @param session_df A data frame as generated by list_session_assets_2(). -#' @param target_dir A character string. Directory to save the downloaded file. -#' Default is directory named after the session_id. -#' @param add_session_subdir A logical value. Add add the session name to the -#' file path so that files are in a subdirectory specific to the session. Default -#' is TRUE. -#' @param overwrite A logical value. Overwrite an existing file. Default is TRUE. -#' @param make_portable_fn A logical value. Replace characters in file names -#' that are not broadly portable across file systems. Default is FALSE. -#' @param timeout_secs An integer. The seconds an httr2 request will run before -#' timing out. Default is 600 (10 min). This is to handle very large files. -#' @param rq A list in the form of an `httr2` request object. Default is NULL. +#' @param session_df Data frame describing assets. Must include `vol_id`, +#' `session_id`, `asset_id`, and `asset_name` columns. +#' @param target_dir Character string. Base directory for downloads. Defaults to +#' `tempdir()`. +#' @param add_session_subdir Logical. When `TRUE`, creates a subdirectory per +#' session inside `target_dir`. +#' @param overwrite Logical. When `FALSE`, the function aborts if the target +#' directory already exists. +#' @param make_portable_fn Logical. When `TRUE`, filenames are sanitized via +#' `make_fn_portable()`. +#' @param timeout_secs Numeric. Timeout applied to each download request. +#' @param rq An optional `httr2` request object reused when requesting signed +#' links. #' -#' @returns Full file names to the downloaded assets or NULL. +#' @returns Character vector of downloaded file paths or `NULL` if the request +#' fails before any downloads start. #' #' @inheritParams options_params #' #' @examples #' \donttest{ #' \dontrun{ -#' download_session_assets_fr_df() # Downloads all of the files from session -#' 9807 in Databrary volume 1. -#' -#' # Just the CSVs -#' v1 <- list_session_assets() -#' v1_csv <- dplyr::filter(v1, format_extension == "csv") -#' download_session_assets_fr_df(v1_csv, vb = TRUE) +#' assets <- list_session_assets(vol_id = 1, session_id = 9807) +#' download_session_assets_fr_df(assets, vb = TRUE) #' } #' } #' @export @@ -47,61 +46,57 @@ download_session_assets_fr_df <- timeout_secs = REQUEST_TIMEOUT_VERY_LONG, vb = options::opt("vb"), rq = NULL) { - # Check parameters assertthat::assert_that(is.data.frame(session_df)) - assertthat::assert_that("session_id" %in% names(session_df)) - assertthat::assert_that("session_id" %in% names(session_df)) - assertthat::assert_that("asset_id" %in% names(session_df)) - assertthat::assert_that("format_extension" %in% names(session_df)) - assertthat::assert_that("asset_name" %in% names(session_df)) - + required_cols <- c("vol_id", "session_id", "asset_id", "asset_name") + missing_cols <- setdiff(required_cols, names(session_df)) + if (length(missing_cols) > 0) { + stop( + "session_df is missing required columns: ", + paste(missing_cols, collapse = ", "), + call. = FALSE + ) + } + assertthat::assert_that(length(target_dir) == 1) assertthat::assert_that(is.character(target_dir)) - if (!dir.exists(target_dir)) { - if (vb) { - message("Target directory not found: ", target_dir) - message("Creating: ", target_dir) - } - dir.create(target_dir, recursive = TRUE) - } else { - if (vb) - message("Target directory exists: ", target_dir) - if (overwrite) { - if (vb) - message("`overwrite` is TRUE. Overwriting directory: ", target_dir) - } else { - if (vb) + if (dir.exists(target_dir)) { + if (!overwrite) { + if (vb) { message("`overwrite` is FALSE. Cannot continue.") + } return(NULL) } + } else { + dir.create(target_dir, recursive = TRUE, showWarnings = FALSE) } assertthat::is.writeable(target_dir) - + assertthat::assert_that(length(add_session_subdir) == 1) assertthat::assert_that(is.logical(add_session_subdir)) - + assertthat::assert_that(length(overwrite) == 1) assertthat::assert_that(is.logical(overwrite)) - + assertthat::assert_that(length(make_portable_fn) == 1) assertthat::assert_that(is.logical(make_portable_fn)) - + assertthat::is.number(timeout_secs) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - if (vb) - message("Downloading n=", dim(session_df)[1], " files to /", target_dir) + + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) + + if (vb) { + message("Downloading n=", nrow(session_df), " files to ", target_dir) + } + purrr::map( - 1:dim(session_df)[1], + seq_len(nrow(session_df)), download_single_session_asset_fr_df, - session_df, + session_df = session_df, target_dir = target_dir, add_session_subdir = add_session_subdir, overwrite = overwrite, @@ -109,7 +104,7 @@ download_session_assets_fr_df <- timeout_secs = timeout_secs, vb = vb, rq = rq, - .progress = TRUE + .progress = vb ) |> purrr::list_c() } diff --git a/R/download_session_csv.R b/R/download_session_csv.R index 84dd9240..87e6f400 100644 --- a/R/download_session_csv.R +++ b/R/download_session_csv.R @@ -3,108 +3,61 @@ #' NULL -#' Download Session Spreadsheet As CSV +#' Request a Session or Volume CSV Export. #' -#' @description Databrary generates a CSV-formated spreadsheet that summarizes -#' information about individual sessions. This command downloads that CSV file -#' as a temporary file or with a name specified by the user. +#' @description +#' The Django API generates CSV reports asynchronously. This function queues a +#' CSV export for a specific session when `session_id` is supplied, or for the +#' entire volume when `session_id` is `NULL`. The API delivers the final signed +#' download link via email once the export is ready. #' -#' @param vol_id An integer. Target volume number. Default is 1. -#' @param file_name A character string. Name for the output file. -#' Default is 'test.csv'. -#' @param target_dir A character string. Directory to save downloaded file. -#' Default is `tempdir()`. -#' @param as_df A logical value. Convert the data from a list to a data frame. -#' Default is FALSE. -#' @param rq An `httr2` request object. Default is NULL. +#' @param vol_id Integer. Target volume identifier. Default is 1. +#' @param session_id Optional integer. When provided, requests a session-level +#' CSV export. When `NULL`, a volume-level CSV export is requested. +#' @param rq An `httr2` request object. Default is `NULL`, meaning a default +#' authenticated request is generated. #' -#' @returns A character string that is the name of the downloaded file or a -#' data frame if `as_df` is TRUE. +#' @returns A list describing the processing task (`status`, `message`, +#' `task_id`) or `NULL` if the request fails. #' #' @inheritParams options_params #' #' @examples #' \donttest{ #' \dontrun{ -#' download_session_csv() # Downloads "session" CSV for volume 1 +#' # Request a volume-wide CSV export +#' download_session_csv(vol_id = 1) +#' +#' # Request a session-specific CSV export +#' download_session_csv(vol_id = 1, session_id = 9807) #' } #' } #' #' @export download_session_csv <- function(vol_id = 1, - file_name = "test.csv", - target_dir = tempdir(), - as_df = FALSE, + session_id = NULL, vb = options::opt("vb"), rq = NULL) { - # Check parameters assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - - assertthat::assert_that(length(file_name) == 1) - assertthat::assert_that(is.character(file_name)) - - assertthat::assert_that(length(target_dir) == 1) - assertthat::assert_that(is.character(target_dir)) - - assertthat::assert_that(length(as_df) == 1) - assertthat::assert_that(is.logical(as_df)) - + + if (!is.null(session_id)) { + assertthat::assert_that(length(session_id) == 1) + assertthat::assert_that(is.numeric(session_id)) + assertthat::assert_that(session_id >= 1) + } + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - # Handle NULL request - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - this_rq <- rq %>% - httr2::req_url(sprintf(GET_SESSION_CSV, vol_id)) - - if (vb) - message(paste0("Downloading spreadsheet from vol_id ", vol_id, '.')) - resp <- tryCatch( - httr2::req_perform(this_rq), - httr2_error = function(cnd) { - if (vb) - message("Error retrieving spreadsheet from vol_id ", vol_id, ".") - NULL - } - ) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } - - if (vb) - message("Valid CSV downloaded from ", sprintf(GET_SESSION_CSV, vol_id)) - - resp_txt <- httr2::resp_body_string(resp) - df <- - readr::read_csv( - resp_txt, - show_col_types = FALSE, - col_types = readr::cols(.default = readr::col_character()) - ) %>% - # Replace dashes in column names with underscores - dplyr::rename_with( ~ gsub("-", "_", .x, fixed = TRUE)) - if (as_df == TRUE) { - df + + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) + + path <- if (is.null(session_id)) { + sprintf(API_VOLUME_CSV_DOWNLOAD_LINK, vol_id) } else { - if (vb) - message("Saving CSV.") - assertthat::is.writeable(target_dir) - full_fn <- file.path(target_dir, file_name) - assertthat::is.string(full_fn) - readr::write_csv(df, full_fn) - full_fn + sprintf(API_SESSION_CSV_DOWNLOAD_LINK, vol_id, session_id) } + + request_processing_task(path = path, rq = rq, vb = vb) } diff --git a/R/download_session_zip.R b/R/download_session_zip.R index 18f9a44b..440a1be3 100644 --- a/R/download_session_zip.R +++ b/R/download_session_zip.R @@ -3,125 +3,49 @@ #' NULL -#' Download Zip Archive From Databrary Session. +#' Request a Signed ZIP Download for a Session. #' -#' @param vol_id Volume number. -#' @param session_id Slot/session number. -#' @param out_dir Directory to save output file. -#' @param file_name Name for downloaded file, default is 'test.zip'. -#' @param rq An `httr2` request object. Default is NULL. +#' @description +#' The Django API prepares session-level ZIP archives asynchronously. Calling +#' `download_session_zip()` triggers the job and returns a processing task +#' summary. Once the archive is ready, Databrary emails a signed download link +#' to the authenticated user. #' -#' @returns Full filename of the downloaded file. +#' @param vol_id Volume identifier that owns the session. +#' @param session_id Session identifier within the volume. +#' @param rq An `httr2` request object. Default is `NULL`, in which case a +#' default authenticated request is generated. +#' +#' @returns A list describing the processing task (`status`, `message`, +#' `task_id`) or `NULL` when the request fails. #' #' @inheritParams options_params #' #' @examples #' \donttest{ #' \dontrun{ -#' download_session_zip() # Downloads Zip Archive from volume 31, session 9803 +#' download_session_zip(vol_id = 31, session_id = 9803) #' } #' } #' #' @export download_session_zip <- function(vol_id = 31, session_id = 9803, - out_dir = tempdir(), - file_name = "test.zip", vb = options::opt("vb"), rq = NULL) { - # Check parameters assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) - - assertthat::assert_that(length(out_dir) == 1) - assertthat::assert_that(is.character(out_dir)) - - assertthat::assert_that(length(file_name) == 1) - assertthat::assert_that(is.character(file_name)) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - rq <- rq %>% - httr2::req_url(sprintf(GET_SESSION_ZIP, vol_id, session_id)) - - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) { - if (vb) - message("Error downloading zip from sprintf(GET_SESSION_ZIP, vol_id, - session_id)") - NULL - } - ) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(NULL) - } - - bin <- NULL - bin <- httr2::resp_body_raw(resp) - - if (is.null(bin)) { - if (vb) - message("Null file returned") - return(NULL) - } - - if (file_name == "test.zip") { - if (vb) { - if (vb) - message("File name unspecified. Generating unique name.") - } - file_name <- make_zip_fn_sess(out_dir, vol_id, session_id) - } - if (vb) { - if (vb) - message(paste0("Downloading zip file as: \n'", file_name, "'.")) - } - writeBin(bin, file_name) - file_name -} -#------------------------------------------------------------------------------- -make_zip_fn_sess <- function(out_dir, vol_id, session_id) { - # Check parameters - assertthat::is.string(out_dir) - assertthat::is.writeable(out_dir) - assertthat::assert_that(length(out_dir) == 1) - - assertthat::assert_that(length(vol_id) == 1) - assertthat::assert_that(is.numeric(vol_id)) - assertthat::assert_that(vol_id >= 1) - - assertthat::assert_that(length(session_id) == 1) - assertthat::assert_that(is.numeric(session_id)) - assertthat::assert_that(session_id >= 1) - - paste0( - out_dir, - "/vol-", - vol_id, - "-sess-", - session_id, - "-", - format(Sys.time(), "%F-%H%M-%S"), - ".zip" - ) + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) + + path <- sprintf(API_SESSION_DOWNLOAD_LINK, vol_id, session_id) + request_processing_task(path = path, rq = rq, vb = vb) } diff --git a/R/download_single_folder_asset_fr_df.R b/R/download_single_folder_asset_fr_df.R new file mode 100644 index 00000000..807c5945 --- /dev/null +++ b/R/download_single_folder_asset_fr_df.R @@ -0,0 +1,150 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Download a Single Folder Asset From a Data Frame Row. +#' +#' @description +#' Helper used by `download_folder_assets_fr_df()` to fetch a single asset via +#' the signed-download workflow. +#' +#' @param i Integer. Index of the asset within `folder_df`. +#' @param folder_df Data frame containing folder asset metadata. +#' @param target_dir Base directory for downloads. +#' @param add_folder_subdir Logical. When `TRUE`, creates a subdirectory per +#' folder inside `target_dir`. +#' @param overwrite Logical. When `FALSE`, existing files are saved with a +#' timestamped suffix. +#' @param make_portable_fn Logical. When `TRUE`, filenames are sanitized via +#' `make_fn_portable()`. +#' @param timeout_secs Numeric. Timeout applied to the signed download request. +#' @param rq Optional `httr2` request object reused to request signed links. +#' +#' @returns Path to the downloaded asset or `NULL` if the download fails. +#' +#' @inheritParams options_params +#' +#' @export +download_single_folder_asset_fr_df <- function(i = NULL, + folder_df = NULL, + target_dir = tempdir(), + add_folder_subdir = TRUE, + overwrite = TRUE, + make_portable_fn = FALSE, + timeout_secs = REQUEST_TIMEOUT_VERY_LONG, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(length(i) == 1) + assertthat::is.number(i) + assertthat::assert_that(i > 0) + + assertthat::assert_that(is.data.frame(folder_df)) + required_cols <- c("vol_id", "folder_id", "asset_id", "asset_name") + missing_cols <- setdiff(required_cols, names(folder_df)) + if (length(missing_cols) > 0) { + stop( + "folder_df is missing required columns: ", + paste(missing_cols, collapse = ", "), + call. = FALSE + ) + } + + assertthat::assert_that(length(target_dir) == 1) + assertthat::is.string(target_dir) + assertthat::assert_that(dir.exists(target_dir) || dir.create(target_dir, recursive = TRUE, showWarnings = FALSE)) + assertthat::is.writeable(target_dir) + + assertthat::assert_that(length(add_folder_subdir) == 1) + assertthat::assert_that(is.logical(add_folder_subdir)) + + assertthat::assert_that(length(overwrite) == 1) + assertthat::assert_that(is.logical(overwrite)) + + assertthat::assert_that(length(make_portable_fn) == 1) + assertthat::assert_that(is.logical(make_portable_fn)) + + assertthat::is.number(timeout_secs) + assertthat::assert_that(length(timeout_secs) == 1) + assertthat::assert_that(timeout_secs > 0) + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) + + this_asset <- folder_df[i, , drop = FALSE] + if (nrow(this_asset) == 0) { + if (vb) { + message("No asset for index ", i) + } + return(NULL) + } + + dest_dir <- if (isTRUE(add_folder_subdir)) { + file.path(target_dir, this_asset$folder_id) + } else { + target_dir + } + dir.create(dest_dir, recursive = TRUE, showWarnings = FALSE) + assertthat::assert_that(dir.exists(dest_dir)) + assertthat::is.writeable(dest_dir) + + base_name <- this_asset$asset_name + if (is.null(base_name) || is.na(base_name) || base_name == "") { + base_name <- paste0("asset-", this_asset$asset_id) + } + + extension <- "" + if ("format_extension" %in% names(this_asset)) { + ext_value <- this_asset$format_extension + if (!is.null(ext_value) && !is.na(ext_value) && nzchar(ext_value)) { + if (tools::file_ext(base_name) != ext_value) { + extension <- paste0(".", ext_value) + } + } + } + + candidate_name <- paste0(base_name, extension) + + if (make_portable_fn) { + if (vb) { + message("Making file name '", candidate_name, "' portable.") + } + candidate_name <- make_fn_portable(candidate_name, vb = vb) + } + + dest_file <- file.path(dest_dir, candidate_name) + if (file.exists(dest_file) && !overwrite) { + if (vb) { + message("Generating new unique (time-stamped) file name.") + } + candidate_name <- paste0( + this_asset$folder_id, + "-", + this_asset$asset_id, + "-", + format(Sys.time(), "%F-%H%M-%S"), + ifelse( + nzchar(tools::file_ext(candidate_name)), + paste0(".", tools::file_ext(candidate_name)), + "" + ) + ) + dest_file <- file.path(dest_dir, candidate_name) + } + + download_folder_asset( + vol_id = this_asset$vol_id, + folder_id = this_asset$folder_id, + asset_id = this_asset$asset_id, + file_name = candidate_name, + target_dir = dest_dir, + timeout_secs = timeout_secs, + vb = vb, + rq = rq + ) +} + + + diff --git a/R/download_single_session_asset_fr_df.R b/R/download_single_session_asset_fr_df.R index 8ace4fec..ce4fe68a 100644 --- a/R/download_single_session_asset_fr_df.R +++ b/R/download_single_session_asset_fr_df.R @@ -3,48 +3,28 @@ #' NULL -#' Download Single Asset From Databrary +#' Download a Single Asset From a Session Data Frame Row. #' -#' @description Databrary stores file types (assets) of many types. This -#' function downloads an asset based on its system-unique integer identifer -#' (asset_id) and system-unique session (slot) identifier (session_id). It -#' is designed to work with download_session_assets_fr_df() so that multiple -#' files can be downloaded simultaneously. +#' @description +#' Helper used by `download_session_assets_fr_df()` to fetch a single asset via +#' the signed-download workflow. #' -#' @param i An integer. Index into a row of the session asset data frame. -#' Default is NULL. -#' @param session_df A row from a data frame from `list_session_assets()` -#' or `list_volume_assets()`. Default is NULL> -#' @param target_dir A character string. Directory to save the downloaded file. -#' Default is a temporary directory given by a call to `tempdir()`. -#' @param add_session_subdir A logical value. Add add the session name to the -#' file path so that files are in a subdirectory specific to the session. Default -#' is TRUE. -#' @param overwrite A logical value. Overwrite an existing file. Default is TRUE. -#' @param make_portable_fn A logical value. Replace characters in file names -#' that are not broadly portable across file systems. Default is FALSE. -#' @param timeout_secs An integer. The seconds an httr2 request will run before -#' timing out. Default is 600 (10 min). This is to handle very large files. -#' @param rq A list in the form of an `httr2` request object. Default is NULL. +#' @param i Integer. Index of the asset within `session_df`. +#' @param session_df Data frame containing asset metadata. +#' @param target_dir Base directory for downloads. +#' @param add_session_subdir Logical. When `TRUE`, creates a subdirectory per +#' session inside `target_dir`. +#' @param overwrite Logical. When `FALSE`, existing files are saved with a +#' timestamped suffix. +#' @param make_portable_fn Logical. When `TRUE`, filenames are sanitized via +#' `make_fn_portable()`. +#' @param timeout_secs Numeric. Timeout applied to the signed download request. +#' @param rq Optional `httr2` request object reused to request signed links. #' -#' @returns Full file name to the asset or NULL. -#' -#' @inheritParams options_params +#' @returns Path to the downloaded asset or `NULL` if the download fails. #' -#' @examples -#' \donttest{ -#' \dontrun{ -#' vol_1 <- list_session_assets(session_id = 9807) -#' a_1 <- vol_1[1,] -#' tmp_dir <- tempdir() -#' fn <- file.path(tmp_dir, paste0(a_1$asset_name, ".", a_1$format_extension)) -#' download_single_session_asset_fr_df(a_1$asset_id, -#' fn, -#' session_id = a_1$session_id, -#' vb = TRUE) +#' @inheritParams options_params #' -#' } -#' } #' @export download_single_session_asset_fr_df <- function(i = NULL, session_df = NULL, @@ -55,183 +35,113 @@ download_single_session_asset_fr_df <- function(i = NULL, timeout_secs = REQUEST_TIMEOUT_VERY_LONG, vb = options::opt("vb"), rq = NULL) { - # Check parameters assertthat::assert_that(length(i) == 1) assertthat::is.number(i) assertthat::assert_that(i > 0) - + assertthat::assert_that(is.data.frame(session_df)) - assertthat::assert_that("session_id" %in% names(session_df)) - assertthat::assert_that("asset_id" %in% names(session_df)) - assertthat::assert_that("format_extension" %in% names(session_df)) - assertthat::assert_that("asset_name" %in% names(session_df)) - + required_cols <- c("vol_id", "session_id", "asset_id", "asset_name") + missing_cols <- setdiff(required_cols, names(session_df)) + if (length(missing_cols) > 0) { + stop( + "session_df is missing required columns: ", + paste(missing_cols, collapse = ", "), + call. = FALSE + ) + } + assertthat::assert_that(length(target_dir) == 1) assertthat::is.string(target_dir) + assertthat::assert_that(dir.exists(target_dir) || dir.create(target_dir, recursive = TRUE, showWarnings = FALSE)) assertthat::is.writeable(target_dir) - + assertthat::assert_that(length(add_session_subdir) == 1) assertthat::assert_that(is.logical(add_session_subdir)) - + assertthat::assert_that(length(overwrite) == 1) assertthat::assert_that(is.logical(overwrite)) - + assertthat::assert_that(length(make_portable_fn) == 1) assertthat::assert_that(is.logical(make_portable_fn)) - + assertthat::is.number(timeout_secs) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - this_asset <- session_df[i, ] - if (is.null(this_asset)) { - if (vb) + + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) + + this_asset <- session_df[i, , drop = FALSE] + if (nrow(this_asset) == 0) { + if (vb) { message("No asset for index ", i) + } return(NULL) } - - if (add_session_subdir) { - full_fn <- file.path( - target_dir, - this_asset$session_id, - paste0(this_asset$asset_name, ".", this_asset$format_extension) - ) - if (vb) - message("`add_session_subdir` is TRUE.") + + dest_dir <- if (isTRUE(add_session_subdir)) { + file.path(target_dir, this_asset$session_id) } else { - full_fn <- file.path(target_dir, - paste0(this_asset$asset_name, ".", this_asset$format_extension)) - if (vb) - message("`add_session_subdir` is FALSE.") + target_dir } - - if (file.exists(full_fn)) { - if (vb) - message("File exists: ", full_fn) - if (!overwrite) { - if (vb) - message("Generating new unique (time-stamped) file name.") - full_fn <- file.path( - dirname(full_fn), - paste0( - this_asset$session_id, - "-", - this_asset$asset_id, - "-", - format(Sys.time(), "%F-%H%M-%S"), - paste0(".", this_asset$format_extension) - ) - ) - } else { - if (vb) - message("Will overwrite existing file.") + dir.create(dest_dir, recursive = TRUE, showWarnings = FALSE) + assertthat::assert_that(dir.exists(dest_dir)) + assertthat::is.writeable(dest_dir) + + base_name <- this_asset$asset_name + if (is.null(base_name) || is.na(base_name) || base_name == "") { + base_name <- paste0("asset-", this_asset$asset_id) + } + + extension <- "" + if ("format_extension" %in% names(this_asset)) { + ext_value <- this_asset$format_extension + if (!is.null(ext_value) && !is.na(ext_value) && nzchar(ext_value)) { + if (tools::file_ext(base_name) != ext_value) { + extension <- paste0(".", ext_value) + } } } - + + candidate_name <- paste0(base_name, extension) + if (make_portable_fn) { - if (vb) - message("Making file name '", full_fn, "' portable.") - full_fn <- make_fn_portable(full_fn, vb = vb) - } - assertthat::is.string(full_fn) - - if (!dir.exists(dirname(full_fn))) { if (vb) { - message("Target directory not found: ", dirname(full_fn)) - message("Creating: ", dirname(full_fn)) - } - dir.create(dirname(full_fn), recursive = TRUE) - } else { - if (vb) - message("Target directory exists: ", dirname(full_fn)) - if (overwrite) { - if (vb) - message("Overwriting directory: ", dirname(full_fn)) - } else { - if (vb) - message("`overwrite` is FALSE. Skipping.") - return(NULL) + message("Making file name '", candidate_name, "' portable.") } + candidate_name <- make_fn_portable(candidate_name, vb = vb) } - assertthat::is.writeable(dirname(full_fn)) - - # Handle NULL rq - if (is.null(rq)) { + + dest_file <- file.path(dest_dir, candidate_name) + if (file.exists(dest_file) && !overwrite) { if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") + message("Generating new unique (time-stamped) file name.") } - rq <- databraryr::make_default_request() - } - - if (vb) - message( - "Downloading file with asset_id ", + candidate_name <- paste0( + this_asset$session_id, + "-", this_asset$asset_id, - " from session_id ", - this_asset$session_id + "-", + format(Sys.time(), "%F-%H%M-%S"), + ifelse( + nzchar(tools::file_ext(candidate_name)), + paste0(".", tools::file_ext(candidate_name)), + "" + ) ) - - # Up default timeout for possibly big files - rq <- - httr2::req_timeout(rq, seconds = timeout_secs) - - this_rq <- rq %>% - httr2::req_url(sprintf(DOWNLOAD_FILE, this_asset$session_id, this_asset$asset_id)) %>% - httr2::req_progress() - - resp <- tryCatch( - httr2::req_perform(this_rq), - httr2_error = function(cnd) - if (vb) - message( - "Error downloading asset ", - this_asset$asset_name, - " from session_id ", - this_asset$session_id - ), - NULL - ) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) + dest_file <- file.path(dest_dir, candidate_name) } - - # if (is.null(resp)) { - # if (vb) - # message( - # "Download request for session ", - # this_asset$session_id, - # " asset ", - # this_asset$asset_id, - # " returned NULL. Skipping." - # ) - # return(NULL) - # } - - write_file <- tryCatch( - error = function(cnd) { - if (vb) - message("Failure writing file ", full_fn) - NULL - }, - { - file_con <- file(full_fn, "wb") - writeBin(resp$body, file_con) - close(file_con) - } + + download_session_asset( + vol_id = this_asset$vol_id, + session_id = this_asset$session_id, + asset_id = this_asset$asset_id, + file_name = candidate_name, + target_dir = dest_dir, + timeout_secs = timeout_secs, + vb = vb, + rq = rq ) - - if (!is.null(write_file)) { - full_fn - } else { - write_file - } } diff --git a/R/download_utils.R b/R/download_utils.R new file mode 100644 index 00000000..caea1b26 --- /dev/null +++ b/R/download_utils.R @@ -0,0 +1,101 @@ +# Internal helpers for the Django signed-download workflow. + +#' @noRd +request_processing_task <- function(path, rq = NULL, vb = FALSE) { + task <- perform_api_get( + path = path, + rq = rq, + vb = vb, + normalize = TRUE + ) + + if (is.null(task)) { + if (vb) { + message("Cannot access requested resource on Databrary. Exiting.") + } + return(NULL) + } + + if (vb && !is.null(task$message)) { + message(task$message) + } + + class(task) <- unique(c("databrary_processing_task", class(task))) + task +} + +#' @noRd +request_signed_download_link <- function(path, rq = NULL, vb = FALSE) { + link <- perform_api_get( + path = path, + rq = rq, + vb = vb, + normalize = TRUE + ) + + if (is.null(link)) { + if (vb) { + message("Cannot access requested resource on Databrary. Exiting.") + } + return(NULL) + } + + if (is.null(link$download_url)) { + if (vb) { + message("Download link payload missing 'download_url'.") + } + return(NULL) + } + + link$download_url <- ensure_absolute_url(link$download_url) + class(link) <- unique(c("databrary_signed_download", class(link))) + link +} + +#' @noRd +ensure_absolute_url <- function(url) { + assertthat::assert_that(assertthat::is.string(url)) + if (startsWith(url, "http://") || startsWith(url, "https://")) { + return(url) + } + paste0(DATABRARY_BASE_URL, ensure_leading_slash(url)) +} + +#' @noRd +download_signed_file <- function(download_url, + dest_path, + timeout_secs = REQUEST_TIMEOUT_VERY_LONG, + vb = FALSE) { + assertthat::assert_that(assertthat::is.string(download_url)) + assertthat::assert_that(assertthat::is.string(dest_path)) + assertthat::is.number(timeout_secs) + assertthat::assert_that(timeout_secs > 0) + + parent_dir <- dirname(dest_path) + if (!dir.exists(parent_dir)) { + dir.create(parent_dir, recursive = TRUE, showWarnings = FALSE) + } + assertthat::is.writeable(parent_dir) + + req <- httr2::request(download_url) | + httr2::req_timeout(seconds = timeout_secs) + + if (vb) { + message("Saving download to '", dest_path, "'.") + } + + tryCatch( + { + httr2::req_perform(req, path = dest_path) + dest_path + }, + httr2_error = function(cnd) { + if (vb) { + message("Download failed: ", conditionMessage(cnd)) + } + NULL + } + ) +} + + diff --git a/R/download_video.R b/R/download_video.R index d2a17118..8e24daec 100644 --- a/R/download_video.R +++ b/R/download_video.R @@ -3,119 +3,77 @@ #' NULL -#' Download Video From Databrary. +#' Download a Video Asset via Signed URL. #' -#' @param asset_id Asset id for target file. -#' @param session_id Slot/session number where target file is stored. -#' @param file_name Name for downloaded file. -#' @param target_dir Directory to save the downloaded file. -#' Default is a temporary directory given by a call to `tempdir()`. -#' @param rq An `httr2` request object. +#' @param vol_id Volume identifier containing the session. +#' @param session_id Session identifier containing the asset. +#' @param asset_id Asset identifier for the video file. +#' @param file_name Optional explicit file name. Defaults to the API-provided +#' value. +#' @param target_dir Directory to save the downloaded file. Defaults to +#' `tempdir()`. +#' @param rq Optional `httr2` request object reused when requesting the signed +#' link. #' -#' @returns Full file name to the asset. +#' @returns Path to the downloaded video or `NULL` on failure. #' #' @inheritParams options_params #' #' @examples #' \donttest{ #' \dontrun{ -#' download_video() # Download's 'numbers' file from volume 1. -#' download_video(asset_id = 11643, session_id = 9825, file_name = "rdk.mp4") -#' #' # Downloads a display with a random dot kinematogram (RDK). +#' download_video() # Default public video from volume 1 +#' download_video(vol_id = 1, session_id = 9825, asset_id = 11643, +#' file_name = "rdk.mp4") #' } #' } #' #' @export -download_video <- function(asset_id = 1, +download_video <- function(vol_id = 1, session_id = 9807, - file_name = tempfile(paste0(session_id, "_", - asset_id, "_"), - fileext = ".mp4"), + asset_id = 1, + file_name = NULL, target_dir = tempdir(), vb = options::opt("vb"), rq = NULL) { - # Check parameters assertthat::assert_that(length(asset_id) == 1) assertthat::assert_that(is.numeric(asset_id)) assertthat::assert_that(asset_id >= 1) - + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) - - assertthat::assert_that(length(file_name) == 1) - assertthat::assert_that(is.character(file_name)) - + + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id >= 1) + + if (!is.null(file_name)) { + assertthat::assert_that(length(file_name) == 1) + assertthat::assert_that(is.character(file_name)) + if (!endsWith(tolower(file_name), ".mp4")) { + stop("file_name must end with '.mp4' when provided.", call. = FALSE) + } + } + assertthat::assert_that(length(target_dir) == 1) assertthat::assert_that(is.character(target_dir)) - assertthat::assert_that(dir.exists(target_dir)) - + assertthat::assert_that(dir.exists(target_dir) || dir.create(target_dir, recursive = TRUE, showWarnings = FALSE)) + assertthat::is.writeable(target_dir) + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - - this_rq <- rq %>% - httr2::req_url(sprintf(DOWNLOAD_FILE, session_id, asset_id)) %>% - httr2::req_progress() - - if (file.exists(file_name)) { - if (vb) - message("File exists. Generating new unique name.\n") - file_name <- file.path(tempdir(), - paste0( - session_id, - "-", - asset_id, - "-", - format(Sys.time(), "%F-%H%M-%S"), - ".mp4" - )) - } - - if (vb) - message("Attempting to download video with asset_id ", - asset_id, - " from session_id ", - session_id) - - resp <- tryCatch( - httr2::req_perform(this_rq), - httr2_error = function(cnd) { - if (vb) - message( - message( - "Error retrieving video with asset_id ", - asset_id, - " from session_id ", - session_id - ) - ) - NULL - } + + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) + + download_session_asset( + vol_id = vol_id, + session_id = session_id, + asset_id = asset_id, + file_name = file_name, + target_dir = target_dir, + vb = vb, + rq = rq, + timeout_secs = REQUEST_TIMEOUT_VERY_LONG ) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } - - if (httr2::resp_content_type(resp) == "video/mp4") { - file_con <- file(file_name, "wb") - writeBin(resp$body, file_con) - close(file_con) - file_name - } else { - message("Content type is ", httr2::resp_content_type(resp)) - NULL - } } diff --git a/R/download_volume_zip.R b/R/download_volume_zip.R index a8bfcf19..8d44338c 100644 --- a/R/download_volume_zip.R +++ b/R/download_volume_zip.R @@ -3,112 +3,43 @@ #' NULL -#' Download Zip Archive of All Data in a Volume. +#' Request a Signed ZIP Download for a Volume. #' -#' @param vol_id Volume number. -#' @param out_dir Directory to save output file. -#' @param file_name Name for downloaded file, default is 'test.mp4'. -#' @param rq An `httr2` request object. Default is NULL. +#' @description +#' Volume-level ZIP archives are prepared asynchronously by the Django API. +#' Calling `download_volume_zip()` queues the job and returns a processing task +#' descriptor. When the archive is ready, Databrary emails a signed download +#' link to the authenticated user. +#' +#' @param vol_id Volume identifier. +#' @param rq An `httr2` request object. Default is `NULL`, in which case a +#' default authenticated request is generated. +#' +#' @returns A list describing the processing task (`status`, `message`, +#' `task_id`) or `NULL` when the request fails. #' -#' @returns Full filename of the downloaded file. -#' #' @inheritParams options_params -#' +#' #' @examples #' \donttest{ #' \dontrun{ -#' download_volume_zip() # Zip file of all data from volume 31, the default. +#' download_volume_zip(vol_id = 31) #' } #' } #' #' @export download_volume_zip <- function(vol_id = 31, - out_dir = tempdir(), - file_name = "test.zip", vb = options::opt("vb"), rq = NULL) { - # Check parameters assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - - assertthat::assert_that(length(out_dir) == 1) - assertthat::assert_that(is.character(out_dir)) - - assertthat::assert_that(length(file_name) == 1) - assertthat::assert_that(is.character(file_name)) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - # Handle NULL request - if (is.null(rq)) { - if (vb) { - message("\nNULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - rq <- rq %>% - httr2::req_url(sprintf(GET_VOLUME_ZIP, vol_id)) - - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) { - if (vb) message("Error downloading zip archive from vol_id ", vol_id) - NULL - } - ) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } - - bin <- NULL - bin <- httr2::resp_body_raw(resp) - if (is.null(bin)) { - if (vb) message("Null file returned") - return(NULL) - } - - if (file_name == "test.zip") { - if (vb) { - if (vb) - message("File name unspecified. Generating unique name.") - } - file_name <- make_zip_fn_vol(out_dir, vol_id) - } - if (vb) { - if (vb) - message(paste0("Downloading zip file as: \n'", file_name, "'.")) - } - writeBin(bin, file_name) - file_name -} + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) -#------------------------------------------------------------------------------- -make_zip_fn_vol <- function(out_dir, vol_id) { - - # Check parameters - assertthat::is.string(out_dir) - assertthat::is.writeable(out_dir) - assertthat::assert_that(length(out_dir) == 1) - - assertthat::assert_that(length(vol_id) == 1) - assertthat::assert_that(is.numeric(vol_id)) - assertthat::assert_that(vol_id >= 1) - - paste0( - out_dir, - "/vol-", - vol_id, - "-", - format(Sys.time(), "%F-%H%M-%S"), - ".zip" - ) + path <- sprintf(API_VOLUME_DOWNLOAD_LINK, vol_id) + request_processing_task(path = path, rq = rq, vb = vb) } diff --git a/R/list_folder_assets.R b/R/list_folder_assets.R index b701f33c..ccbac127 100644 --- a/R/list_folder_assets.R +++ b/R/list_folder_assets.R @@ -79,6 +79,7 @@ list_folder_assets <- function(folder_id = 1, asset_mime_type = format$mimetype, asset_format_id = format$id, asset_format_name = format$name, + format_extension = format$extension, asset_duration = file$duration, asset_created_at = file$created_at, asset_updated_at = file$updated_at, diff --git a/R/list_session_assets.R b/R/list_session_assets.R index dc24c69a..270658ec 100644 --- a/R/list_session_assets.R +++ b/R/list_session_assets.R @@ -84,6 +84,7 @@ list_session_assets <- function(session_id = 9807, asset_mime_type = format$mimetype, asset_format_id = format$id, asset_format_name = format$name, + format_extension = format$extension, asset_duration = file$duration, asset_created_at = file$created_at, asset_updated_at = file$updated_at, diff --git a/man/download_folder_asset.Rd b/man/download_folder_asset.Rd new file mode 100644 index 00000000..5c6e01ac --- /dev/null +++ b/man/download_folder_asset.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/download_folder_asset.R +\name{download_folder_asset} +\alias{download_folder_asset} +\title{Download a Folder Asset via Signed Link.} +\usage{ +download_folder_asset( + vol_id = 1, + folder_id = 1, + asset_id = 1, + file_name = NULL, + target_dir = tempdir(), + timeout_secs = REQUEST_TIMEOUT, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Integer. Volume identifier containing the folder. Default is 1.} + +\item{folder_id}{Integer. Folder identifier within the volume. Default is 1.} + +\item{asset_id}{Integer. Asset identifier within the folder. Default is 1.} + +\item{file_name}{Optional character string. File name to use when saving the +asset. Defaults to the API-provided file name.} + +\item{target_dir}{Character string. Directory where the file will be saved. +Default is \code{tempdir()}.} + +\item{timeout_secs}{Numeric. Timeout (seconds) applied to the download +request. Default is \code{REQUEST_TIMEOUT}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Default is \code{NULL}, in which case a +default authenticated request is generated.} +} +\value{ +The path to the downloaded file (character string) or \code{NULL} if the +download fails. +} +\description{ +Databrary serves folder-scoped assets through signed URLs. This helper +requests the signed link for a folder asset and streams the file to the +specified directory. +} +\examples{ +\donttest{ +\dontrun{ +download_folder_asset() # Default public asset in folder 1 of volume 1 +download_folder_asset(vol_id = 1, folder_id = 2, asset_id = 3, + file_name = "example.mp4") +} +} + +} diff --git a/man/download_folder_assets_fr_df.Rd b/man/download_folder_assets_fr_df.Rd new file mode 100644 index 00000000..73992878 --- /dev/null +++ b/man/download_folder_assets_fr_df.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/download_folder_assets_fr_df.R +\name{download_folder_assets_fr_df} +\alias{download_folder_assets_fr_df} +\title{Download Multiple Assets From a Folder Data Frame.} +\usage{ +download_folder_assets_fr_df( + folder_df = list_folder_assets(vol_id = 1), + target_dir = tempdir(), + add_folder_subdir = TRUE, + overwrite = TRUE, + make_portable_fn = FALSE, + timeout_secs = REQUEST_TIMEOUT_VERY_LONG, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{folder_df}{Data frame describing assets. Must include \code{vol_id}, +\code{folder_id}, \code{asset_id}, and \code{asset_name} columns.} + +\item{target_dir}{Character string. Base directory for downloads. Defaults to +\code{tempdir()}.} + +\item{add_folder_subdir}{Logical. When \code{TRUE}, creates a subdirectory per +folder inside \code{target_dir}.} + +\item{overwrite}{Logical. When \code{FALSE}, the function aborts if the target +directory already exists.} + +\item{make_portable_fn}{Logical. When \code{TRUE}, filenames are sanitized via +\code{make_fn_portable()}.} + +\item{timeout_secs}{Numeric. Timeout applied to each download request.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An optional \code{httr2} request object reused when requesting signed +links.} +} +\value{ +Character vector of downloaded file paths or \code{NULL} if the request +fails before any downloads start. +} +\description{ +Iterates over a data frame of folder assets, requesting signed download links +for each asset and saving them to disk. Designed to work with +\code{list_folder_assets()} output. +} +\examples{ +\donttest{ +\dontrun{ +assets <- list_folder_assets(folder_id = 1, vol_id = 1) +download_folder_assets_fr_df(assets, vb = TRUE) +} +} + +} diff --git a/man/download_folder_zip.Rd b/man/download_folder_zip.Rd new file mode 100644 index 00000000..84e1714a --- /dev/null +++ b/man/download_folder_zip.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/download_folder_zip.R +\name{download_folder_zip} +\alias{download_folder_zip} +\title{Request a Signed ZIP Download for a Folder.} +\usage{ +download_folder_zip( + vol_id = 1, + folder_id = 1, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Volume identifier for the folder.} + +\item{folder_id}{Folder identifier scoped within the specified volume.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Default is \code{NULL}, in which case a +default authenticated request is generated.} +} +\value{ +A list describing the processing task (\code{status}, \code{message}, +\code{task_id}) or \code{NULL} when the request fails. +} +\description{ +Folder-level ZIP archives are prepared asynchronously by the Django API. +Calling \code{download_folder_zip()} queues the job and returns a processing task +descriptor. When the archive is ready, Databrary emails a signed download +link to the authenticated user. +} +\examples{ +\donttest{ +\dontrun{ +download_folder_zip(vol_id = 1, folder_id = 1) +} +} + +} diff --git a/man/download_session_asset.Rd b/man/download_session_asset.Rd index 2c95e5a8..5f6369ba 100644 --- a/man/download_session_asset.Rd +++ b/man/download_session_asset.Rd @@ -2,11 +2,12 @@ % Please edit documentation in R/download_session_asset.R \name{download_session_asset} \alias{download_session_asset} -\title{Download Asset From Databrary.} +\title{Download an Asset via Signed Link.} \usage{ download_session_asset( - asset_id = 1, + vol_id = 1, session_id = 9807, + asset_id = 1, file_name = NULL, target_dir = tempdir(), timeout_secs = REQUEST_TIMEOUT, @@ -15,39 +16,41 @@ download_session_asset( ) } \arguments{ -\item{asset_id}{An integer. Asset id for target file. Default is 1.} +\item{vol_id}{Integer. Volume identifier. Default is 1.} + +\item{session_id}{Integer. Session identifier. Default is 9807.} -\item{session_id}{An integer. Slot/session number where target file is -stored. Default is 9807.} +\item{asset_id}{Integer. Asset identifier within the session. Default is 1.} -\item{file_name}{A character string. Name for downloaded file. Default is NULL.} +\item{file_name}{Optional character string. Target file name. Defaults to the +API-provided file name.} -\item{target_dir}{A character string. Directory to save the downloaded file. -Default is a temporary directory given by a call to \code{tempdir()}.} +\item{target_dir}{Character string. Directory where the file will be saved. +Default is \code{tempdir()}.} -\item{timeout_secs}{An integer constant. The default value, defined in -CONSTANTS.R is REQUEST_TIMEOUT. This value determines the default timeout -value for the httr2 request object. When downloading large files, it can be -useful to set this value to a large number.} +\item{timeout_secs}{Numeric. Timeout (seconds) applied to the download +request. Default is \code{REQUEST_TIMEOUT}.} \item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} -\item{rq}{A list in the form of an \code{httr2} request object. Default is NULL.} +\item{rq}{An \code{httr2} request object. Default is \code{NULL}, in which case a +default authenticated request is generated.} } \value{ -Full file name to the asset or NULL. +The path to the downloaded file (character string) or \code{NULL} if the +download fails. } \description{ -Databrary stores file types (assets) of many types. This -function downloads an asset based on its system-unique integer identifer -(asset_id) and system-unique session (slot) identifier (session_id). +Databrary serves assets through short-lived, signed URLs. This helper +requests the signed link for a session asset and streams the file to the +requested directory. } \examples{ \donttest{ \dontrun{ -download_session_asset() # Download's 'numbers' file from volume 1. -download_session_asset(asset_id = 11643, session_id = 9825, file_name = "rdk.mp4") -# Downloads a display with a random dot kinematogram (RDK). +download_session_asset() # Default public asset in volume 1 +download_session_asset(vol_id = 1, session_id = 9825, asset_id = 11643, + file_name = "rdk.mp4") } } } diff --git a/man/download_session_assets_fr_df.Rd b/man/download_session_assets_fr_df.Rd index f9548650..48c7b46f 100644 --- a/man/download_session_assets_fr_df.Rd +++ b/man/download_session_assets_fr_df.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/download_session_assets_fr_df.R \name{download_session_assets_fr_df} \alias{download_session_assets_fr_df} -\title{Download Asset From A Databrary Session.} +\title{Download Multiple Assets From a Session Data Frame.} \usage{ download_session_assets_fr_df( session_df = list_session_assets(), @@ -16,44 +16,42 @@ download_session_assets_fr_df( ) } \arguments{ -\item{session_df}{A data frame as generated by list_session_assets_2().} +\item{session_df}{Data frame describing assets. Must include \code{vol_id}, +\code{session_id}, \code{asset_id}, and \code{asset_name} columns.} -\item{target_dir}{A character string. Directory to save the downloaded file. -Default is directory named after the session_id.} +\item{target_dir}{Character string. Base directory for downloads. Defaults to +\code{tempdir()}.} -\item{add_session_subdir}{A logical value. Add add the session name to the -file path so that files are in a subdirectory specific to the session. Default -is TRUE.} +\item{add_session_subdir}{Logical. When \code{TRUE}, creates a subdirectory per +session inside \code{target_dir}.} -\item{overwrite}{A logical value. Overwrite an existing file. Default is TRUE.} +\item{overwrite}{Logical. When \code{FALSE}, the function aborts if the target +directory already exists.} -\item{make_portable_fn}{A logical value. Replace characters in file names -that are not broadly portable across file systems. Default is FALSE.} +\item{make_portable_fn}{Logical. When \code{TRUE}, filenames are sanitized via +\code{make_fn_portable()}.} -\item{timeout_secs}{An integer. The seconds an httr2 request will run before -timing out. Default is 600 (10 min). This is to handle very large files.} +\item{timeout_secs}{Numeric. Timeout applied to each download request.} \item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} -\item{rq}{A list in the form of an \code{httr2} request object. Default is NULL.} +\item{rq}{An optional \code{httr2} request object reused when requesting signed +links.} } \value{ -Full file names to the downloaded assets or NULL. +Character vector of downloaded file paths or \code{NULL} if the request +fails before any downloads start. } \description{ -Databrary stores file types (assets) of many types. This -function downloads assets in a data frame generated by list_session_assets(). +Iterates over a data frame of session assets, requesting signed download +links for each asset and saving them to disk. Designed to work with +\code{list_session_assets()} or \code{list_volume_session_assets()} output. } \examples{ \donttest{ \dontrun{ -download_session_assets_fr_df() # Downloads all of the files from session -9807 in Databrary volume 1. - -# Just the CSVs -v1 <- list_session_assets() -v1_csv <- dplyr::filter(v1, format_extension == "csv") -download_session_assets_fr_df(v1_csv, vb = TRUE) +assets <- list_session_assets(vol_id = 1, session_id = 9807) +download_session_assets_fr_df(assets, vb = TRUE) } } } diff --git a/man/download_session_csv.Rd b/man/download_session_csv.Rd index 039448f3..74eea14c 100644 --- a/man/download_session_csv.Rd +++ b/man/download_session_csv.Rd @@ -2,46 +2,44 @@ % Please edit documentation in R/download_session_csv.R \name{download_session_csv} \alias{download_session_csv} -\title{Download Session Spreadsheet As CSV} +\title{Request a Session or Volume CSV Export.} \usage{ download_session_csv( vol_id = 1, - file_name = "test.csv", - target_dir = tempdir(), - as_df = FALSE, + session_id = NULL, vb = options::opt("vb"), rq = NULL ) } \arguments{ -\item{vol_id}{An integer. Target volume number. Default is 1.} +\item{vol_id}{Integer. Target volume identifier. Default is 1.} -\item{file_name}{A character string. Name for the output file. -Default is 'test.csv'.} - -\item{target_dir}{A character string. Directory to save downloaded file. -Default is \code{tempdir()}.} - -\item{as_df}{A logical value. Convert the data from a list to a data frame. -Default is FALSE.} +\item{session_id}{Optional integer. When provided, requests a session-level +CSV export. When \code{NULL}, a volume-level CSV export is requested.} \item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} -\item{rq}{An \code{httr2} request object. Default is NULL.} +\item{rq}{An \code{httr2} request object. Default is \code{NULL}, meaning a default +authenticated request is generated.} } \value{ -A character string that is the name of the downloaded file or a -data frame if \code{as_df} is TRUE. +A list describing the processing task (\code{status}, \code{message}, +\code{task_id}) or \code{NULL} if the request fails. } \description{ -Databrary generates a CSV-formated spreadsheet that summarizes -information about individual sessions. This command downloads that CSV file -as a temporary file or with a name specified by the user. +The Django API generates CSV reports asynchronously. This function queues a +CSV export for a specific session when \code{session_id} is supplied, or for the +entire volume when \code{session_id} is \code{NULL}. The API delivers the final signed +download link via email once the export is ready. } \examples{ \donttest{ \dontrun{ -download_session_csv() # Downloads "session" CSV for volume 1 +# Request a volume-wide CSV export +download_session_csv(vol_id = 1) + +# Request a session-specific CSV export +download_session_csv(vol_id = 1, session_id = 9807) } } diff --git a/man/download_session_zip.Rd b/man/download_session_zip.Rd index c7c5c9b0..ab5bb17f 100644 --- a/man/download_session_zip.Rd +++ b/man/download_session_zip.Rd @@ -2,40 +2,39 @@ % Please edit documentation in R/download_session_zip.R \name{download_session_zip} \alias{download_session_zip} -\title{Download Zip Archive From Databrary Session.} +\title{Request a Signed ZIP Download for a Session.} \usage{ download_session_zip( vol_id = 31, session_id = 9803, - out_dir = tempdir(), - file_name = "test.zip", vb = options::opt("vb"), rq = NULL ) } \arguments{ -\item{vol_id}{Volume number.} +\item{vol_id}{Volume identifier that owns the session.} -\item{session_id}{Slot/session number.} - -\item{out_dir}{Directory to save output file.} - -\item{file_name}{Name for downloaded file, default is 'test.zip'.} +\item{session_id}{Session identifier within the volume.} \item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} -\item{rq}{An \code{httr2} request object. Default is NULL.} +\item{rq}{An \code{httr2} request object. Default is \code{NULL}, in which case a +default authenticated request is generated.} } \value{ -Full filename of the downloaded file. +A list describing the processing task (\code{status}, \code{message}, +\code{task_id}) or \code{NULL} when the request fails. } \description{ -Download Zip Archive From Databrary Session. +The Django API prepares session-level ZIP archives asynchronously. Calling +\code{download_session_zip()} triggers the job and returns a processing task +summary. Once the archive is ready, Databrary emails a signed download link +to the authenticated user. } \examples{ \donttest{ \dontrun{ -download_session_zip() # Downloads Zip Archive from volume 31, session 9803 +download_session_zip(vol_id = 31, session_id = 9803) } } diff --git a/man/download_single_folder_asset_fr_df.Rd b/man/download_single_folder_asset_fr_df.Rd new file mode 100644 index 00000000..ebf17e1d --- /dev/null +++ b/man/download_single_folder_asset_fr_df.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/download_single_folder_asset_fr_df.R +\name{download_single_folder_asset_fr_df} +\alias{download_single_folder_asset_fr_df} +\title{Download a Single Folder Asset From a Data Frame Row.} +\usage{ +download_single_folder_asset_fr_df( + i = NULL, + folder_df = NULL, + target_dir = tempdir(), + add_folder_subdir = TRUE, + overwrite = TRUE, + make_portable_fn = FALSE, + timeout_secs = REQUEST_TIMEOUT_VERY_LONG, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{i}{Integer. Index of the asset within \code{folder_df}.} + +\item{folder_df}{Data frame containing folder asset metadata.} + +\item{target_dir}{Base directory for downloads.} + +\item{add_folder_subdir}{Logical. When \code{TRUE}, creates a subdirectory per +folder inside \code{target_dir}.} + +\item{overwrite}{Logical. When \code{FALSE}, existing files are saved with a +timestamped suffix.} + +\item{make_portable_fn}{Logical. When \code{TRUE}, filenames are sanitized via +\code{make_fn_portable()}.} + +\item{timeout_secs}{Numeric. Timeout applied to the signed download request.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{Optional \code{httr2} request object reused to request signed links.} +} +\value{ +Path to the downloaded asset or \code{NULL} if the download fails. +} +\description{ +Helper used by \code{download_folder_assets_fr_df()} to fetch a single asset via +the signed-download workflow. +} diff --git a/man/download_single_session_asset_fr_df.Rd b/man/download_single_session_asset_fr_df.Rd index 72d3a795..0bdd37ad 100644 --- a/man/download_single_session_asset_fr_df.Rd +++ b/man/download_single_session_asset_fr_df.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/download_single_session_asset_fr_df.R \name{download_single_session_asset_fr_df} \alias{download_single_session_asset_fr_df} -\title{Download Single Asset From Databrary} +\title{Download a Single Asset From a Session Data Frame Row.} \usage{ download_single_session_asset_fr_df( i = NULL, @@ -17,53 +17,31 @@ download_single_session_asset_fr_df( ) } \arguments{ -\item{i}{An integer. Index into a row of the session asset data frame. -Default is NULL.} +\item{i}{Integer. Index of the asset within \code{session_df}.} -\item{session_df}{A row from a data frame from \code{list_session_assets()} -or \code{list_volume_assets()}. Default is NULL>} +\item{session_df}{Data frame containing asset metadata.} -\item{target_dir}{A character string. Directory to save the downloaded file. -Default is a temporary directory given by a call to \code{tempdir()}.} +\item{target_dir}{Base directory for downloads.} -\item{add_session_subdir}{A logical value. Add add the session name to the -file path so that files are in a subdirectory specific to the session. Default -is TRUE.} +\item{add_session_subdir}{Logical. When \code{TRUE}, creates a subdirectory per +session inside \code{target_dir}.} -\item{overwrite}{A logical value. Overwrite an existing file. Default is TRUE.} +\item{overwrite}{Logical. When \code{FALSE}, existing files are saved with a +timestamped suffix.} -\item{make_portable_fn}{A logical value. Replace characters in file names -that are not broadly portable across file systems. Default is FALSE.} +\item{make_portable_fn}{Logical. When \code{TRUE}, filenames are sanitized via +\code{make_fn_portable()}.} -\item{timeout_secs}{An integer. The seconds an httr2 request will run before -timing out. Default is 600 (10 min). This is to handle very large files.} +\item{timeout_secs}{Numeric. Timeout applied to the signed download request.} \item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} -\item{rq}{A list in the form of an \code{httr2} request object. Default is NULL.} +\item{rq}{Optional \code{httr2} request object reused to request signed links.} } \value{ -Full file name to the asset or NULL. +Path to the downloaded asset or \code{NULL} if the download fails. } \description{ -Databrary stores file types (assets) of many types. This -function downloads an asset based on its system-unique integer identifer -(asset_id) and system-unique session (slot) identifier (session_id). It -is designed to work with download_session_assets_fr_df() so that multiple -files can be downloaded simultaneously. -} -\examples{ -\donttest{ -\dontrun{ -vol_1 <- list_session_assets(session_id = 9807) -a_1 <- vol_1[1,] -tmp_dir <- tempdir() -fn <- file.path(tmp_dir, paste0(a_1$asset_name, ".", a_1$format_extension)) -download_single_session_asset_fr_df(a_1$asset_id, - fn, - session_id = a_1$session_id, - vb = TRUE) - -} -} +Helper used by \code{download_session_assets_fr_df()} to fetch a single asset via +the signed-download workflow. } diff --git a/man/download_video.Rd b/man/download_video.Rd index f958cf82..a7796623 100644 --- a/man/download_video.Rd +++ b/man/download_video.Rd @@ -2,43 +2,48 @@ % Please edit documentation in R/download_video.R \name{download_video} \alias{download_video} -\title{Download Video From Databrary.} +\title{Download a Video Asset via Signed URL.} \usage{ download_video( - asset_id = 1, + vol_id = 1, session_id = 9807, - file_name = tempfile(paste0(session_id, "_", asset_id, "_"), fileext = ".mp4"), + asset_id = 1, + file_name = NULL, target_dir = tempdir(), vb = options::opt("vb"), rq = NULL ) } \arguments{ -\item{asset_id}{Asset id for target file.} +\item{vol_id}{Volume identifier containing the session.} + +\item{session_id}{Session identifier containing the asset.} -\item{session_id}{Slot/session number where target file is stored.} +\item{asset_id}{Asset identifier for the video file.} -\item{file_name}{Name for downloaded file.} +\item{file_name}{Optional explicit file name. Defaults to the API-provided +value.} -\item{target_dir}{Directory to save the downloaded file. -Default is a temporary directory given by a call to \code{tempdir()}.} +\item{target_dir}{Directory to save the downloaded file. Defaults to +\code{tempdir()}.} \item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} -\item{rq}{An \code{httr2} request object.} +\item{rq}{Optional \code{httr2} request object reused when requesting the signed +link.} } \value{ -Full file name to the asset. +Path to the downloaded video or \code{NULL} on failure. } \description{ -Download Video From Databrary. +Download a Video Asset via Signed URL. } \examples{ \donttest{ \dontrun{ -download_video() # Download's 'numbers' file from volume 1. -download_video(asset_id = 11643, session_id = 9825, file_name = "rdk.mp4") -#' # Downloads a display with a random dot kinematogram (RDK). +download_video() # Default public video from volume 1 +download_video(vol_id = 1, session_id = 9825, asset_id = 11643, + file_name = "rdk.mp4") } } diff --git a/man/download_volume_zip.Rd b/man/download_volume_zip.Rd index 180a1cb3..c6034724 100644 --- a/man/download_volume_zip.Rd +++ b/man/download_volume_zip.Rd @@ -2,37 +2,32 @@ % Please edit documentation in R/download_volume_zip.R \name{download_volume_zip} \alias{download_volume_zip} -\title{Download Zip Archive of All Data in a Volume.} +\title{Request a Signed ZIP Download for a Volume.} \usage{ -download_volume_zip( - vol_id = 31, - out_dir = tempdir(), - file_name = "test.zip", - vb = options::opt("vb"), - rq = NULL -) +download_volume_zip(vol_id = 31, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vol_id}{Volume number.} - -\item{out_dir}{Directory to save output file.} - -\item{file_name}{Name for downloaded file, default is 'test.mp4'.} +\item{vol_id}{Volume identifier.} \item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} -\item{rq}{An \code{httr2} request object. Default is NULL.} +\item{rq}{An \code{httr2} request object. Default is \code{NULL}, in which case a +default authenticated request is generated.} } \value{ -Full filename of the downloaded file. +A list describing the processing task (\code{status}, \code{message}, +\code{task_id}) or \code{NULL} when the request fails. } \description{ -Download Zip Archive of All Data in a Volume. +Volume-level ZIP archives are prepared asynchronously by the Django API. +Calling \code{download_volume_zip()} queues the job and returns a processing task +descriptor. When the archive is ready, Databrary emails a signed download +link to the authenticated user. } \examples{ \donttest{ \dontrun{ -download_volume_zip() # Zip file of all data from volume 31, the default. +download_volume_zip(vol_id = 31) } } diff --git a/tests/testthat/test-download_folder_asset.R b/tests/testthat/test-download_folder_asset.R new file mode 100644 index 00000000..279a2b6d --- /dev/null +++ b/tests/testthat/test-download_folder_asset.R @@ -0,0 +1,70 @@ +# download_folder_asset ------------------------------------------------------- +test_that("download_folder_asset rejects bad input parameters", { + expect_error(download_folder_asset(vol_id = -1)) + expect_error(download_folder_asset(vol_id = 0)) + expect_error(download_folder_asset(vol_id = "a")) + expect_error(download_folder_asset(vol_id = list(a = 1, b = 2))) + expect_error(download_folder_asset(vol_id = TRUE)) + + expect_error(download_folder_asset(folder_id = -1)) + expect_error(download_folder_asset(folder_id = 0)) + expect_error(download_folder_asset(folder_id = "a")) + expect_error(download_folder_asset(folder_id = list(a = 1, b = 2))) + expect_error(download_folder_asset(folder_id = TRUE)) + + expect_error(download_folder_asset(asset_id = -1)) + expect_error(download_folder_asset(asset_id = 0)) + expect_error(download_folder_asset(asset_id = "a")) + expect_error(download_folder_asset(asset_id = list(a = 1, b = 2))) + expect_error(download_folder_asset(asset_id = TRUE)) + + expect_error(download_folder_asset(file_name = 3)) + expect_error(download_folder_asset(file_name = list(a = 1, b = 2))) + expect_error(download_folder_asset(file_name = TRUE)) + + expect_error(download_folder_asset(target_dir = 3)) + expect_error(download_folder_asset(target_dir = list(a = 1, b = 2))) + expect_error(download_folder_asset(target_dir = TRUE)) + + expect_error(download_folder_asset(timeout_secs = -1)) + expect_error(download_folder_asset(timeout_secs = 0)) + expect_error(download_folder_asset(timeout_secs = list(1, 2))) + + expect_error(download_folder_asset(vb = -1)) + expect_error(download_folder_asset(vb = 3)) + expect_error(download_folder_asset(vb = "a")) + expect_error(download_folder_asset(vb = list(a = 1, b = 2))) + + expect_error(download_folder_asset(rq = "a")) + expect_error(download_folder_asset(rq = -1)) + expect_error(download_folder_asset(rq = c(2, 3))) + expect_error(download_folder_asset(rq = list(a = 1, b = 2))) +}) + +test_that("download_folder_asset fetches signed link", { + tmp_dir <- tempdir() + fake_link <- list(download_url = "https://example.com/file.bin", file_name = "example.bin") + class(fake_link) <- c("databrary_signed_download", "list") + + captured_path <- NULL + captured_dest <- NULL + + result <- with_mocked_bindings( + download_folder_asset(vol_id = 1, folder_id = 2, asset_id = 3, target_dir = tmp_dir), + request_signed_download_link = function(path, rq = NULL, vb = FALSE) { + captured_path <<- path + fake_link + }, + download_signed_file = function(download_url, dest_path, timeout_secs = REQUEST_TIMEOUT, vb = FALSE) { + captured_dest <<- dest_path + dest_path + } + ) + + expect_true(grepl("example.bin$", result)) + expect_equal(result, captured_dest) + expect_equal(captured_path, sprintf("/volumes/%s/folders/%s/files/%s/download-link/", 1, 2, 3)) +}) + + + diff --git a/tests/testthat/test-download_folder_assets_fr_df.R b/tests/testthat/test-download_folder_assets_fr_df.R new file mode 100644 index 00000000..ccb4485e --- /dev/null +++ b/tests/testthat/test-download_folder_assets_fr_df.R @@ -0,0 +1,65 @@ +# download_folder_assets_fr_df ----------------------------------------------- +test_that("download_folder_assets_fr_df rejects bad input parameters", { + expect_error(download_folder_assets_fr_df(folder_df = 3)) + expect_error(download_folder_assets_fr_df(folder_df = "a")) + expect_error(download_folder_assets_fr_df(folder_df = TRUE)) + + missing_cols <- data.frame(vol_id = 1, folder_id = 1, asset_id = 1) + expect_error(download_folder_assets_fr_df(folder_df = missing_cols)) + + expect_error(download_folder_assets_fr_df(target_dir = 3)) + expect_error(download_folder_assets_fr_df(target_dir = list(a = 1, b = 2))) + expect_error(download_folder_assets_fr_df(target_dir = TRUE)) + + expect_error(download_folder_assets_fr_df(add_folder_subdir = -1)) + expect_error(download_folder_assets_fr_df(add_folder_subdir = 3)) + expect_error(download_folder_assets_fr_df(add_folder_subdir = "a")) + expect_error(download_folder_assets_fr_df(add_folder_subdir = list(a = 1, b = 2))) + + expect_error(download_folder_assets_fr_df(overwrite = -1)) + expect_error(download_folder_assets_fr_df(overwrite = 3)) + expect_error(download_folder_assets_fr_df(overwrite = "a")) + expect_error(download_folder_assets_fr_df(overwrite = list(a = 1, b = 2))) + + expect_error(download_folder_assets_fr_df(make_portable_fn = -1)) + expect_error(download_folder_assets_fr_df(make_portable_fn = 3)) + expect_error(download_folder_assets_fr_df(make_portable_fn = "a")) + expect_error(download_folder_assets_fr_df(make_portable_fn = list(a = 1, b = 2))) + + expect_error(download_folder_assets_fr_df(timeout_secs = -1)) + expect_error(download_folder_assets_fr_df(timeout_secs = TRUE)) + expect_error(download_folder_assets_fr_df(timeout_secs = "a")) + expect_error(download_folder_assets_fr_df(timeout_secs = list(a = 1, b = 2))) + + expect_error(download_folder_assets_fr_df(vb = -1)) + expect_error(download_folder_assets_fr_df(vb = 3)) + expect_error(download_folder_assets_fr_df(vb = "a")) + expect_error(download_folder_assets_fr_df(vb = list(a = 1, b = 2))) + + expect_error(download_folder_assets_fr_df(rq = "a")) + expect_error(download_folder_assets_fr_df(rq = -1)) + expect_error(download_folder_assets_fr_df(rq = c(1, 2))) + expect_error(download_folder_assets_fr_df(rq = list(a = 1, b = 2))) +}) + +test_that("download_folder_assets_fr_df iterates rows", { + folder_df <- tibble::tibble( + vol_id = c(1, 1), + folder_id = c(2, 2), + asset_id = c(3, 4), + asset_name = c("file_a", "file_b") + ) + + calls <- list() + results <- with_mocked_bindings( + download_folder_assets_fr_df(folder_df = folder_df, target_dir = tempdir(), vb = FALSE), + download_single_folder_asset_fr_df = function(i, folder_df, ...) { + calls[[length(calls) + 1]] <<- list(i = i, folder_df = folder_df) + paste0("path-", i) + } + ) + + expect_equal(results, c("path-1", "path-2")) + expect_equal(vapply(calls, function(x) x$i, numeric(1)), c(1, 2)) +}) + diff --git a/tests/testthat/test-download_folder_zip.R b/tests/testthat/test-download_folder_zip.R new file mode 100644 index 00000000..519da6c0 --- /dev/null +++ b/tests/testthat/test-download_folder_zip.R @@ -0,0 +1,41 @@ +# download_folder_zip --------------------------------------------------------- +test_that("download_folder_zip rejects bad input parameters", { + expect_error(download_folder_zip(vol_id = -1)) + expect_error(download_folder_zip(vol_id = 0)) + expect_error(download_folder_zip(vol_id = "a")) + expect_error(download_folder_zip(vol_id = list(a = 1, b = 2))) + expect_error(download_folder_zip(vol_id = TRUE)) + + expect_error(download_folder_zip(folder_id = -1)) + expect_error(download_folder_zip(folder_id = 0)) + expect_error(download_folder_zip(folder_id = "a")) + expect_error(download_folder_zip(folder_id = list(a = 1, b = 2))) + expect_error(download_folder_zip(folder_id = TRUE)) + + expect_error(download_folder_zip(vb = -1)) + expect_error(download_folder_zip(vb = 3)) + expect_error(download_folder_zip(vb = "a")) + expect_error(download_folder_zip(vb = list(a = 1, b = 2))) + + expect_error(download_folder_zip(rq = "a")) + expect_error(download_folder_zip(rq = -1)) + expect_error(download_folder_zip(rq = c(1, 2))) +}) + +test_that("download_folder_zip returns processing task", { + captured_path <- NULL + fake_task <- list(status = "processing", message = "queued", task_id = "xyz") + task <- with_mocked_bindings( + download_folder_zip(vol_id = 2, folder_id = 5), + request_processing_task = function(path, rq = NULL, vb = FALSE) { + captured_path <<- path + fake_task + } + ) + + expect_identical(task, fake_task) + expect_equal(captured_path, sprintf("/volumes/%s/folders/%s/download-link/", 2, 5)) +}) + + + diff --git a/tests/testthat/test-download_session_asset.R b/tests/testthat/test-download_session_asset.R index ec241871..b61aa708 100644 --- a/tests/testthat/test-download_session_asset.R +++ b/tests/testthat/test-download_session_asset.R @@ -1,32 +1,42 @@ # download_session_asset --------------------------------------------------------- test_that("download_session_asset rejects bad input parameters", { + expect_error(download_session_asset(vol_id = -1)) + expect_error(download_session_asset(vol_id = 0)) + expect_error(download_session_asset(vol_id = "a")) + expect_error(download_session_asset(vol_id = list(a = 1, b = 2))) + expect_error(download_session_asset(vol_id = TRUE)) + expect_error(download_session_asset(asset_id = -1)) expect_error(download_session_asset(asset_id = 0)) expect_error(download_session_asset(asset_id = "a")) - expect_error(download_session_asset(asset_id = list(a=1, b=2))) + expect_error(download_session_asset(asset_id = list(a = 1, b = 2))) expect_error(download_session_asset(asset_id = TRUE)) - + expect_error(download_session_asset(session_id = -1)) expect_error(download_session_asset(session_id = 0)) expect_error(download_session_asset(session_id = "a")) - expect_error(download_session_asset(session_id = list(a=1, b=2))) + expect_error(download_session_asset(session_id = list(a = 1, b = 2))) expect_error(download_session_asset(session_id = TRUE)) - + expect_error(download_session_asset(file_name = 3)) - expect_error(download_session_asset(file_name = list(a=1, b=2))) + expect_error(download_session_asset(file_name = list(a = 1, b = 2))) expect_error(download_session_asset(file_name = TRUE)) - + expect_error(download_session_asset(target_dir = 3)) - expect_error(download_session_asset(target_dir = list(a=1, b=2))) + expect_error(download_session_asset(target_dir = list(a = 1, b = 2))) expect_error(download_session_asset(target_dir = TRUE)) - + + expect_error(download_session_asset(timeout_secs = -1)) + expect_error(download_session_asset(timeout_secs = 0)) + expect_error(download_session_asset(timeout_secs = list(1, 2))) + expect_error(download_session_asset(vb = -1)) expect_error(download_session_asset(vb = 3)) expect_error(download_session_asset(vb = "a")) - expect_error(download_session_asset(vb = list(a=1, b=2))) - + expect_error(download_session_asset(vb = list(a = 1, b = 2))) + expect_error(download_session_asset(rq = "a")) expect_error(download_session_asset(rq = -1)) - expect_error(download_session_asset(rq = c(2,3))) - expect_error(download_session_asset(rq = list(a=1, b=2))) + expect_error(download_session_asset(rq = c(2, 3))) + expect_error(download_session_asset(rq = list(a = 1, b = 2))) }) diff --git a/tests/testthat/test-download_session_assets_fr_df.R b/tests/testthat/test-download_session_assets_fr_df.R index 275f3937..fed17e64 100644 --- a/tests/testthat/test-download_session_assets_fr_df.R +++ b/tests/testthat/test-download_session_assets_fr_df.R @@ -1,43 +1,43 @@ # download_session_assets_fr_df --------------------------------------------------------- -test_that("download_session_assets_fr_df rejects bad input parameters", - { - expect_error(download_session_assets_fr_df(session_asset_entry = 3)) - expect_error(download_session_assets_fr_df(session_asset_entry = "a")) - expect_error(download_session_assets_fr_df(session_asset_entry = TRUE)) - expect_error(download_session_assets_fr_df(session_asset_entry = list(a = 1, b = - 2))) - expect_error(download_session_assets_fr_df(target_dir = 3)) - expect_error(download_session_assets_fr_df(target_dir = list(a = 1, b = - 2))) - expect_error(download_session_assets_fr_df(target_dir = TRUE)) - - expect_error(download_session_assets_fr_df(add_session_subdir = -1)) - expect_error(download_session_assets_fr_df(add_session_subdir = 3)) - expect_error(download_session_assets_fr_df(add_session_subdir = "a")) - expect_error(download_session_assets_fr_df(add_session_subdir = list(a = 1, b = 2))) - - expect_error(download_session_assets_fr_df(overwrite = -1)) - expect_error(download_session_assets_fr_df(overwrite = 3)) - expect_error(download_session_assets_fr_df(overwrite = "a")) - expect_error(download_session_assets_fr_df(overwrite = list(a = 1, b = 2))) - - expect_error(download_session_assets_fr_df(make_portable_fn = -1)) - expect_error(download_session_assets_fr_df(make_portable_fn = 3)) - expect_error(download_session_assets_fr_df(make_portable_fn = "a")) - expect_error(download_session_assets_fr_df(make_portable_fn = list(a = 1, b = 2))) - - expect_error(download_session_assets_fr_df(timeout_secs = -1)) - expect_error(download_session_assets_fr_df(timeout_secs = TRUE)) - expect_error(download_session_assest_fr_df(timeout_secs = "a")) - expect_error(download_session_assets_fr_df(timeout_secs = list(a = 1, b = 2))) - - expect_error(download_session_assets_fr_df(vb = -1)) - expect_error(download_session_assets_fr_df(vb = 3)) - expect_error(download_session_assets_fr_df(vb = "a")) - expect_error(download_session_assets_fr_df(vb = list(a = 1, b = 2))) - - expect_error(download_session_assets_fr_df(rq = "a")) - expect_error(download_session_assets_fr_df(rq = -1)) - expect_error(download_session_assets_fr_df(rq = c(2, 3))) - expect_error(download_session_assets_fr_df(rq = list(a = 1, b = 2))) - }) +test_that("download_session_assets_fr_df rejects bad input parameters", { + expect_error(download_session_assets_fr_df(session_df = 3)) + expect_error(download_session_assets_fr_df(session_df = "a")) + expect_error(download_session_assets_fr_df(session_df = TRUE)) + + missing_cols <- data.frame(vol_id = 1, session_id = 1, asset_id = 1) + expect_error(download_session_assets_fr_df(session_df = missing_cols)) + + expect_error(download_session_assets_fr_df(target_dir = 3)) + expect_error(download_session_assets_fr_df(target_dir = list(a = 1, b = 2))) + expect_error(download_session_assets_fr_df(target_dir = TRUE)) + + expect_error(download_session_assets_fr_df(add_session_subdir = -1)) + expect_error(download_session_assets_fr_df(add_session_subdir = 3)) + expect_error(download_session_assets_fr_df(add_session_subdir = "a")) + expect_error(download_session_assets_fr_df(add_session_subdir = list(a = 1, b = 2))) + + expect_error(download_session_assets_fr_df(overwrite = -1)) + expect_error(download_session_assets_fr_df(overwrite = 3)) + expect_error(download_session_assets_fr_df(overwrite = "a")) + expect_error(download_session_assets_fr_df(overwrite = list(a = 1, b = 2))) + + expect_error(download_session_assets_fr_df(make_portable_fn = -1)) + expect_error(download_session_assets_fr_df(make_portable_fn = 3)) + expect_error(download_session_assets_fr_df(make_portable_fn = "a")) + expect_error(download_session_assets_fr_df(make_portable_fn = list(a = 1, b = 2))) + + expect_error(download_session_assets_fr_df(timeout_secs = -1)) + expect_error(download_session_assets_fr_df(timeout_secs = TRUE)) + expect_error(download_session_assets_fr_df(timeout_secs = "a")) + expect_error(download_session_assets_fr_df(timeout_secs = list(a = 1, b = 2))) + + expect_error(download_session_assets_fr_df(vb = -1)) + expect_error(download_session_assets_fr_df(vb = 3)) + expect_error(download_session_assets_fr_df(vb = "a")) + expect_error(download_session_assets_fr_df(vb = list(a = 1, b = 2))) + + expect_error(download_session_assets_fr_df(rq = "a")) + expect_error(download_session_assets_fr_df(rq = -1)) + expect_error(download_session_assets_fr_df(rq = c(2, 3))) + expect_error(download_session_assets_fr_df(rq = list(a = 1, b = 2))) +}) diff --git a/tests/testthat/test-download_session_csv.R b/tests/testthat/test-download_session_csv.R index 2ee07590..8e7eaa09 100644 --- a/tests/testthat/test-download_session_csv.R +++ b/tests/testthat/test-download_session_csv.R @@ -3,24 +3,51 @@ test_that("download_session_csv rejects bad input parameters", { expect_error(download_session_csv(vol_id = -1)) expect_error(download_session_csv(vol_id = 0)) expect_error(download_session_csv(vol_id = "a")) - expect_error(download_session_csv(vol_id = list(a=1, b=2))) + expect_error(download_session_csv(vol_id = list(a = 1, b = 2))) expect_error(download_session_csv(vol_id = TRUE)) - - expect_error(download_session_csv(file_name = 3)) - expect_error(download_session_csv(file_name = list(a=1, b=2))) - expect_error(download_session_csv(file_name = TRUE)) - - expect_error(download_session_csv(target_dir = 3)) - expect_error(download_session_csv(target_dir = list(a=1, b=2))) - expect_error(download_session_csv(target_dir = TRUE)) - expect_error(download_session_csv(as_df = -1)) - expect_error(download_session_csv(as_df = 3)) - expect_error(download_session_csv(as_df = "a")) - expect_error(download_session_csv(as_df = list(a=1, b=2))) - + expect_error(download_session_csv(session_id = -1)) + expect_error(download_session_csv(session_id = 0)) + expect_error(download_session_csv(session_id = "a")) + expect_error(download_session_csv(session_id = list(a = 1, b = 2))) + expect_error(download_session_csv(session_id = TRUE)) + expect_error(download_session_csv(vb = -1)) expect_error(download_session_csv(vb = 3)) expect_error(download_session_csv(vb = "a")) - expect_error(download_session_csv(vb = list(a=1, b=2))) + expect_error(download_session_csv(vb = list(a = 1, b = 2))) + + expect_error(download_session_csv(rq = "a")) + expect_error(download_session_csv(rq = -1)) + expect_error(download_session_csv(rq = c(1, 2))) +}) + +test_that("download_session_csv returns volume processing task", { + captured_path <- NULL + fake_task <- list(status = "processing", message = "queued", task_id = "abc") + task <- with_mocked_bindings( + download_session_csv(), + request_processing_task = function(path, rq = NULL, vb = FALSE) { + captured_path <<- path + fake_task + } + ) + + expect_identical(task, fake_task) + expect_equal(captured_path, sprintf("/volumes/%s/csv-download-link/", 1)) +}) + +test_that("download_session_csv returns session processing task", { + captured_path <- NULL + fake_task <- list(status = "processing", message = "queued", task_id = "def") + task <- with_mocked_bindings( + download_session_csv(vol_id = 2, session_id = 11), + request_processing_task = function(path, rq = NULL, vb = FALSE) { + captured_path <<- path + fake_task + } + ) + + expect_identical(task, fake_task) + expect_equal(captured_path, sprintf("/volumes/%s/sessions/%s/csv-download-link/", 2, 11)) }) diff --git a/tests/testthat/test-download_session_zip.R b/tests/testthat/test-download_session_zip.R index 91bd6f68..34038857 100644 --- a/tests/testthat/test-download_session_zip.R +++ b/tests/testthat/test-download_session_zip.R @@ -2,29 +2,38 @@ test_that("download_session_zip rejects bad input parameters", { expect_error(download_session_zip(vol_id = -1)) expect_error(download_session_zip(vol_id = "a")) - expect_error(download_session_zip(vol_id = list(a=1, b=2))) + expect_error(download_session_zip(vol_id = list(a = 1, b = 2))) expect_error(download_session_zip(vol_id = TRUE)) - + expect_error(download_session_zip(session_id = -1)) expect_error(download_session_zip(session_id = "a")) - expect_error(download_session_zip(session_id = list(a=1, b=2))) + expect_error(download_session_zip(session_id = list(a = 1, b = 2))) expect_error(download_session_zip(session_id = TRUE)) - - expect_error(download_session_zip(out_dir = -1)) - expect_error(download_session_zip(out_dir = list(a=1, b=2))) - expect_error(download_session_zip(out_dir = TRUE)) - - expect_error(download_session_zip(file_name = -1)) - expect_error(download_session_zip(file_name = list(a=1, b=2))) - expect_error(download_session_zip(file_name = TRUE)) - + expect_error(download_session_zip(vb = -1)) expect_error(download_session_zip(vb = 3)) expect_error(download_session_zip(vb = "a")) - expect_error(download_session_zip(vb = list(a=1, b=2))) + expect_error(download_session_zip(vb = list(a = 1, b = 2))) + + expect_error(download_session_zip(rq = "a")) + expect_error(download_session_zip(rq = -1)) + expect_error(download_session_zip(rq = c(1, 2))) }) -test_that("download_session_zip returns string", { - testthat::skip("Download route still under migration to Django signed-link workflow") - expect_true(is.character(download_session_zip())) +test_that("download_session_zip returns processing task", { + captured_path <- NULL + fake_task <- list(status = "processing", message = "queued", task_id = "abc") + task <- with_mocked_bindings( + download_session_zip(), + request_processing_task = function(path, rq = NULL, vb = FALSE) { + captured_path <<- path + fake_task + } + ) + + expect_identical(task, fake_task) + expect_equal( + captured_path, + sprintf("/volumes/%s/sessions/%s/download-link/", 31, 9803) + ) }) diff --git a/tests/testthat/test-download_single_folder_asset_fr_df.R b/tests/testthat/test-download_single_folder_asset_fr_df.R new file mode 100644 index 00000000..91b31a25 --- /dev/null +++ b/tests/testthat/test-download_single_folder_asset_fr_df.R @@ -0,0 +1,79 @@ +# download_single_folder_asset_fr_df ---------------------------------------- +test_that("download_single_folder_asset_fr_df rejects bad input parameters", { + expect_error(download_single_folder_asset_fr_df(i = 0)) + expect_error(download_single_folder_asset_fr_df(i = -1)) + expect_error(download_single_folder_asset_fr_df(i = "a")) + + expect_error(download_single_folder_asset_fr_df(i = 1, folder_df = 3)) + expect_error(download_single_folder_asset_fr_df(i = 1, folder_df = "a")) + expect_error(download_single_folder_asset_fr_df(i = 1, folder_df = TRUE)) + + missing_cols <- data.frame(vol_id = 1, folder_id = 1, asset_id = 1) + expect_error(download_single_folder_asset_fr_df(i = 1, folder_df = missing_cols)) + + expect_error(download_single_folder_asset_fr_df(i = 1, target_dir = 3)) + expect_error(download_single_folder_asset_fr_df(i = 1, target_dir = list(a = 1, b = 2))) + expect_error(download_single_folder_asset_fr_df(i = 1, target_dir = TRUE)) + + expect_error(download_single_folder_asset_fr_df(i = 1, add_folder_subdir = -1)) + expect_error(download_single_folder_asset_fr_df(i = 1, add_folder_subdir = 3)) + expect_error(download_single_folder_asset_fr_df(i = 1, add_folder_subdir = "a")) + expect_error(download_single_folder_asset_fr_df(i = 1, add_folder_subdir = list(a = 1, b = 2))) + + expect_error(download_single_folder_asset_fr_df(i = 1, overwrite = -1)) + expect_error(download_single_folder_asset_fr_df(i = 1, overwrite = 3)) + expect_error(download_single_folder_asset_fr_df(i = 1, overwrite = "a")) + expect_error(download_single_folder_asset_fr_df(i = 1, overwrite = list(a = 1, b = 2))) + + expect_error(download_single_folder_asset_fr_df(i = 1, make_portable_fn = -1)) + expect_error(download_single_folder_asset_fr_df(i = 1, make_portable_fn = 3)) + expect_error(download_single_folder_asset_fr_df(i = 1, make_portable_fn = "a")) + expect_error(download_single_folder_asset_fr_df(i = 1, make_portable_fn = list(a = 1, b = 2))) + + expect_error(download_single_folder_asset_fr_df(i = 1, timeout_secs = -1)) + expect_error(download_single_folder_asset_fr_df(i = 1, timeout_secs = TRUE)) + expect_error(download_single_folder_asset_fr_df(i = 1, timeout_secs = "a")) + expect_error(download_single_folder_asset_fr_df(i = 1, timeout_secs = list(a = 1, b = 2))) + + expect_error(download_single_folder_asset_fr_df(i = 1, vb = -1)) + expect_error(download_single_folder_asset_fr_df(i = 1, vb = 3)) + expect_error(download_single_folder_asset_fr_df(i = 1, vb = "a")) + expect_error(download_single_folder_asset_fr_df(i = 1, vb = list(a = 1, b = 2))) + + expect_error(download_single_folder_asset_fr_df(i = 1, rq = "a")) + expect_error(download_single_folder_asset_fr_df(i = 1, rq = -1)) + expect_error(download_single_folder_asset_fr_df(i = 1, rq = c(2, 3))) + expect_error(download_single_folder_asset_fr_df(i = 1, rq = list(a = 1, b = 2))) +}) + +test_that("download_single_folder_asset_fr_df delegates to download_folder_asset", { + folder_df <- tibble::tibble( + vol_id = 1, + folder_id = 2, + asset_id = 3, + asset_name = "demo", + format_extension = "txt" + ) + + captured <- NULL + result <- with_mocked_bindings( + download_single_folder_asset_fr_df(i = 1, folder_df = folder_df, target_dir = tempdir()), + download_folder_asset = function(vol_id, folder_id, asset_id, file_name, target_dir, ...) { + captured <<- list( + vol_id = vol_id, + folder_id = folder_id, + asset_id = asset_id, + file_name = file_name, + target_dir = target_dir + ) + "downloaded-path" + } + ) + + expect_equal(result, "downloaded-path") + expect_equal(captured$vol_id, 1) + expect_equal(captured$folder_id, 2) + expect_equal(captured$asset_id, 3) + expect_true(grepl("demo.txt$", captured$file_name)) +}) + diff --git a/tests/testthat/test-download_single_session_asset_fr_df.R b/tests/testthat/test-download_single_session_asset_fr_df.R index 8cec8e34..263cccb8 100644 --- a/tests/testthat/test-download_single_session_asset_fr_df.R +++ b/tests/testthat/test-download_single_session_asset_fr_df.R @@ -1,44 +1,47 @@ # download_single_session_asset_fr_df --------------------------------------------------------- -test_that("download_single_session_asset_fr_df rejects bad input parameters", - { - expect_error(download_single_session_asset_fr_df(session_asset_entry = 3)) - expect_error(download_single_session_asset_fr_df(session_asset_entry = "a")) - expect_error(download_single_session_asset_fr_df(session_asset_entry = TRUE)) - expect_error(download_single_session_asset_fr_df(session_asset_entry = list(a = 1, b = - 2))) - - expect_error(download_single_session_asset_fr_df(target_dir = 3)) - expect_error(download_single_session_asset_fr_df(target_dir = list(a = 1, b = - 2))) - expect_error(download_single_session_asset_fr_df(target_dir = TRUE)) - - expect_error(download_single_session_asset_fr_df(add_session_subdir = -1)) - expect_error(download_single_session_asset_fr_df(add_session_subdir = 3)) - expect_error(download_single_session_asset_fr_df(add_session_subdir = "a")) - expect_error(download_single_session_asset_fr_df(add_session_subdir = list(a = 1, b = 2))) - - expect_error(download_single_session_asset_fr_df(overwrite = -1)) - expect_error(download_single_session_asset_fr_df(overwrite = 3)) - expect_error(download_single_session_asset_fr_df(overwrite = "a")) - expect_error(download_single_session_asset_fr_df(overwrite = list(a = 1, b = 2))) - - expect_error(download_single_session_asset_fr_df(make_portable_fn = -1)) - expect_error(download_single_session_asset_fr_df(make_portable_fn = 3)) - expect_error(download_single_session_asset_fr_df(make_portable_fn = "a")) - expect_error(download_single_session_asset_fr_df(make_portable_fn = list(a = 1, b = 2))) - - expect_error(download_single_session_asset_fr_df(timeout_secs = -1)) - expect_error(download_single_session_asset_fr_df(timeout_secs = TRUE)) - expect_error(download_single_session_asset_fr_df(timeout_secs = "a")) - expect_error(download_single_session_asset_fr_df(timeout_secs = list(a = 1, b = 2))) - - expect_error(download_single_session_asset_fr_df(vb = -1)) - expect_error(download_single_session_asset_fr_df(vb = 3)) - expect_error(download_single_session_asset_fr_df(vb = "a")) - expect_error(download_single_session_asset_fr_df(vb = list(a = 1, b = 2))) - - expect_error(download_single_session_asset_fr_df(rq = "a")) - expect_error(download_single_session_asset_fr_df(rq = -1)) - expect_error(download_single_session_asset_fr_df(rq = c(2, 3))) - expect_error(download_single_session_asset_fr_df(rq = list(a = 1, b = 2))) - }) +test_that("download_single_session_asset_fr_df rejects bad input parameters", { + expect_error(download_single_session_asset_fr_df(i = 0)) + expect_error(download_single_session_asset_fr_df(i = -1)) + expect_error(download_single_session_asset_fr_df(i = "a")) + + expect_error(download_single_session_asset_fr_df(session_df = 3)) + expect_error(download_single_session_asset_fr_df(session_df = "a")) + expect_error(download_single_session_asset_fr_df(session_df = TRUE)) + + missing_cols <- data.frame(vol_id = 1, session_id = 1, asset_id = 1) + expect_error(download_single_session_asset_fr_df(i = 1, session_df = missing_cols)) + + expect_error(download_single_session_asset_fr_df(i = 1, target_dir = 3)) + expect_error(download_single_session_asset_fr_df(i = 1, target_dir = list(a = 1, b = 2))) + expect_error(download_single_session_asset_fr_df(i = 1, target_dir = TRUE)) + + expect_error(download_single_session_asset_fr_df(i = 1, add_session_subdir = -1)) + expect_error(download_single_session_asset_fr_df(i = 1, add_session_subdir = 3)) + expect_error(download_single_session_asset_fr_df(i = 1, add_session_subdir = "a")) + expect_error(download_single_session_asset_fr_df(i = 1, add_session_subdir = list(a = 1, b = 2))) + + expect_error(download_single_session_asset_fr_df(i = 1, overwrite = -1)) + expect_error(download_single_session_asset_fr_df(i = 1, overwrite = 3)) + expect_error(download_single_session_asset_fr_df(i = 1, overwrite = "a")) + expect_error(download_single_session_asset_fr_df(i = 1, overwrite = list(a = 1, b = 2))) + + expect_error(download_single_session_asset_fr_df(i = 1, make_portable_fn = -1)) + expect_error(download_single_session_asset_fr_df(i = 1, make_portable_fn = 3)) + expect_error(download_single_session_asset_fr_df(i = 1, make_portable_fn = "a")) + expect_error(download_single_session_asset_fr_df(i = 1, make_portable_fn = list(a = 1, b = 2))) + + expect_error(download_single_session_asset_fr_df(i = 1, timeout_secs = -1)) + expect_error(download_single_session_asset_fr_df(i = 1, timeout_secs = TRUE)) + expect_error(download_single_session_asset_fr_df(i = 1, timeout_secs = "a")) + expect_error(download_single_session_asset_fr_df(i = 1, timeout_secs = list(a = 1, b = 2))) + + expect_error(download_single_session_asset_fr_df(i = 1, vb = -1)) + expect_error(download_single_session_asset_fr_df(i = 1, vb = 3)) + expect_error(download_single_session_asset_fr_df(i = 1, vb = "a")) + expect_error(download_single_session_asset_fr_df(i = 1, vb = list(a = 1, b = 2))) + + expect_error(download_single_session_asset_fr_df(i = 1, rq = "a")) + expect_error(download_single_session_asset_fr_df(i = 1, rq = -1)) + expect_error(download_single_session_asset_fr_df(i = 1, rq = c(2, 3))) + expect_error(download_single_session_asset_fr_df(i = 1, rq = list(a = 1, b = 2))) +}) diff --git a/tests/testthat/test-download_video.R b/tests/testthat/test-download_video.R index 90af42ee..41f11d70 100644 --- a/tests/testthat/test-download_video.R +++ b/tests/testthat/test-download_video.R @@ -1,29 +1,41 @@ # download_video --------------------------------------------------------- test_that("download_video rejects bad input parameters", { - expect_error(download_asset(asset_id = -1)) - expect_error(download_asset(asset_id = 0)) - expect_error(download_asset(asset_id = "a")) - expect_error(download_asset(asset_id = list(a=1, b=2))) - expect_error(download_asset(asset_id = TRUE)) - - expect_error(download_asset(session_id = -1)) - expect_error(download_asset(session_id = 0)) - expect_error(download_asset(session_id = "a")) - expect_error(download_asset(session_id = list(a=1, b=2))) - expect_error(download_asset(session_id = TRUE)) + expect_error(download_video(vol_id = -1)) + expect_error(download_video(vol_id = 0)) + expect_error(download_video(vol_id = "a")) + expect_error(download_video(vol_id = list(a = 1, b = 2))) + expect_error(download_video(vol_id = TRUE)) + + expect_error(download_video(asset_id = -1)) + expect_error(download_video(asset_id = 0)) + expect_error(download_video(asset_id = "a")) + expect_error(download_video(asset_id = list(a = 1, b = 2))) + expect_error(download_video(asset_id = TRUE)) + + expect_error(download_video(session_id = -1)) + expect_error(download_video(session_id = 0)) + expect_error(download_video(session_id = "a")) + expect_error(download_video(session_id = list(a = 1, b = 2))) + expect_error(download_video(session_id = TRUE)) expect_error(download_video(file_name = 3)) - expect_error(download_video(file_name = list(a=1, b=2))) + expect_error(download_video(file_name = list(a = 1, b = 2))) expect_error(download_video(file_name = TRUE)) - + expect_error(download_video(file_name = "not_mp3")) + expect_error(download_video(target_dir = 3)) - expect_error(download_video(target_dir = list(a=1, b=2))) + expect_error(download_video(target_dir = list(a = 1, b = 2))) expect_error(download_video(target_dir = TRUE)) - + expect_error(download_video(vb = -1)) expect_error(download_video(vb = 3)) expect_error(download_video(vb = "a")) - expect_error(download_video(vb = list(a=1, b=2))) + expect_error(download_video(vb = list(a = 1, b = 2))) + + expect_error(download_video(rq = "a")) + expect_error(download_video(rq = -1)) + expect_error(download_video(rq = c(1, 2))) + expect_error(download_video(rq = list(a = 1, b = 2))) }) # Removing 2023-10-09 until Databrary system responds more quickly diff --git a/tests/testthat/test-download_volume_zip.R b/tests/testthat/test-download_volume_zip.R index 8c0bc589..35c5e254 100644 --- a/tests/testthat/test-download_volume_zip.R +++ b/tests/testthat/test-download_volume_zip.R @@ -2,25 +2,31 @@ test_that("download_volume_zip rejects bad input parameters", { expect_error(download_volume_zip(vol_id = -1)) expect_error(download_volume_zip(vol_id = "a")) - expect_error(download_volume_zip(vol_id = list(a=1, b=2))) + expect_error(download_volume_zip(vol_id = list(a = 1, b = 2))) expect_error(download_volume_zip(vol_id = TRUE)) - - expect_error(download_volume_zip(out_dir = -1)) - expect_error(download_volume_zip(out_dir = list(a=1, b=2))) - expect_error(download_volume_zip(out_dir = TRUE)) - - expect_error(download_volume_zip(file_name = -1)) - expect_error(download_volume_zip(file_name = list(a=1, b=2))) - expect_error(download_volume_zip(file_name = TRUE)) - + expect_error(download_volume_zip(vb = -1)) expect_error(download_volume_zip(vb = 3)) expect_error(download_volume_zip(vb = "a")) - expect_error(download_volume_zip(vb = list(a=1, b=2))) + expect_error(download_volume_zip(vb = list(a = 1, b = 2))) + + expect_error(download_volume_zip(rq = "a")) + expect_error(download_volume_zip(rq = -1)) + expect_error(download_volume_zip(rq = c(1, 2))) }) -test_that("download_volume_zip returns string", { - testthat::skip("Download route still under migration to Django signed-link workflow") - expect_true(is.character(download_volume_zip())) +test_that("download_volume_zip returns processing task", { + captured_path <- NULL + fake_task <- list(status = "processing", message = "queued", task_id = "abc") + task <- with_mocked_bindings( + download_volume_zip(), + request_processing_task = function(path, rq = NULL, vb = FALSE) { + captured_path <<- path + fake_task + } + ) + + expect_identical(task, fake_task) + expect_equal(captured_path, sprintf("/volumes/%s/download-link/", 31)) }) From b4e3e3dacad97ce7b69a2fdc46de516371cad0bd Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Mon, 8 Dec 2025 13:57:37 +0100 Subject: [PATCH 04/77] fix(api): update get_db_stats to match new API response structure The Databrary API now returns different field names (institutions, affiliates, investigators, hours_of_recordings) instead of the legacy fields (authorized_users, total_volumes, etc.). Updated the function to map new fields while keeping legacy fields as NA for backwards compatibility. --- R/get_db_stats.R | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/R/get_db_stats.R b/R/get_db_stats.R index c42b7c14..239ac0f2 100644 --- a/R/get_db_stats.R +++ b/R/get_db_stats.R @@ -70,16 +70,23 @@ get_db_stats <- function(type = "stats", } if (type %in% c("stats", "numbers")) { + # Map new API field names to output tibble::tibble( date = Sys.time(), - investors = stats$authorized_users, - datasets_total = stats$total_volumes, - datasets_shared = stats$public_volumes, - n_files = stats$total_files, - hours = stats$total_duration_hours, - TB = stats$total_storage_tb + institutions = if (!is.null(stats$institutions)) stats$institutions else NA_integer_, + affiliates = if (!is.null(stats$affiliates)) stats$affiliates else NA_integer_, + investigators = if (!is.null(stats$investigators)) stats$investigators else NA_integer_, + hours_of_recordings = if (!is.null(stats$hours_of_recordings)) stats$hours_of_recordings else NA_integer_, + # Legacy fields (may not be present in new API) + authorized_users = if (!is.null(stats$authorized_users)) stats$authorized_users else NA_integer_, + total_volumes = if (!is.null(stats$total_volumes)) stats$total_volumes else NA_integer_, + public_volumes = if (!is.null(stats$public_volumes)) stats$public_volumes else NA_integer_, + total_files = if (!is.null(stats$total_files)) stats$total_files else NA_integer_, + total_duration_hours = if (!is.null(stats$total_duration_hours)) stats$total_duration_hours else NA_real_, + total_storage_tb = if (!is.null(stats$total_storage_tb)) stats$total_storage_tb else NA_real_ ) } else { - tibble::as_tibble(stats$recent_activity) + # For other types, return the raw stats as a tibble + tibble::as_tibble(stats) } } From 82366c6a7f8d9ed4cd0144a5aa101c8cf49d31df Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Wed, 10 Dec 2025 10:00:47 +0100 Subject: [PATCH 05/77] feat: add get_funder_by_id() for direct funder lookup by ID - Add API constant for funder detail endpoint - Implement get_funder_by_id() function - Add test suite (11 test cases) - Add function documentation --- NAMESPACE | 1 + R/CONSTANTS.R | 1 + R/get_funder_by_id.R | 67 +++++++++++++++ man/get_funder_by_id.Rd | 34 ++++++++ tests/testthat/test-get_funder_by_id.R | 111 +++++++++++++++++++++++++ 5 files changed, 214 insertions(+) create mode 100644 R/get_funder_by_id.R create mode 100644 man/get_funder_by_id.Rd create mode 100644 tests/testthat/test-get_funder_by_id.R diff --git a/NAMESPACE b/NAMESPACE index 765a14b6..d96b6c2e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,6 +18,7 @@ export(download_volume_zip) export(get_db_stats) export(get_file_duration) export(get_folder_by_id) +export(get_funder_by_id) export(get_institution_by_id) export(get_permission_levels) export(get_release_levels) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index f6d676be..6f07bd57 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -40,6 +40,7 @@ API_SEARCH_VOLUMES <- "/search/volumes/" API_SEARCH_USERS <- "/search/users/" API_SEARCH_INSTITUTIONS <- "/search/institutions/" API_FUNDERS <- "/funders/" +API_FUNDER_DETAIL <- "/funders/%s/" RETRY_LIMIT <- 3 RETRY_WAIT_TIME <- 1 # seconds diff --git a/R/get_funder_by_id.R b/R/get_funder_by_id.R new file mode 100644 index 00000000..01c688ed --- /dev/null +++ b/R/get_funder_by_id.R @@ -0,0 +1,67 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get Funder Information By ID +#' +#' @description Retrieve detailed information about a specific funder from +#' Databrary using its unique identifier. +#' +#' @param funder_id Numeric funder identifier. Must be a positive integer. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return A list with the funder's metadata including id, name, and approval +#' status, or `NULL` if the funder is not found or inaccessible. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Get details for a specific funder +#' get_funder_by_id(funder_id = 1) +#' +#' # Get funder information with verbose output +#' get_funder_by_id(funder_id = 1, vb = TRUE) +#' } +#' } +#' @export +get_funder_by_id <- function(funder_id = 1, + vb = options::opt("vb"), + rq = NULL) { + # Validate funder_id + assertthat::assert_that(is.numeric(funder_id)) + assertthat::assert_that(length(funder_id) == 1) + assertthat::assert_that(funder_id > 0) + assertthat::assert_that(funder_id == floor(funder_id), + msg = "funder_id must be an integer") + + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Perform API call + funder <- perform_api_get( + path = sprintf(API_FUNDER_DETAIL, funder_id), + rq = rq, + vb = vb + ) + + if (is.null(funder)) { + if (vb) { + message("Funder ", funder_id, " not found or inaccessible.") + } + return(NULL) + } + + # Return structured list + list( + funder_id = funder$id, + funder_name = funder$name, + funder_is_approved = funder$is_approved + ) +} \ No newline at end of file diff --git a/man/get_funder_by_id.Rd b/man/get_funder_by_id.Rd new file mode 100644 index 00000000..70c66bd5 --- /dev/null +++ b/man/get_funder_by_id.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_funder_by_id.R +\name{get_funder_by_id} +\alias{get_funder_by_id} +\title{Get Funder Information By ID} +\usage{ +get_funder_by_id(funder_id = 1, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{funder_id}{Numeric funder identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the funder's metadata including id, name, and approval +status, or \code{NULL} if the funder is not found or inaccessible. +} +\description{ +Retrieve detailed information about a specific funder from +Databrary using its unique identifier. +} +\examples{ +\donttest{ +\dontrun{ +# Get details for a specific funder +get_funder_by_id(funder_id = 1) + +# Get funder information with verbose output +get_funder_by_id(funder_id = 1, vb = TRUE) +} +} +} diff --git a/tests/testthat/test-get_funder_by_id.R b/tests/testthat/test-get_funder_by_id.R new file mode 100644 index 00000000..95fe7cd4 --- /dev/null +++ b/tests/testthat/test-get_funder_by_id.R @@ -0,0 +1,111 @@ +# get_funder_by_id() --------------------------------------------------- +login_test_account() + +test_that("get_funder_by_id retrieves valid funder", { + # Test with a known funder ID (assuming ID 1 exists in test environment) + result <- get_funder_by_id(funder_id = 1) + skip_if_null_response(result, "get_funder_by_id(1)") + + expect_type(result, "list") + expect_named(result, c("funder_id", "funder_name", "funder_is_approved")) + expect_equal(result$funder_id, 1) + expect_type(result$funder_name, "character") + expect_type(result$funder_is_approved, "logical") +}) + +test_that("get_funder_by_id returns NULL for non-existent funder", { + # Use a very large ID that likely doesn't exist + result <- get_funder_by_id(funder_id = 999999, vb = FALSE) + expect_null(result) +}) + +test_that("get_funder_by_id works with verbose mode", { + result <- get_funder_by_id(funder_id = 1, vb = TRUE) + skip_if_null_response(result, "get_funder_by_id(1, vb = TRUE)") + + expect_type(result, "list") + expect_true(!is.null(result$funder_id)) +}) + +test_that("get_funder_by_id rejects invalid funder_id", { + # Negative ID + expect_error(get_funder_by_id(funder_id = -1)) + + # Zero ID + expect_error(get_funder_by_id(funder_id = 0)) + + # Non-numeric ID + expect_error(get_funder_by_id(funder_id = "1")) + expect_error(get_funder_by_id(funder_id = TRUE)) + expect_error(get_funder_by_id(funder_id = list(a = 1))) + + # Multiple values + expect_error(get_funder_by_id(funder_id = c(1, 2))) + + # Decimal/non-integer + expect_error(get_funder_by_id(funder_id = 1.5)) + expect_error(get_funder_by_id(funder_id = 2.7)) + + # NULL + expect_error(get_funder_by_id(funder_id = NULL)) + + # NA + expect_error(get_funder_by_id(funder_id = NA)) +}) + +test_that("get_funder_by_id rejects invalid vb parameter", { + expect_error(get_funder_by_id(funder_id = 1, vb = -1)) + expect_error(get_funder_by_id(funder_id = 1, vb = 3)) + expect_error(get_funder_by_id(funder_id = 1, vb = "a")) + expect_error(get_funder_by_id(funder_id = 1, vb = list(a = 1, b = 2))) + expect_error(get_funder_by_id(funder_id = 1, vb = c(TRUE, FALSE))) + expect_error(get_funder_by_id(funder_id = 1, vb = NULL)) +}) + +test_that("get_funder_by_id rejects invalid rq parameter", { + expect_error(get_funder_by_id(funder_id = 1, rq = "a")) + expect_error(get_funder_by_id(funder_id = 1, rq = -1)) + expect_error(get_funder_by_id(funder_id = 1, rq = c(2, 3))) + expect_error(get_funder_by_id(funder_id = 1, rq = list(a = 1, b = 2))) + expect_error(get_funder_by_id(funder_id = 1, rq = TRUE)) +}) + +test_that("get_funder_by_id result structure is consistent", { + result <- get_funder_by_id(funder_id = 1) + skip_if_null_response(result, "get_funder_by_id(1)") + + # Check that all expected fields exist + expect_true(all(c("funder_id", "funder_name", "funder_is_approved") %in% names(result))) + + # Check field types + expect_true(is.numeric(result$funder_id) || is.integer(result$funder_id)) + expect_true(is.character(result$funder_name)) + expect_true(is.logical(result$funder_is_approved)) + + # Check that funder_id matches the requested ID + expect_equal(result$funder_id, 1) +}) + +test_that("get_funder_by_id can retrieve multiple different funders", { + result1 <- get_funder_by_id(funder_id = 1, vb = FALSE) + skip_if_null_response(result1, "get_funder_by_id(1)") + + # Try to get another funder (if available) + result2 <- get_funder_by_id(funder_id = 2, vb = FALSE) + + # If both exist, they should be different + if (!is.null(result2)) { + expect_false(identical(result1$funder_name, result2$funder_name)) + expect_equal(result1$funder_id, 1) + expect_equal(result2$funder_id, 2) + } +}) + +test_that("get_funder_by_id works with custom request object", { + custom_rq <- databraryr::make_default_request() + result <- get_funder_by_id(funder_id = 1, rq = custom_rq) + skip_if_null_response(result, "get_funder_by_id(1, rq = custom_rq)") + + expect_type(result, "list") + expect_equal(result$funder_id, 1) +}) \ No newline at end of file From 79355a8464b5c2ffa875c51d893a41b7bb5d0ca7 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Wed, 10 Dec 2025 10:21:08 +0100 Subject: [PATCH 06/77] feat: add get_tag_by_id() for direct tag lookup by ID - Add API constant for tag detail endpoint - Implement get_tag_by_id() function - Add test suite (12 test cases) - Add function documentation --- NAMESPACE | 1 + R/CONSTANTS.R | 1 + R/get_tag_by_id.R | 66 +++++++++++++++ man/get_tag_by_id.Rd | 34 ++++++++ tests/testthat/test-get_tag_by_id.R | 122 ++++++++++++++++++++++++++++ 5 files changed, 224 insertions(+) create mode 100644 R/get_tag_by_id.R create mode 100644 man/get_tag_by_id.Rd create mode 100644 tests/testthat/test-get_tag_by_id.R diff --git a/NAMESPACE b/NAMESPACE index d96b6c2e..c522432b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -25,6 +25,7 @@ export(get_release_levels) export(get_session_by_id) export(get_session_by_name) export(get_supported_file_types) +export(get_tag_by_id) export(get_user_by_id) export(get_volume_by_id) export(list_asset_formats) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 6f07bd57..6f32d68e 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -41,6 +41,7 @@ API_SEARCH_USERS <- "/search/users/" API_SEARCH_INSTITUTIONS <- "/search/institutions/" API_FUNDERS <- "/funders/" API_FUNDER_DETAIL <- "/funders/%s/" +API_TAG_DETAIL <- "/tags/%s/" RETRY_LIMIT <- 3 RETRY_WAIT_TIME <- 1 # seconds diff --git a/R/get_tag_by_id.R b/R/get_tag_by_id.R new file mode 100644 index 00000000..6f303145 --- /dev/null +++ b/R/get_tag_by_id.R @@ -0,0 +1,66 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get Tag Information By ID +#' +#' @description Retrieve detailed information about a specific tag from +#' Databrary using its unique identifier. +#' +#' @param tag_id Numeric tag identifier. Must be a positive integer. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return A list with the tag's metadata including id and name, +#' or `NULL` if the tag is not found or inaccessible. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Get details for a specific tag +#' get_tag_by_id(tag_id = 1) +#' +#' # Get tag information with verbose output +#' get_tag_by_id(tag_id = 1, vb = TRUE) +#' } +#' } +#' @export +get_tag_by_id <- function(tag_id = 1, + vb = options::opt("vb"), + rq = NULL) { + # Validate tag_id + assertthat::assert_that(is.numeric(tag_id)) + assertthat::assert_that(length(tag_id) == 1) + assertthat::assert_that(tag_id > 0) + assertthat::assert_that(tag_id == floor(tag_id), + msg = "tag_id must be an integer") + + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Perform API call + tag <- perform_api_get( + path = sprintf(API_TAG_DETAIL, tag_id), + rq = rq, + vb = vb + ) + + if (is.null(tag)) { + if (vb) { + message("Tag ", tag_id, " not found or inaccessible.") + } + return(NULL) + } + + # Return structured list + list( + tag_id = tag$id, + tag_name = tag$name + ) +} diff --git a/man/get_tag_by_id.Rd b/man/get_tag_by_id.Rd new file mode 100644 index 00000000..4c0d0e3a --- /dev/null +++ b/man/get_tag_by_id.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_tag_by_id.R +\name{get_tag_by_id} +\alias{get_tag_by_id} +\title{Get Tag Information By ID} +\usage{ +get_tag_by_id(tag_id = 1, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{tag_id}{Numeric tag identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the tag's metadata including id and name, +or \code{NULL} if the tag is not found or inaccessible. +} +\description{ +Retrieve detailed information about a specific tag from +Databrary using its unique identifier. +} +\examples{ +\donttest{ +\dontrun{ +# Get details for a specific tag +get_tag_by_id(tag_id = 1) + +# Get tag information with verbose output +get_tag_by_id(tag_id = 1, vb = TRUE) +} +} +} diff --git a/tests/testthat/test-get_tag_by_id.R b/tests/testthat/test-get_tag_by_id.R new file mode 100644 index 00000000..4008c665 --- /dev/null +++ b/tests/testthat/test-get_tag_by_id.R @@ -0,0 +1,122 @@ +# get_tag_by_id() --------------------------------------------------- +login_test_account() + +test_that("get_tag_by_id retrieves valid tag", { + # Test with a known tag ID (assuming ID 1 exists in test environment) + result <- get_tag_by_id(tag_id = 1) + skip_if_null_response(result, "get_tag_by_id(1)") + + expect_type(result, "list") + expect_named(result, c("tag_id", "tag_name")) + expect_equal(result$tag_id, 1) + expect_type(result$tag_name, "character") + expect_true(nchar(result$tag_name) > 0) +}) + +test_that("get_tag_by_id returns NULL for non-existent tag", { + # Use a very large ID that likely doesn't exist + result <- get_tag_by_id(tag_id = 999999, vb = FALSE) + expect_null(result) +}) + +test_that("get_tag_by_id works with verbose mode", { + result <- get_tag_by_id(tag_id = 1, vb = TRUE) + skip_if_null_response(result, "get_tag_by_id(1, vb = TRUE)") + + expect_type(result, "list") + expect_true(!is.null(result$tag_id)) +}) + +test_that("get_tag_by_id rejects invalid tag_id", { + # Negative ID + expect_error(get_tag_by_id(tag_id = -1)) + + # Zero ID + expect_error(get_tag_by_id(tag_id = 0)) + + # Non-numeric ID + expect_error(get_tag_by_id(tag_id = "1")) + expect_error(get_tag_by_id(tag_id = TRUE)) + expect_error(get_tag_by_id(tag_id = list(a = 1))) + + # Multiple values + expect_error(get_tag_by_id(tag_id = c(1, 2))) + + # Decimal/non-integer + expect_error(get_tag_by_id(tag_id = 1.5)) + expect_error(get_tag_by_id(tag_id = 2.7)) + + # NULL + expect_error(get_tag_by_id(tag_id = NULL)) + + # NA + expect_error(get_tag_by_id(tag_id = NA)) +}) + +test_that("get_tag_by_id rejects invalid vb parameter", { + expect_error(get_tag_by_id(tag_id = 1, vb = -1)) + expect_error(get_tag_by_id(tag_id = 1, vb = 3)) + expect_error(get_tag_by_id(tag_id = 1, vb = "a")) + expect_error(get_tag_by_id(tag_id = 1, vb = list(a = 1, b = 2))) + expect_error(get_tag_by_id(tag_id = 1, vb = c(TRUE, FALSE))) + expect_error(get_tag_by_id(tag_id = 1, vb = NULL)) +}) + +test_that("get_tag_by_id rejects invalid rq parameter", { + expect_error(get_tag_by_id(tag_id = 1, rq = "a")) + expect_error(get_tag_by_id(tag_id = 1, rq = -1)) + expect_error(get_tag_by_id(tag_id = 1, rq = c(2, 3))) + expect_error(get_tag_by_id(tag_id = 1, rq = list(a = 1, b = 2))) + expect_error(get_tag_by_id(tag_id = 1, rq = TRUE)) +}) + +test_that("get_tag_by_id result structure is consistent", { + result <- get_tag_by_id(tag_id = 1) + skip_if_null_response(result, "get_tag_by_id(1)") + + # Check that all expected fields exist + expect_true(all(c("tag_id", "tag_name") %in% names(result))) + + # Check field types + expect_true(is.numeric(result$tag_id) || is.integer(result$tag_id)) + expect_true(is.character(result$tag_name)) + + # Check that tag_id matches the requested ID + expect_equal(result$tag_id, 1) + + # Check that tag_name is not empty + expect_true(nchar(result$tag_name) > 0) +}) + +test_that("get_tag_by_id can retrieve multiple different tags", { + result1 <- get_tag_by_id(tag_id = 1, vb = FALSE) + skip_if_null_response(result1, "get_tag_by_id(1)") + + # Try to get another tag (if available) + result2 <- get_tag_by_id(tag_id = 2, vb = FALSE) + + # If both exist, they should be different + if (!is.null(result2)) { + expect_false(identical(result1$tag_name, result2$tag_name)) + expect_equal(result1$tag_id, 1) + expect_equal(result2$tag_id, 2) + } +}) + +test_that("get_tag_by_id works with custom request object", { + custom_rq <- databraryr::make_default_request() + result <- get_tag_by_id(tag_id = 1, rq = custom_rq) + skip_if_null_response(result, "get_tag_by_id(1, rq = custom_rq)") + + expect_type(result, "list") + expect_equal(result$tag_id, 1) +}) + +test_that("get_tag_by_id returns simple structure with only id and name", { + result <- get_tag_by_id(tag_id = 1) + skip_if_null_response(result, "get_tag_by_id(1)") + + # Tag should only have id and name fields + expect_length(result, 2) + expect_named(result, c("tag_id", "tag_name")) +}) From 9a9bec5655fd6f12208daaa9194b088e1d9eab63 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Wed, 10 Dec 2025 10:43:17 +0100 Subject: [PATCH 07/77] feat: add get_category_by_id() function with tests - Added API_CATEGORY_DETAIL constant - Implemented get_category_by_id() to retrieve category by ID - Add test suite (12 test cases) - Add function documentation --- NAMESPACE | 1 + R/CONSTANTS.R | 1 + R/get_category_by_id.R | 86 ++++++++++++++ man/get_category_by_id.Rd | 35 ++++++ tests/testthat/test-get_category_by_id.R | 145 +++++++++++++++++++++++ 5 files changed, 268 insertions(+) create mode 100644 R/get_category_by_id.R create mode 100644 man/get_category_by_id.Rd create mode 100644 tests/testthat/test-get_category_by_id.R diff --git a/NAMESPACE b/NAMESPACE index c522432b..4cff29c7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,6 +15,7 @@ export(download_single_folder_asset_fr_df) export(download_single_session_asset_fr_df) export(download_video) export(download_volume_zip) +export(get_category_by_id) export(get_db_stats) export(get_file_duration) export(get_folder_by_id) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 6f32d68e..bea05d8a 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -42,6 +42,7 @@ API_SEARCH_INSTITUTIONS <- "/search/institutions/" API_FUNDERS <- "/funders/" API_FUNDER_DETAIL <- "/funders/%s/" API_TAG_DETAIL <- "/tags/%s/" +API_CATEGORY_DETAIL <- "/categories/%s/" RETRY_LIMIT <- 3 RETRY_WAIT_TIME <- 1 # seconds diff --git a/R/get_category_by_id.R b/R/get_category_by_id.R new file mode 100644 index 00000000..1b137692 --- /dev/null +++ b/R/get_category_by_id.R @@ -0,0 +1,86 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get Category Information By ID +#' +#' @description Retrieve detailed information about a specific category from +#' Databrary using its unique identifier. Categories include nested metrics +#' that define data collection fields. +#' +#' @param category_id Numeric category identifier. Must be a positive integer. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return A list with the category's metadata including id, name, description, +#' and nested metrics, or `NULL` if the category is not found or inaccessible. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Get details for a specific category +#' get_category_by_id(category_id = 1) +#' +#' # Get category information with verbose output +#' get_category_by_id(category_id = 1, vb = TRUE) +#' } +#' } +#' @export +get_category_by_id <- function(category_id = 1, + vb = options::opt("vb"), + rq = NULL) { + # Validate category_id + assertthat::assert_that(is.numeric(category_id)) + assertthat::assert_that(length(category_id) == 1) + assertthat::assert_that(category_id > 0) + assertthat::assert_that(category_id == floor(category_id), + msg = "category_id must be an integer") + + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Perform API call + category <- perform_api_get( + path = sprintf(API_CATEGORY_DETAIL, category_id), + rq = rq, + vb = vb + ) + + if (is.null(category)) { + if (vb) { + message("Category ", category_id, " not found or inaccessible.") + } + return(NULL) + } + + # Process metrics if present + metrics <- NULL + if (!is.null(category$metrics) && length(category$metrics) > 0) { + metrics <- lapply(category$metrics, function(metric) { + list( + metric_id = metric$id, + metric_name = metric$name, + metric_type = metric$type, + metric_release = metric$release, + metric_options = metric$options, + metric_assumed = metric$assumed, + metric_description = metric$description, + metric_required = metric$required + ) + }) + } + + # Return structured list + list( + category_id = category$id, + category_name = category$name, + category_description = category$description, + metrics = metrics + ) +} \ No newline at end of file diff --git a/man/get_category_by_id.Rd b/man/get_category_by_id.Rd new file mode 100644 index 00000000..a5c08edc --- /dev/null +++ b/man/get_category_by_id.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_category_by_id.R +\name{get_category_by_id} +\alias{get_category_by_id} +\title{Get Category Information By ID} +\usage{ +get_category_by_id(category_id = 1, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{category_id}{Numeric category identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the category's metadata including id, name, description, +and nested metrics, or \code{NULL} if the category is not found or inaccessible. +} +\description{ +Retrieve detailed information about a specific category from +Databrary using its unique identifier. Categories include nested metrics +that define data collection fields. +} +\examples{ +\donttest{ +\dontrun{ +# Get details for a specific category +get_category_by_id(category_id = 1) + +# Get category information with verbose output +get_category_by_id(category_id = 1, vb = TRUE) +} +} +} diff --git a/tests/testthat/test-get_category_by_id.R b/tests/testthat/test-get_category_by_id.R new file mode 100644 index 00000000..2b29034e --- /dev/null +++ b/tests/testthat/test-get_category_by_id.R @@ -0,0 +1,145 @@ +# get_category_by_id() --------------------------------------------------- +login_test_account() + +test_that("get_category_by_id retrieves valid category", { + # Test with a known category ID (assuming ID 1 exists in test environment) + result <- get_category_by_id(category_id = 1) + skip_if_null_response(result, "get_category_by_id(1)") + + expect_type(result, "list") + expect_named(result, c("category_id", "category_name", "category_description", "metrics")) + expect_equal(result$category_id, 1) + expect_type(result$category_name, "character") + expect_true(nchar(result$category_name) > 0) +}) + +test_that("get_category_by_id returns NULL for non-existent category", { + # Use a very large ID that likely doesn't exist + result <- get_category_by_id(category_id = 999999, vb = FALSE) + expect_null(result) +}) + +test_that("get_category_by_id works with verbose mode", { + result <- get_category_by_id(category_id = 1, vb = TRUE) + skip_if_null_response(result, "get_category_by_id(1, vb = TRUE)") + + expect_type(result, "list") + expect_true(!is.null(result$category_id)) +}) + +test_that("get_category_by_id rejects invalid category_id", { + # Negative ID + expect_error(get_category_by_id(category_id = -1)) + + # Zero ID + expect_error(get_category_by_id(category_id = 0)) + + # Non-numeric ID + expect_error(get_category_by_id(category_id = "1")) + expect_error(get_category_by_id(category_id = TRUE)) + expect_error(get_category_by_id(category_id = list(a = 1))) + + # Multiple values + expect_error(get_category_by_id(category_id = c(1, 2))) + + # Decimal/non-integer + expect_error(get_category_by_id(category_id = 1.5)) + expect_error(get_category_by_id(category_id = 2.7)) + + # NULL + expect_error(get_category_by_id(category_id = NULL)) + + # NA + expect_error(get_category_by_id(category_id = NA)) +}) + +test_that("get_category_by_id rejects invalid vb parameter", { + expect_error(get_category_by_id(category_id = 1, vb = -1)) + expect_error(get_category_by_id(category_id = 1, vb = 3)) + expect_error(get_category_by_id(category_id = 1, vb = "a")) + expect_error(get_category_by_id(category_id = 1, vb = list(a = 1, b = 2))) + expect_error(get_category_by_id(category_id = 1, vb = c(TRUE, FALSE))) + expect_error(get_category_by_id(category_id = 1, vb = NULL)) +}) + +test_that("get_category_by_id rejects invalid rq parameter", { + expect_error(get_category_by_id(category_id = 1, rq = "a")) + expect_error(get_category_by_id(category_id = 1, rq = -1)) + expect_error(get_category_by_id(category_id = 1, rq = c(2, 3))) + expect_error(get_category_by_id(category_id = 1, rq = list(a = 1, b = 2))) + expect_error(get_category_by_id(category_id = 1, rq = TRUE)) +}) + +test_that("get_category_by_id result structure is consistent", { + result <- get_category_by_id(category_id = 1) + skip_if_null_response(result, "get_category_by_id(1)") + + # Check that all expected fields exist + expect_true(all(c("category_id", "category_name", "category_description", "metrics") %in% names(result))) + + # Check field types + expect_true(is.numeric(result$category_id) || is.integer(result$category_id)) + expect_true(is.character(result$category_name)) + expect_true(is.character(result$category_description) || is.null(result$category_description)) + expect_true(is.list(result$metrics) || is.null(result$metrics)) + + # Check that category_id matches the requested ID + expect_equal(result$category_id, 1) + + # Check that category_name is not empty + expect_true(nchar(result$category_name) > 0) +}) + +test_that("get_category_by_id can retrieve multiple different categories", { + result1 <- get_category_by_id(category_id = 1, vb = FALSE) + skip_if_null_response(result1, "get_category_by_id(1)") + + # Try to get another category (if available) + result2 <- get_category_by_id(category_id = 2, vb = FALSE) + + # If both exist, they should be different + if (!is.null(result2)) { + expect_false(identical(result1$category_name, result2$category_name)) + expect_equal(result1$category_id, 1) + expect_equal(result2$category_id, 2) + } +}) + +test_that("get_category_by_id works with custom request object", { + custom_rq <- databraryr::make_default_request() + result <- get_category_by_id(category_id = 1, rq = custom_rq) + skip_if_null_response(result, "get_category_by_id(1, rq = custom_rq)") + + expect_type(result, "list") + expect_equal(result$category_id, 1) +}) + +test_that("get_category_by_id handles metrics properly", { + result <- get_category_by_id(category_id = 1) + skip_if_null_response(result, "get_category_by_id(1)") + + # If metrics exist, check their structure + if (!is.null(result$metrics) && length(result$metrics) > 0) { + expect_type(result$metrics, "list") + + # Check first metric structure + first_metric <- result$metrics[[1]] + expected_fields <- c("metric_id", "metric_name", "metric_type", "metric_release", + "metric_options", "metric_assumed", "metric_description", "metric_required") + expect_true(all(expected_fields %in% names(first_metric))) + + # Check that metric_id and metric_name are not NULL + expect_true(!is.null(first_metric$metric_id)) + expect_true(!is.null(first_metric$metric_name)) + expect_true(!is.null(first_metric$metric_type)) + } +}) + +test_that("get_category_by_id returns expected structure with all fields", { + result <- get_category_by_id(category_id = 1) + skip_if_null_response(result, "get_category_by_id(1)") + + # Category should have id, name, description, and metrics fields + expect_length(result, 4) + expect_named(result, c("category_id", "category_name", "category_description", "metrics")) +}) \ No newline at end of file From 4f10d6f90f50961453acc4790e81757b09cc1aac Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Wed, 10 Dec 2025 11:00:30 +0100 Subject: [PATCH 08/77] feat: add list_categories() function with tests - Added API_CATEGORIES constant - Implemented list_categories() to retrieve all categories - Add test suite (10 test cases) - Add function documentation --- NAMESPACE | 1 + R/CONSTANTS.R | 1 + R/list_categories.R | 79 ++++++++++++++++++ man/list_categories.Rd | 33 ++++++++ tests/testthat/test-list_categories.R | 110 ++++++++++++++++++++++++++ 5 files changed, 224 insertions(+) create mode 100644 R/list_categories.R create mode 100644 man/list_categories.Rd create mode 100644 tests/testthat/test-list_categories.R diff --git a/NAMESPACE b/NAMESPACE index 4cff29c7..bbefb667 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -31,6 +31,7 @@ export(get_user_by_id) export(get_volume_by_id) export(list_asset_formats) export(list_authorized_investigators) +export(list_categories) export(list_folder_assets) export(list_institution_affiliates) export(list_session_activity) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index bea05d8a..9837f777 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -42,6 +42,7 @@ API_SEARCH_INSTITUTIONS <- "/search/institutions/" API_FUNDERS <- "/funders/" API_FUNDER_DETAIL <- "/funders/%s/" API_TAG_DETAIL <- "/tags/%s/" +API_CATEGORIES <- "/categories/" API_CATEGORY_DETAIL <- "/categories/%s/" RETRY_LIMIT <- 3 diff --git a/R/list_categories.R b/R/list_categories.R new file mode 100644 index 00000000..338a8b84 --- /dev/null +++ b/R/list_categories.R @@ -0,0 +1,79 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List Databrary Categories +#' +#' @description Retrieve all available categories from Databrary. Categories +#' define different types of data collection sessions and include nested +#' metrics that specify the data fields collected for each category. +#' +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return A tibble containing metadata for each category including id, name, +#' description, and nested metrics, or `NULL` when no results are available. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # List all categories +#' list_categories() +#' +#' # List with verbose output +#' list_categories(vb = TRUE) +#' } +#' } +#' @export +list_categories <- function(vb = options::opt("vb"), + rq = NULL) { + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Perform API call + categories <- perform_api_get( + path = API_CATEGORIES, + rq = rq, + vb = vb + ) + + if (is.null(categories) || length(categories) == 0) { + if (vb) { + message("No categories available.") + } + return(NULL) + } + + # Process categories into tibble + purrr::map_dfr(categories, function(category) { + # Process metrics if present + metrics <- NULL + if (!is.null(category$metrics) && length(category$metrics) > 0) { + metrics <- lapply(category$metrics, function(metric) { + list( + metric_id = metric$id, + metric_name = metric$name, + metric_type = metric$type, + metric_release = metric$release, + metric_options = metric$options, + metric_assumed = metric$assumed, + metric_description = metric$description, + metric_required = metric$required + ) + }) + } + + tibble::tibble( + category_id = category$id, + category_name = category$name, + category_description = if (is.null(category$description)) NA_character_ else category$description, + metrics = list(metrics) + ) + }) +} diff --git a/man/list_categories.Rd b/man/list_categories.Rd new file mode 100644 index 00000000..1bce307c --- /dev/null +++ b/man/list_categories.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_categories.R +\name{list_categories} +\alias{list_categories} +\title{List Databrary Categories} +\usage{ +list_categories(vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A tibble containing metadata for each category including id, name, +description, and nested metrics, or \code{NULL} when no results are available. +} +\description{ +Retrieve all available categories from Databrary. Categories +define different types of data collection sessions and include nested +metrics that specify the data fields collected for each category. +} +\examples{ +\donttest{ +\dontrun{ +# List all categories +list_categories() + +# List with verbose output +list_categories(vb = TRUE) +} +} +} diff --git a/tests/testthat/test-list_categories.R b/tests/testthat/test-list_categories.R new file mode 100644 index 00000000..a88170a8 --- /dev/null +++ b/tests/testthat/test-list_categories.R @@ -0,0 +1,110 @@ +# list_categories ------------------------------------------------------------- +login_test_account() + +test_that("list_categories returns tibble with categories", { + result <- list_categories() + skip_if_null_response(result, "list_categories()") + + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(all(c("category_id", "category_name", "category_description", "metrics") %in% names(result))) +}) + +test_that("list_categories returns valid category structure", { + result <- list_categories(vb = FALSE) + skip_if_null_response(result, "list_categories()") + + # Check column types + expect_true(is.numeric(result$category_id) || is.integer(result$category_id)) + expect_type(result$category_name, "character") + expect_type(result$category_description, "character") + expect_type(result$metrics, "list") + + # Check that category_ids are positive + expect_true(all(result$category_id > 0)) + + # Check that category names are not empty + expect_true(all(nchar(result$category_name) > 0)) +}) + +test_that("list_categories works with verbose mode", { + result <- list_categories(vb = TRUE) + skip_if_null_response(result, "list_categories(vb = TRUE)") + + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) +}) + +test_that("list_categories rejects invalid vb parameter", { + expect_error(list_categories(vb = -1)) + expect_error(list_categories(vb = 3)) + expect_error(list_categories(vb = "a")) + expect_error(list_categories(vb = list(a = 1, b = 2))) + expect_error(list_categories(vb = c(TRUE, FALSE))) + expect_error(list_categories(vb = NULL)) +}) + +test_that("list_categories rejects invalid rq parameter", { + expect_error(list_categories(rq = "a")) + expect_error(list_categories(rq = -1)) + expect_error(list_categories(rq = c(2, 3))) + expect_error(list_categories(rq = list(a = 1, b = 2))) + expect_error(list_categories(rq = TRUE)) +}) + +test_that("list_categories handles metrics correctly", { + result <- list_categories() + skip_if_null_response(result, "list_categories()") + + # Check that metrics column exists and is a list + expect_true("metrics" %in% names(result)) + expect_type(result$metrics, "list") + + # If any category has metrics, check their structure + has_metrics <- sapply(result$metrics, function(m) !is.null(m) && length(m) > 0) + if (any(has_metrics)) { + # Get first category with metrics + first_with_metrics <- which(has_metrics)[1] + metrics <- result$metrics[[first_with_metrics]] + + expect_type(metrics, "list") + expect_gt(length(metrics), 0) + + # Check first metric structure + first_metric <- metrics[[1]] + expected_fields <- c("metric_id", "metric_name", "metric_type", "metric_release", + "metric_options", "metric_assumed", "metric_description", "metric_required") + expect_true(all(expected_fields %in% names(first_metric))) + expect_true(!is.null(first_metric$metric_id)) + expect_true(!is.null(first_metric$metric_name)) + expect_true(!is.null(first_metric$metric_type)) + } +}) + +test_that("list_categories works with custom request object", { + custom_rq <- databraryr::make_default_request() + result <- list_categories(rq = custom_rq) + skip_if_null_response(result, "list_categories(rq = custom_rq)") + + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) +}) + +test_that("list_categories returns consistent number of rows across calls", { + result1 <- list_categories(vb = FALSE) + skip_if_null_response(result1, "list_categories() first call") + + result2 <- list_categories(vb = FALSE) + skip_if_null_response(result2, "list_categories() second call") + + # Number of categories should be stable + expect_equal(nrow(result1), nrow(result2)) +}) + +test_that("list_categories has unique category IDs", { + result <- list_categories() + skip_if_null_response(result, "list_categories()") + + # All category IDs should be unique + expect_equal(length(unique(result$category_id)), nrow(result)) +}) From 92ab1181d0ef7786ec74f7317db67fa5c65a84f0 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Wed, 10 Dec 2025 11:44:01 +0100 Subject: [PATCH 09/77] feat: add list_volume_records() function with tests - Added API_VOLUME_RECORDS constant - Implemented list_volume_records() to retrieve participant records from volumes - Add test suite (14 test cases) - Add function documentation --- NAMESPACE | 1 + R/CONSTANTS.R | 1 + R/list_volume_records.R | 121 +++++++++++++++++ man/list_volume_records.Rd | 47 +++++++ tests/testthat/test-list_volume_records.R | 157 ++++++++++++++++++++++ 5 files changed, 327 insertions(+) create mode 100644 R/list_volume_records.R create mode 100644 man/list_volume_records.Rd create mode 100644 tests/testthat/test-list_volume_records.R diff --git a/NAMESPACE b/NAMESPACE index bbefb667..1b98e87e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -48,6 +48,7 @@ export(list_volume_folders) export(list_volume_funding) export(list_volume_info) export(list_volume_links) +export(list_volume_records) export(list_volume_session_assets) export(list_volume_sessions) export(list_volume_tags) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 9837f777..a6bb8a30 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -24,6 +24,7 @@ API_VOLUME_COLLABORATORS <- "/volumes/%s/collaborators/" API_VOLUME_HISTORY <- "/volumes/%s/history/" API_VOLUME_SESSIONS <- "/volumes/%s/sessions/" API_VOLUME_FOLDERS <- "/volumes/%s/folders/" +API_VOLUME_RECORDS <- "/volumes/%s/records/" API_SESSION_DETAIL <- "/volumes/%s/sessions/%s/" API_SESSION_FILES <- "/volumes/%s/sessions/%s/files/" API_SESSION_FILE_DETAIL <- "/volumes/%s/sessions/%s/files/%s/" diff --git a/R/list_volume_records.R b/R/list_volume_records.R new file mode 100644 index 00000000..c67ffdf3 --- /dev/null +++ b/R/list_volume_records.R @@ -0,0 +1,121 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List Records in Databrary Volume +#' +#' @description Retrieve all records (participant data with measures) from a +#' specific Databrary volume. Records contain participant information including +#' age, birthday, category, and associated measures collected during sessions. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param category_id Optional numeric category identifier to filter records +#' by category type. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return A tibble containing metadata for each record including id, volume, +#' category_id, measures, birthday, and age information, or `NULL` when no +#' records are available. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # List all records in volume 1 +#' list_volume_records(vol_id = 1) +#' +#' # Filter records by category +#' list_volume_records(vol_id = 1, category_id = 2) +#' +#' # With verbose output +#' list_volume_records(vol_id = 1, vb = TRUE) +#' } +#' } +#' @export +list_volume_records <- function(vol_id = 1, + category_id = NULL, + vb = options::opt("vb"), + rq = NULL) { + # Validate vol_id + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id >= 1) + assertthat::assert_that(vol_id == floor(vol_id), + msg = "vol_id must be an integer") + + # Validate category_id + if (!is.null(category_id)) { + assertthat::assert_that(length(category_id) == 1) + assertthat::assert_that(is.numeric(category_id)) + assertthat::assert_that(category_id > 0) + assertthat::assert_that(category_id == floor(category_id), + msg = "category_id must be an integer") + } + + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Build params list + params <- list() + if (!is.null(category_id)) { + params$category_id <- category_id + } + + # Perform API call + records <- collect_paginated_get( + path = sprintf(API_VOLUME_RECORDS, vol_id), + params = params, + rq = rq, + vb = vb + ) + + if (is.null(records) || length(records) == 0) { + if (vb) { + message("No records found for volume ", vol_id) + } + return(NULL) + } + + # Process records into tibble + purrr::map_dfr(records, function(record) { + # Process age if present + age_years <- NA_integer_ + age_months <- NA_integer_ + age_days <- NA_integer_ + age_total_days <- NA_integer_ + age_formatted <- NA_character_ + age_is_estimated <- NA + age_is_blurred <- NA + + if (!is.null(record$age)) { + age_years <- if (!is.null(record$age$years)) record$age$years else NA_integer_ + age_months <- if (!is.null(record$age$months)) record$age$months else NA_integer_ + age_days <- if (!is.null(record$age$days)) record$age$days else NA_integer_ + age_total_days <- if (!is.null(record$age$total_days)) record$age$total_days else NA_integer_ + age_formatted <- if (!is.null(record$age$formatted_value)) record$age$formatted_value else NA_character_ + age_is_estimated <- if (!is.null(record$age$is_estimated)) record$age$is_estimated else NA + age_is_blurred <- if (!is.null(record$age$is_blurred)) record$age$is_blurred else NA + } + + tibble::tibble( + record_id = record$id, + record_volume = record$volume, + record_category_id = record$category_id, + record_measures = list(record$measures), + record_birthday = if (is.null(record$birthday)) NA_character_ else as.character(record$birthday), + age_years = age_years, + age_months = age_months, + age_days = age_days, + age_total_days = age_total_days, + age_formatted = age_formatted, + age_is_estimated = age_is_estimated, + age_is_blurred = age_is_blurred + ) + }) +} diff --git a/man/list_volume_records.Rd b/man/list_volume_records.Rd new file mode 100644 index 00000000..c195131f --- /dev/null +++ b/man/list_volume_records.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_volume_records.R +\name{list_volume_records} +\alias{list_volume_records} +\title{List Records in Databrary Volume} +\usage{ +list_volume_records( + vol_id = 1, + category_id = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{category_id}{Optional numeric category identifier to filter records +by category type.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A tibble containing metadata for each record including id, volume, +category_id, measures, birthday, and age information, or \code{NULL} when no +records are available. +} +\description{ +Retrieve all records (participant data with measures) from a +specific Databrary volume. Records contain participant information including +age, birthday, category, and associated measures collected during sessions. +} +\examples{ +\donttest{ +\dontrun{ +# List all records in volume 1 +list_volume_records(vol_id = 1) + +# Filter records by category +list_volume_records(vol_id = 1, category_id = 2) + +# With verbose output +list_volume_records(vol_id = 1, vb = TRUE) +} +} +} diff --git a/tests/testthat/test-list_volume_records.R b/tests/testthat/test-list_volume_records.R new file mode 100644 index 00000000..79f07aaa --- /dev/null +++ b/tests/testthat/test-list_volume_records.R @@ -0,0 +1,157 @@ +# list_volume_records --------------------------------------------------------- +login_test_account() + +test_that("list_volume_records returns tibble given valid vol_id", { + result <- list_volume_records(vol_id = 1) + skip_if_null_response(result, "list_volume_records(vol_id = 1)") + + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(all(c("record_id", "record_volume", "record_category_id") %in% names(result))) +}) + +test_that("list_volume_records returns valid record structure", { + result <- list_volume_records(vol_id = 1, vb = FALSE) + skip_if_null_response(result, "list_volume_records(vol_id = 1)") + + # Check column types + expect_true(is.numeric(result$record_id) || is.integer(result$record_id)) + expect_true(is.numeric(result$record_volume) || is.integer(result$record_volume)) + expect_true(is.numeric(result$record_category_id) || is.integer(result$record_category_id)) + expect_type(result$record_measures, "list") + + # Check that record_ids are positive + expect_true(all(result$record_id > 0)) + + # Check that record_volume matches requested volume + expect_true(all(result$record_volume == 1)) +}) + +test_that("list_volume_records returns NULL for non-existent volume", { + result <- list_volume_records(vol_id = 999999, vb = FALSE) + expect_null(result) +}) + +test_that("list_volume_records works with category_id filter", { + # First get all records to find a valid category_id + all_records <- list_volume_records(vol_id = 1, vb = FALSE) + skip_if_null_response(all_records, "list_volume_records(vol_id = 1)") + + if (nrow(all_records) > 0) { + # Get unique category_id from results + test_category <- all_records$record_category_id[1] + + # Filter by that category + filtered_records <- list_volume_records(vol_id = 1, category_id = test_category, vb = FALSE) + skip_if_null_response(filtered_records, sprintf("list_volume_records(vol_id = 1, category_id = %d)", test_category)) + + # All records should have the specified category_id + expect_true(all(filtered_records$record_category_id == test_category)) + } +}) + +test_that("list_volume_records works with verbose mode", { + result <- list_volume_records(vol_id = 1, vb = TRUE) + skip_if_null_response(result, "list_volume_records(vol_id = 1, vb = TRUE)") + + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) +}) + +test_that("list_volume_records rejects invalid vol_id", { + # Negative ID + expect_error(list_volume_records(vol_id = -1)) + + # Zero ID + expect_error(list_volume_records(vol_id = 0)) + + # Non-numeric ID + expect_error(list_volume_records(vol_id = "1")) + expect_error(list_volume_records(vol_id = TRUE)) + expect_error(list_volume_records(vol_id = list(a = 1))) + + # Multiple values + expect_error(list_volume_records(vol_id = c(1, 2))) + + # Decimal/non-integer + expect_error(list_volume_records(vol_id = 1.5)) +}) + +test_that("list_volume_records rejects invalid category_id", { + # Negative ID + expect_error(list_volume_records(vol_id = 1, category_id = -1)) + + # Zero ID + expect_error(list_volume_records(vol_id = 1, category_id = 0)) + + # Non-numeric ID + expect_error(list_volume_records(vol_id = 1, category_id = "1")) + expect_error(list_volume_records(vol_id = 1, category_id = TRUE)) + + # Multiple values + expect_error(list_volume_records(vol_id = 1, category_id = c(1, 2))) + + # Decimal/non-integer + expect_error(list_volume_records(vol_id = 1, category_id = 1.5)) +}) + +test_that("list_volume_records rejects invalid vb parameter", { + expect_error(list_volume_records(vol_id = 1, vb = -1)) + expect_error(list_volume_records(vol_id = 1, vb = 3)) + expect_error(list_volume_records(vol_id = 1, vb = "a")) + expect_error(list_volume_records(vol_id = 1, vb = list(a = 1, b = 2))) + expect_error(list_volume_records(vol_id = 1, vb = c(TRUE, FALSE))) + expect_error(list_volume_records(vol_id = 1, vb = NULL)) +}) + +test_that("list_volume_records rejects invalid rq parameter", { + expect_error(list_volume_records(vol_id = 1, rq = "a")) + expect_error(list_volume_records(vol_id = 1, rq = -1)) + expect_error(list_volume_records(vol_id = 1, rq = c(2, 3))) + expect_error(list_volume_records(vol_id = 1, rq = list(a = 1, b = 2))) + expect_error(list_volume_records(vol_id = 1, rq = TRUE)) +}) + +test_that("list_volume_records includes age fields", { + result <- list_volume_records(vol_id = 1) + skip_if_null_response(result, "list_volume_records(vol_id = 1)") + + # Check that age fields exist + age_fields <- c("age_years", "age_months", "age_days", "age_total_days", + "age_formatted", "age_is_estimated", "age_is_blurred") + expect_true(all(age_fields %in% names(result))) +}) + +test_that("list_volume_records includes measures as list column", { + result <- list_volume_records(vol_id = 1) + skip_if_null_response(result, "list_volume_records(vol_id = 1)") + + # Check that measures column is a list + expect_true("record_measures" %in% names(result)) + expect_type(result$record_measures, "list") +}) + +test_that("list_volume_records works with custom request object", { + custom_rq <- databraryr::make_default_request() + result <- list_volume_records(vol_id = 1, rq = custom_rq) + skip_if_null_response(result, "list_volume_records(vol_id = 1, rq = custom_rq)") + + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) +}) + +test_that("list_volume_records returns for different volumes", { + result1 <- list_volume_records(vol_id = 1, vb = FALSE) + skip_if_null_response(result1, "list_volume_records(vol_id = 1)") + + result2 <- list_volume_records(vol_id = 2, vb = FALSE) + skip_if_null_response(result2, "list_volume_records(vol_id = 2)") + + # Both should be tibbles + expect_s3_class(result1, "tbl_df") + expect_s3_class(result2, "tbl_df") + + # Records should have different volume IDs + expect_true(all(result1$record_volume == 1)) + expect_true(all(result2$record_volume == 2)) +}) From 6d6c0cdbce7c768b0fac48bfcd96202b1b53307e Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Wed, 10 Dec 2025 12:00:25 +0100 Subject: [PATCH 10/77] feat: add get_volume_record_by_id() function with tests - Added API_VOLUME_RECORD_DETAIL constant - Implemented get_volume_record_by_id() to retrieve single record by ID - Created test suite (14 test cases) --- NAMESPACE | 1 + R/CONSTANTS.R | 1 + R/get_volume_record_by_id.R | 96 ++++++++ man/get_volume_record_by_id.Rd | 44 ++++ tests/testthat/test-get_volume_record_by_id.R | 224 ++++++++++++++++++ 5 files changed, 366 insertions(+) create mode 100644 R/get_volume_record_by_id.R create mode 100644 man/get_volume_record_by_id.Rd create mode 100644 tests/testthat/test-get_volume_record_by_id.R diff --git a/NAMESPACE b/NAMESPACE index 1b98e87e..b4206150 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -29,6 +29,7 @@ export(get_supported_file_types) export(get_tag_by_id) export(get_user_by_id) export(get_volume_by_id) +export(get_volume_record_by_id) export(list_asset_formats) export(list_authorized_investigators) export(list_categories) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index a6bb8a30..5025634f 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -25,6 +25,7 @@ API_VOLUME_HISTORY <- "/volumes/%s/history/" API_VOLUME_SESSIONS <- "/volumes/%s/sessions/" API_VOLUME_FOLDERS <- "/volumes/%s/folders/" API_VOLUME_RECORDS <- "/volumes/%s/records/" +API_VOLUME_RECORD_DETAIL <- "/volumes/%s/records/%s/" API_SESSION_DETAIL <- "/volumes/%s/sessions/%s/" API_SESSION_FILES <- "/volumes/%s/sessions/%s/files/" API_SESSION_FILE_DETAIL <- "/volumes/%s/sessions/%s/files/%s/" diff --git a/R/get_volume_record_by_id.R b/R/get_volume_record_by_id.R new file mode 100644 index 00000000..5638cef8 --- /dev/null +++ b/R/get_volume_record_by_id.R @@ -0,0 +1,96 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get Volume Record By ID +#' +#' @description Retrieve detailed information about a specific record +#' (participant data) from a Databrary volume using its unique identifier. +#' Records contain participant information including age, birthday, category, +#' and associated measures collected during sessions. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return A list with the record's metadata including id, volume, category_id, +#' measures, birthday, and age information, or `NULL` if the record is not +#' found or inaccessible. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Get details for a specific record +#' get_volume_record_by_id(vol_id = 1, record_id = 123) +#' +#' # Get record information with verbose output +#' get_volume_record_by_id(vol_id = 1, record_id = 123, vb = TRUE) +#' } +#' } +#' @export +get_volume_record_by_id <- function(vol_id = 1, + record_id = 1, + vb = options::opt("vb"), + rq = NULL) { + # Validate vol_id + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(vol_id >= 1) + assertthat::assert_that(vol_id == floor(vol_id), + msg = "vol_id must be an integer") + + # Validate record_id + assertthat::assert_that(is.numeric(record_id)) + assertthat::assert_that(length(record_id) == 1) + assertthat::assert_that(record_id > 0) + assertthat::assert_that(record_id == floor(record_id), + msg = "record_id must be an integer") + + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Perform API call + record <- perform_api_get( + path = sprintf(API_VOLUME_RECORD_DETAIL, vol_id, record_id), + rq = rq, + vb = vb + ) + + if (is.null(record)) { + if (vb) { + message("Record ", record_id, " in volume ", vol_id, " not found or inaccessible.") + } + return(NULL) + } + + # Process age if present + age <- NULL + if (!is.null(record$age)) { + age <- list( + years = record$age$years, + months = record$age$months, + days = record$age$days, + total_days = record$age$total_days, + formatted_value = record$age$formatted_value, + is_estimated = record$age$is_estimated, + is_blurred = record$age$is_blurred + ) + } + + # Return structured list + list( + record_id = record$id, + record_volume = record$volume, + record_category_id = record$category_id, + measures = record$measures, + birthday = record$birthday, + age = age + ) +} diff --git a/man/get_volume_record_by_id.Rd b/man/get_volume_record_by_id.Rd new file mode 100644 index 00000000..9ed51ad8 --- /dev/null +++ b/man/get_volume_record_by_id.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_volume_record_by_id.R +\name{get_volume_record_by_id} +\alias{get_volume_record_by_id} +\title{Get Volume Record By ID} +\usage{ +get_volume_record_by_id( + vol_id = 1, + record_id = 1, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the record's metadata including id, volume, category_id, +measures, birthday, and age information, or \code{NULL} if the record is not +found or inaccessible. +} +\description{ +Retrieve detailed information about a specific record +(participant data) from a Databrary volume using its unique identifier. +Records contain participant information including age, birthday, category, +and associated measures collected during sessions. +} +\examples{ +\donttest{ +\dontrun{ +# Get details for a specific record +get_volume_record_by_id(vol_id = 1, record_id = 123) + +# Get record information with verbose output +get_volume_record_by_id(vol_id = 1, record_id = 123, vb = TRUE) +} +} +} diff --git a/tests/testthat/test-get_volume_record_by_id.R b/tests/testthat/test-get_volume_record_by_id.R new file mode 100644 index 00000000..d402a597 --- /dev/null +++ b/tests/testthat/test-get_volume_record_by_id.R @@ -0,0 +1,224 @@ +# get_volume_record_by_id() -------------------------------------------------- +login_test_account() + +test_that("get_volume_record_by_id retrieves valid record", { + # First get a list of records to find a valid record_id + records <- list_volume_records(vol_id = 1, vb = FALSE) + skip_if_null_response(records, "list_volume_records(vol_id = 1)") + + if (nrow(records) > 0) { + test_record_id <- records$record_id[1] + + result <- get_volume_record_by_id(vol_id = 1, record_id = test_record_id) + skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d)", test_record_id)) + + expect_type(result, "list") + expect_named(result, c("record_id", "record_volume", "record_category_id", "measures", "birthday", "age")) + expect_equal(result$record_id, test_record_id) + expect_equal(result$record_volume, 1) + expect_true(is.numeric(result$record_category_id) || is.integer(result$record_category_id)) + } +}) + +test_that("get_volume_record_by_id returns NULL for non-existent record", { + # Use a very large ID that likely doesn't exist + result <- get_volume_record_by_id(vol_id = 1, record_id = 999999, vb = FALSE) + expect_null(result) +}) + +test_that("get_volume_record_by_id returns NULL for non-existent volume", { + result <- get_volume_record_by_id(vol_id = 999999, record_id = 1, vb = FALSE) + expect_null(result) +}) + +test_that("get_volume_record_by_id works with verbose mode", { + records <- list_volume_records(vol_id = 1, vb = FALSE) + skip_if_null_response(records, "list_volume_records(vol_id = 1)") + + if (nrow(records) > 0) { + test_record_id <- records$record_id[1] + result <- get_volume_record_by_id(vol_id = 1, record_id = test_record_id, vb = TRUE) + skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d, vb = TRUE)", test_record_id)) + + expect_type(result, "list") + expect_true(!is.null(result$record_id)) + } +}) + +test_that("get_volume_record_by_id rejects invalid vol_id", { + # Negative ID + expect_error(get_volume_record_by_id(vol_id = -1, record_id = 1)) + + # Zero ID + expect_error(get_volume_record_by_id(vol_id = 0, record_id = 1)) + + # Non-numeric ID + expect_error(get_volume_record_by_id(vol_id = "1", record_id = 1)) + expect_error(get_volume_record_by_id(vol_id = TRUE, record_id = 1)) + expect_error(get_volume_record_by_id(vol_id = list(a = 1), record_id = 1)) + + # Multiple values + expect_error(get_volume_record_by_id(vol_id = c(1, 2), record_id = 1)) + + # Decimal/non-integer + expect_error(get_volume_record_by_id(vol_id = 1.5, record_id = 1)) + expect_error(get_volume_record_by_id(vol_id = 2.7, record_id = 1)) + + # NULL + expect_error(get_volume_record_by_id(vol_id = NULL, record_id = 1)) + + # NA + expect_error(get_volume_record_by_id(vol_id = NA, record_id = 1)) +}) + +test_that("get_volume_record_by_id rejects invalid record_id", { + # Negative ID + expect_error(get_volume_record_by_id(vol_id = 1, record_id = -1)) + + # Zero ID + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 0)) + + # Non-numeric ID + expect_error(get_volume_record_by_id(vol_id = 1, record_id = "1")) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = TRUE)) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = list(a = 1))) + + # Multiple values + expect_error(get_volume_record_by_id(vol_id = 1, record_id = c(1, 2))) + + # Decimal/non-integer + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1.5)) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 2.7)) + + # NULL + expect_error(get_volume_record_by_id(vol_id = 1, record_id = NULL)) + + # NA + expect_error(get_volume_record_by_id(vol_id = 1, record_id = NA)) +}) + +test_that("get_volume_record_by_id rejects invalid vb parameter", { + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = -1)) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = 3)) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = "a")) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = list(a = 1, b = 2))) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = NULL)) +}) + +test_that("get_volume_record_by_id rejects invalid rq parameter", { + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, rq = "a")) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, rq = -1)) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, rq = c(2, 3))) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, rq = list(a = 1, b = 2))) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, rq = TRUE)) +}) + +test_that("get_volume_record_by_id result structure is consistent", { + records <- list_volume_records(vol_id = 1, vb = FALSE) + skip_if_null_response(records, "list_volume_records(vol_id = 1)") + + if (nrow(records) > 0) { + test_record_id <- records$record_id[1] + result <- get_volume_record_by_id(vol_id = 1, record_id = test_record_id) + skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d)", test_record_id)) + + # Check that all expected fields exist + expect_true(all(c("record_id", "record_volume", "record_category_id", "measures", "birthday", "age") %in% names(result))) + + # Check field types + expect_true(is.numeric(result$record_id) || is.integer(result$record_id)) + expect_true(is.numeric(result$record_volume) || is.integer(result$record_volume)) + expect_true(is.numeric(result$record_category_id) || is.integer(result$record_category_id)) + expect_true(is.list(result$measures) || is.null(result$measures)) + + # Check that record_id matches the requested ID + expect_equal(result$record_id, test_record_id) + + # Check that record_volume matches requested volume + expect_equal(result$record_volume, 1) + } +}) + +test_that("get_volume_record_by_id handles age structure correctly", { + records <- list_volume_records(vol_id = 1, vb = FALSE) + skip_if_null_response(records, "list_volume_records(vol_id = 1)") + + if (nrow(records) > 0) { + test_record_id <- records$record_id[1] + result <- get_volume_record_by_id(vol_id = 1, record_id = test_record_id) + skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d)", test_record_id)) + + # If age exists, check its structure + if (!is.null(result$age)) { + expect_type(result$age, "list") + expected_fields <- c("years", "months", "days", "total_days", "formatted_value", "is_estimated", "is_blurred") + expect_true(all(expected_fields %in% names(result$age))) + } + } +}) + +test_that("get_volume_record_by_id handles measures correctly", { + records <- list_volume_records(vol_id = 1, vb = FALSE) + skip_if_null_response(records, "list_volume_records(vol_id = 1)") + + if (nrow(records) > 0) { + test_record_id <- records$record_id[1] + result <- get_volume_record_by_id(vol_id = 1, record_id = test_record_id) + skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d)", test_record_id)) + + # Measures should be a list (can be empty) + expect_true(is.list(result$measures) || is.null(result$measures)) + } +}) + +test_that("get_volume_record_by_id works with custom request object", { + records <- list_volume_records(vol_id = 1, vb = FALSE) + skip_if_null_response(records, "list_volume_records(vol_id = 1)") + + if (nrow(records) > 0) { + test_record_id <- records$record_id[1] + custom_rq <- databraryr::make_default_request() + result <- get_volume_record_by_id(vol_id = 1, record_id = test_record_id, rq = custom_rq) + skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d, rq = custom_rq)", test_record_id)) + + expect_type(result, "list") + expect_equal(result$record_id, test_record_id) + } +}) + +test_that("get_volume_record_by_id can retrieve multiple different records", { + records <- list_volume_records(vol_id = 1, vb = FALSE) + skip_if_null_response(records, "list_volume_records(vol_id = 1)") + + if (nrow(records) >= 2) { + record_id_1 <- records$record_id[1] + record_id_2 <- records$record_id[2] + + result1 <- get_volume_record_by_id(vol_id = 1, record_id = record_id_1, vb = FALSE) + result2 <- get_volume_record_by_id(vol_id = 1, record_id = record_id_2, vb = FALSE) + + skip_if_null_response(result1, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d)", record_id_1)) + skip_if_null_response(result2, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d)", record_id_2)) + + # If both exist, they should be different + expect_false(identical(result1$record_id, result2$record_id)) + expect_equal(result1$record_id, record_id_1) + expect_equal(result2$record_id, record_id_2) + } +}) + +test_that("get_volume_record_by_id returns complete structure with all fields", { + records <- list_volume_records(vol_id = 1, vb = FALSE) + skip_if_null_response(records, "list_volume_records(vol_id = 1)") + + if (nrow(records) > 0) { + test_record_id <- records$record_id[1] + result <- get_volume_record_by_id(vol_id = 1, record_id = test_record_id) + skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d)", test_record_id)) + + # Record should have all expected fields + expect_length(result, 6) + expect_named(result, c("record_id", "record_volume", "record_category_id", "measures", "birthday", "age")) + } +}) From d0ef941896676845a04f884a9f1883b3f97c0f02 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Wed, 10 Dec 2025 12:38:47 +0100 Subject: [PATCH 11/77] feat: add get_volume_collaborator_by_id() function with tests - Added API_VOLUME_COLLABORATOR_DETAIL constant - Implemented get_volume_collaborator_by_id() to retrieve single collaborator by ID - Returns detailed collaborator data with user, sponsor, and sponsorship info - Created test suite (15 test cases) --- NAMESPACE | 1 + R/CONSTANTS.R | 1 + R/get_volume_collaborator_by_id.R | 134 ++++++++++ man/get_volume_collaborator_by_id.Rd | 45 ++++ .../test-get_volume_collaborator_by_id.R | 250 ++++++++++++++++++ 5 files changed, 431 insertions(+) create mode 100644 R/get_volume_collaborator_by_id.R create mode 100644 man/get_volume_collaborator_by_id.Rd create mode 100644 tests/testthat/test-get_volume_collaborator_by_id.R diff --git a/NAMESPACE b/NAMESPACE index b4206150..84852ff0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -29,6 +29,7 @@ export(get_supported_file_types) export(get_tag_by_id) export(get_user_by_id) export(get_volume_by_id) +export(get_volume_collaborator_by_id) export(get_volume_record_by_id) export(list_asset_formats) export(list_authorized_investigators) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 5025634f..7afef603 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -21,6 +21,7 @@ API_VOLUME_TAGS <- "/volumes/%s/tags/" API_VOLUME_LINKS <- "/volumes/%s/links/" API_VOLUME_FUNDINGS <- "/volumes/%s/fundings/" API_VOLUME_COLLABORATORS <- "/volumes/%s/collaborators/" +API_VOLUME_COLLABORATOR_DETAIL <- "/volumes/%s/collaborators/%s/" API_VOLUME_HISTORY <- "/volumes/%s/history/" API_VOLUME_SESSIONS <- "/volumes/%s/sessions/" API_VOLUME_FOLDERS <- "/volumes/%s/folders/" diff --git a/R/get_volume_collaborator_by_id.R b/R/get_volume_collaborator_by_id.R new file mode 100644 index 00000000..8137eea0 --- /dev/null +++ b/R/get_volume_collaborator_by_id.R @@ -0,0 +1,134 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get Volume Collaborator By ID +#' +#' @description Retrieve detailed information about a specific collaborator +#' on a Databrary volume using their unique collaborator identifier. Returns +#' collaborator details including user information, sponsor details, access +#' level, and visibility settings. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param collaborator_id Numeric collaborator identifier. Must be a positive integer. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return A list with the collaborator's metadata including id, volume, user +#' details, sponsor information (if applicable), access level, visibility +#' settings, and expiration date, or `NULL` if the collaborator is not found +#' or inaccessible. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Get details for a specific collaborator +#' get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 5) +#' +#' # Get collaborator information with verbose output +#' get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 5, vb = TRUE) +#' } +#' } +#' @export +get_volume_collaborator_by_id <- function(vol_id = 1, + collaborator_id = 1, + vb = options::opt("vb"), + rq = NULL) { + # Validate vol_id + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(vol_id >= 1) + assertthat::assert_that(vol_id == floor(vol_id), + msg = "vol_id must be an integer") + + # Validate collaborator_id + assertthat::assert_that(is.numeric(collaborator_id)) + assertthat::assert_that(length(collaborator_id) == 1) + assertthat::assert_that(collaborator_id > 0) + assertthat::assert_that(collaborator_id == floor(collaborator_id), + msg = "collaborator_id must be an integer") + + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Perform API call + collaborator <- perform_api_get( + path = sprintf(API_VOLUME_COLLABORATOR_DETAIL, vol_id, collaborator_id), + rq = rq, + vb = vb + ) + + if (is.null(collaborator)) { + if (vb) { + message("Collaborator ", collaborator_id, " in volume ", vol_id, " not found or inaccessible.") + } + return(NULL) + } + + # Process user information + user <- NULL + if (!is.null(collaborator$user)) { + user <- list( + user_id = collaborator$user$id, + first_name = collaborator$user$first_name, + last_name = collaborator$user$last_name, + email = collaborator$user$email, + is_authorized_investigator = collaborator$user$is_authorized_investigator, + has_avatar = collaborator$user$has_avatar + ) + } + + # Process sponsor information + sponsor <- NULL + if (!is.null(collaborator$sponsor)) { + sponsor <- list( + sponsor_id = collaborator$sponsor$id, + first_name = collaborator$sponsor$first_name, + last_name = collaborator$sponsor$last_name, + email = collaborator$sponsor$email + ) + } + + # Process sponsorship information + sponsorship <- NULL + if (!is.null(collaborator$sponsorship)) { + sponsorship <- list( + sponsorship_id = collaborator$sponsorship$id, + sponsor_id = collaborator$sponsorship$sponsor, + sponsored_user_id = collaborator$sponsorship$sponsored_user, + status = collaborator$sponsorship$status + ) + } + + # Process sponsored_users if present + sponsored_users <- NULL + if (!is.null(collaborator$sponsored_users) && length(collaborator$sponsored_users) > 0) { + sponsored_users <- lapply(collaborator$sponsored_users, function(u) { + list( + user_id = u$id, + first_name = u$first_name, + last_name = u$last_name, + email = u$email + ) + }) + } + + # Return structured list + list( + collaborator_id = collaborator$id, + volume = collaborator$volume, + user = user, + sponsor = sponsor, + sponsorship = sponsorship, + is_publicly_visible = collaborator$is_publicly_visible, + access_level = collaborator$access_level, + expiration_date = collaborator$expiration_date, + sponsored_users = sponsored_users + ) +} \ No newline at end of file diff --git a/man/get_volume_collaborator_by_id.Rd b/man/get_volume_collaborator_by_id.Rd new file mode 100644 index 00000000..a79fd428 --- /dev/null +++ b/man/get_volume_collaborator_by_id.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_volume_collaborator_by_id.R +\name{get_volume_collaborator_by_id} +\alias{get_volume_collaborator_by_id} +\title{Get Volume Collaborator By ID} +\usage{ +get_volume_collaborator_by_id( + vol_id = 1, + collaborator_id = 1, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{collaborator_id}{Numeric collaborator identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the collaborator's metadata including id, volume, user +details, sponsor information (if applicable), access level, visibility +settings, and expiration date, or \code{NULL} if the collaborator is not found +or inaccessible. +} +\description{ +Retrieve detailed information about a specific collaborator +on a Databrary volume using their unique collaborator identifier. Returns +collaborator details including user information, sponsor details, access +level, and visibility settings. +} +\examples{ +\donttest{ +\dontrun{ +# Get details for a specific collaborator +get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 5) + +# Get collaborator information with verbose output +get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 5, vb = TRUE) +} +} +} diff --git a/tests/testthat/test-get_volume_collaborator_by_id.R b/tests/testthat/test-get_volume_collaborator_by_id.R new file mode 100644 index 00000000..78753195 --- /dev/null +++ b/tests/testthat/test-get_volume_collaborator_by_id.R @@ -0,0 +1,250 @@ +# get_volume_collaborator_by_id() -------------------------------------------- +login_test_account() + +test_that("get_volume_collaborator_by_id retrieves valid collaborator", { + # First get a list of collaborators to find a valid collaborator_id + collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) + skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") + + if (nrow(collaborators) > 0) { + test_collaborator_id <- collaborators$collaborator_id[1] + + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + + expect_type(result, "list") + expect_named(result, c("collaborator_id", "volume", "user", "sponsor", "sponsorship", "is_publicly_visible", "access_level", "expiration_date", "sponsored_users")) + expect_equal(result$collaborator_id, test_collaborator_id) + expect_equal(result$volume, 1) + } +}) + +test_that("get_volume_collaborator_by_id returns NULL for non-existent collaborator", { + # Use a very large ID that likely doesn't exist + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 999999, vb = FALSE) + expect_null(result) +}) + +test_that("get_volume_collaborator_by_id returns NULL for non-existent volume", { + result <- get_volume_collaborator_by_id(vol_id = 999999, collaborator_id = 1, vb = FALSE) + expect_null(result) +}) + +test_that("get_volume_collaborator_by_id works with verbose mode", { + collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) + skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") + + if (nrow(collaborators) > 0) { + test_collaborator_id <- collaborators$collaborator_id[1] + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id, vb = TRUE) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d, vb = TRUE)", test_collaborator_id)) + + expect_type(result, "list") + expect_true(!is.null(result$collaborator_id)) + } +}) + +test_that("get_volume_collaborator_by_id rejects invalid vol_id", { + # Negative ID + expect_error(get_volume_collaborator_by_id(vol_id = -1, collaborator_id = 1)) + + # Zero ID + expect_error(get_volume_collaborator_by_id(vol_id = 0, collaborator_id = 1)) + + # Non-numeric ID + expect_error(get_volume_collaborator_by_id(vol_id = "1", collaborator_id = 1)) + expect_error(get_volume_collaborator_by_id(vol_id = TRUE, collaborator_id = 1)) + expect_error(get_volume_collaborator_by_id(vol_id = list(a = 1), collaborator_id = 1)) + + # Multiple values + expect_error(get_volume_collaborator_by_id(vol_id = c(1, 2), collaborator_id = 1)) + + # Decimal/non-integer + expect_error(get_volume_collaborator_by_id(vol_id = 1.5, collaborator_id = 1)) + expect_error(get_volume_collaborator_by_id(vol_id = 2.7, collaborator_id = 1)) + + # NULL + expect_error(get_volume_collaborator_by_id(vol_id = NULL, collaborator_id = 1)) + + # NA + expect_error(get_volume_collaborator_by_id(vol_id = NA, collaborator_id = 1)) +}) + +test_that("get_volume_collaborator_by_id rejects invalid collaborator_id", { + # Negative ID + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = -1)) + + # Zero ID + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 0)) + + # Non-numeric ID + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = "1")) + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = TRUE)) + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = list(a = 1))) + + # Multiple values + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = c(1, 2))) + + # Decimal/non-integer + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 1.5)) + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 2.7)) + + # NULL + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = NULL)) + + # NA + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = NA)) +}) + +test_that("get_volume_collaborator_by_id rejects invalid vb parameter", { + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 1, vb = -1)) + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 1, vb = 3)) + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 1, vb = "a")) + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 1, vb = list(a = 1, b = 2))) + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 1, vb = c(TRUE, FALSE))) + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 1, vb = NULL)) +}) + +test_that("get_volume_collaborator_by_id rejects invalid rq parameter", { + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 1, rq = "a")) + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 1, rq = -1)) + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 1, rq = c(2, 3))) + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 1, rq = list(a = 1, b = 2))) + expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 1, rq = TRUE)) +}) + +test_that("get_volume_collaborator_by_id result structure is consistent", { + collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) + skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") + + if (nrow(collaborators) > 0) { + test_collaborator_id <- collaborators$collaborator_id[1] + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + + # Check that all expected fields exist + expect_true(all(c("collaborator_id", "volume", "user", "sponsor", "sponsorship", "is_publicly_visible", "access_level", "expiration_date", "sponsored_users") %in% names(result))) + + # Check field types + expect_true(is.numeric(result$collaborator_id) || is.integer(result$collaborator_id)) + expect_true(is.numeric(result$volume) || is.integer(result$volume)) + expect_true(is.list(result$user) || is.null(result$user)) + expect_true(is.logical(result$is_publicly_visible)) + expect_true(is.character(result$access_level)) + + # Check that collaborator_id matches the requested ID + expect_equal(result$collaborator_id, test_collaborator_id) + + # Check that volume matches requested volume + expect_equal(result$volume, 1) + } +}) + +test_that("get_volume_collaborator_by_id handles user structure correctly", { + collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) + skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") + + if (nrow(collaborators) > 0) { + test_collaborator_id <- collaborators$collaborator_id[1] + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + + # If user exists, check its structure + if (!is.null(result$user)) { + expect_type(result$user, "list") + expected_fields <- c("user_id", "first_name", "last_name", "email", "is_authorized_investigator", "has_avatar") + expect_true(all(expected_fields %in% names(result$user))) + expect_true(!is.null(result$user$user_id)) + } + } +}) + +test_that("get_volume_collaborator_by_id handles sponsor structure correctly", { + collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) + skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") + + if (nrow(collaborators) > 0) { + test_collaborator_id <- collaborators$collaborator_id[1] + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + + # If sponsor exists, check its structure + if (!is.null(result$sponsor)) { + expect_type(result$sponsor, "list") + expected_fields <- c("sponsor_id", "first_name", "last_name", "email") + expect_true(all(expected_fields %in% names(result$sponsor))) + expect_true(!is.null(result$sponsor$sponsor_id)) + } + } +}) + +test_that("get_volume_collaborator_by_id handles access_level correctly", { + collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) + skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") + + if (nrow(collaborators) > 0) { + test_collaborator_id <- collaborators$collaborator_id[1] + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + + # access_level should be a character string + expect_type(result$access_level, "character") + expect_true(nchar(result$access_level) > 0) + } +}) + +test_that("get_volume_collaborator_by_id works with custom request object", { + collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) + skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") + + if (nrow(collaborators) > 0) { + test_collaborator_id <- collaborators$collaborator_id[1] + custom_rq <- databraryr::make_default_request() + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id, rq = custom_rq) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d, rq = custom_rq)", test_collaborator_id)) + + expect_type(result, "list") + expect_equal(result$collaborator_id, test_collaborator_id) + } +}) + +test_that("get_volume_collaborator_by_id can retrieve multiple different collaborators", { + collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) + skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") + + if (nrow(collaborators) >= 2) { + # Filter out NA values and ensure we have valid IDs + valid_ids <- collaborators$collaborator_id[!is.na(collaborators$collaborator_id) & collaborators$collaborator_id > 0] + + if (length(valid_ids) >= 2) { + collaborator_id_1 <- valid_ids[1] + collaborator_id_2 <- valid_ids[2] + + result1 <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = collaborator_id_1, vb = FALSE) + result2 <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = collaborator_id_2, vb = FALSE) + + skip_if_null_response(result1, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", collaborator_id_1)) + skip_if_null_response(result2, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", collaborator_id_2)) + + # If both exist, they should be different + expect_false(identical(result1$collaborator_id, result2$collaborator_id)) + expect_equal(result1$collaborator_id, collaborator_id_1) + expect_equal(result2$collaborator_id, collaborator_id_2) + } + } +}) + +test_that("get_volume_collaborator_by_id returns complete structure with all fields", { + collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) + skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") + + if (nrow(collaborators) > 0) { + test_collaborator_id <- collaborators$collaborator_id[1] + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + + # Collaborator should have all expected fields + expect_length(result, 9) + expect_named(result, c("collaborator_id", "volume", "user", "sponsor", "sponsorship", "is_publicly_visible", "access_level", "expiration_date", "sponsored_users")) + } +}) \ No newline at end of file From 905368c0c60247c65ca2528bab767c42a01edcf8 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Wed, 10 Dec 2025 14:24:40 +0100 Subject: [PATCH 12/77] feat: add get_institution_avatar() function with tests --- NAMESPACE | 1 + R/get_institution_avatar.R | 163 ++++++++++++++++ man/get_institution_avatar.Rd | 60 ++++++ tests/testthat/test-get_institution_avatar.R | 189 +++++++++++++++++++ 4 files changed, 413 insertions(+) create mode 100644 R/get_institution_avatar.R create mode 100644 man/get_institution_avatar.Rd create mode 100644 tests/testthat/test-get_institution_avatar.R diff --git a/NAMESPACE b/NAMESPACE index 84852ff0..cacbeefe 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,6 +20,7 @@ export(get_db_stats) export(get_file_duration) export(get_folder_by_id) export(get_funder_by_id) +export(get_institution_avatar) export(get_institution_by_id) export(get_permission_levels) export(get_release_levels) diff --git a/R/get_institution_avatar.R b/R/get_institution_avatar.R new file mode 100644 index 00000000..2ce3535e --- /dev/null +++ b/R/get_institution_avatar.R @@ -0,0 +1,163 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Download Institution Avatar Image +#' +#' @description Download an institution's avatar image from Databrary. The +#' image can be saved to a file or returned as raw bytes for further +#' processing. +#' +#' @param institution_id Numeric institution identifier. Must be a positive +#' integer. +#' @param dest_path Optional character string specifying the destination file +#' path or directory where the avatar should be saved. If a directory is +#' provided, the filename will be determined from the response headers or +#' will default to `institution__avatar.jpg`. If `NULL` (the default), +#' the raw image bytes are returned instead of being saved to disk. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return If `dest_path` is provided, returns the full path to the saved +#' file (character string). If `dest_path` is `NULL`, returns the raw +#' image bytes. Returns `NULL` if the avatar is not found or inaccessible. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Download avatar as raw bytes +#' avatar_bytes <- get_institution_avatar(institution_id = 1) +#' +#' # Download and save avatar to specific file +#' avatar_path <- get_institution_avatar( +#' institution_id = 1, +#' dest_path = "institution_1_avatar.jpg" +#' ) +#' +#' # Download and save to directory (filename auto-determined) +#' avatar_path <- get_institution_avatar( +#' institution_id = 1, +#' dest_path = "avatars/" +#' ) +#' +#' # With verbose output +#' get_institution_avatar(institution_id = 1, vb = TRUE) +#' } +#' } +#' @export +get_institution_avatar <- function(institution_id = 1, + dest_path = NULL, + vb = options::opt("vb"), + rq = NULL) { + # Validate institution_id + assertthat::assert_that(is.numeric(institution_id)) + assertthat::assert_that(length(institution_id) == 1) + assertthat::assert_that(institution_id > 0) + assertthat::assert_that(institution_id == floor(institution_id), + msg = "institution_id must be an integer") + + # Validate dest_path + if (!is.null(dest_path)) { + assertthat::assert_that(assertthat::is.string(dest_path)) + } + + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Build URL + avatar_url <- sprintf(API_INSTITUTION_AVATAR, institution_id) + full_url <- paste0(DATABRARY_BASE_URL, avatar_url) + + # Create request + if (is.null(rq)) { + req <- make_default_request() + } else { + req <- rq + } + + # Build the request with the avatar URL + req <- req %>% + httr2::req_url(full_url) %>% + httr2::req_method("GET") %>% + httr2::req_error(is_error = function(resp) FALSE) + + if (vb) { + message("Requesting avatar for institution ", institution_id) + } + + # Perform request + tryCatch({ + resp <- httr2::req_perform(req) + + # Check response status + status <- httr2::resp_status(resp) + if (status != 200) { + if (vb) { + message("Institution ", institution_id, " avatar not found or inaccessible (status: ", status, ")") + } + return(NULL) + } + + # Get raw bytes + avatar_bytes <- httr2::resp_body_raw(resp) + + if (is.null(dest_path)) { + # Return raw bytes + if (vb) { + message("Downloaded ", length(avatar_bytes), " bytes") + } + return(avatar_bytes) + } else { + # Resolve destination path + # If dest_path is a directory, determine filename from response headers or URL + final_path <- dest_path + if (dir.exists(dest_path)) { + # Try to get filename from content-disposition header + filename <- "downloaded_file" + content_disp <- httr2::resp_header(resp, "content-disposition") + + if (!is.null(content_disp) && grepl("filename=", content_disp)) { + # Extract filename from content-disposition header + filename_match <- regmatches(content_disp, regexpr("filename=([^;]+)", content_disp)) + if (length(filename_match) > 0) { + filename <- sub("filename=", "", filename_match) + filename <- gsub('^"|"$', '', filename) # Remove quotes + filename <- trimws(filename) + } + } else { + # Fallback: use URL path basename + url_path <- sprintf(API_INSTITUTION_AVATAR, institution_id) + filename <- paste0("institution_", institution_id, "_avatar.jpg") + } + + final_path <- file.path(dest_path, filename) + } + + # Create parent directory if needed + parent_dir <- dirname(final_path) + if (!dir.exists(parent_dir)) { + dir.create(parent_dir, recursive = TRUE, showWarnings = FALSE) + } + + # Save to file + writeBin(avatar_bytes, final_path) + + if (vb) { + message("Saved avatar to: ", final_path, " (", length(avatar_bytes), " bytes)") + } + + return(normalizePath(final_path)) + } + }, error = function(e) { + if (vb) { + message("Error downloading avatar for institution ", institution_id, ": ", e$message) + } + return(NULL) + }) +} \ No newline at end of file diff --git a/man/get_institution_avatar.Rd b/man/get_institution_avatar.Rd new file mode 100644 index 00000000..b3f3ada1 --- /dev/null +++ b/man/get_institution_avatar.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_institution_avatar.R +\name{get_institution_avatar} +\alias{get_institution_avatar} +\title{Download Institution Avatar Image} +\usage{ +get_institution_avatar( + institution_id = 1, + dest_path = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{institution_id}{Numeric institution identifier. Must be a positive +integer.} + +\item{dest_path}{Optional character string specifying the destination file +path or directory where the avatar should be saved. If a directory is +provided, the filename will be determined from the response headers or +will default to \verb{institution__avatar.jpg}. If \code{NULL} (the default), +the raw image bytes are returned instead of being saved to disk.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +If \code{dest_path} is provided, returns the full path to the saved +file (character string). If \code{dest_path} is \code{NULL}, returns the raw +image bytes. Returns \code{NULL} if the avatar is not found or inaccessible. +} +\description{ +Download an institution's avatar image from Databrary. The +image can be saved to a file or returned as raw bytes for further +processing. +} +\examples{ +\donttest{ +\dontrun{ +# Download avatar as raw bytes +avatar_bytes <- get_institution_avatar(institution_id = 1) + +# Download and save avatar to specific file +avatar_path <- get_institution_avatar( + institution_id = 1, + dest_path = "institution_1_avatar.jpg" +) + +# Download and save to directory (filename auto-determined) +avatar_path <- get_institution_avatar( + institution_id = 1, + dest_path = "avatars/" +) + +# With verbose output +get_institution_avatar(institution_id = 1, vb = TRUE) +} +} +} diff --git a/tests/testthat/test-get_institution_avatar.R b/tests/testthat/test-get_institution_avatar.R new file mode 100644 index 00000000..f04e4684 --- /dev/null +++ b/tests/testthat/test-get_institution_avatar.R @@ -0,0 +1,189 @@ +# get_institution_avatar() --------------------------------------------------- +login_test_account() + +test_that("get_institution_avatar returns raw bytes when dest_path is NULL", { + # Institution ID 1 is known to have an avatar + result <- get_institution_avatar(institution_id = 1, vb = FALSE) + skip_if_null_response(result, "get_institution_avatar(institution_id = 1)") + + expect_type(result, "raw") + expect_gt(length(result), 0) +}) + +test_that("get_institution_avatar saves to file when dest_path is provided", { + # Institution ID 1 is known to have an avatar + temp_file <- tempfile(fileext = ".jpg") + + result <- get_institution_avatar( + institution_id = 1, + dest_path = temp_file, + vb = FALSE + ) + skip_if_null_response(result, "get_institution_avatar(institution_id = 1, dest_path = ...)") + + expect_type(result, "character") + expect_true(file.exists(result)) + expect_gt(file.size(result), 0) + + # Clean up + unlink(temp_file) +}) + +test_that("get_institution_avatar returns NULL for non-existent institution", { + result <- get_institution_avatar(institution_id = 999999, vb = FALSE) + expect_null(result) +}) + +test_that("get_institution_avatar returns NULL for institution without avatar", { + # Test with a very high ID that likely doesn't have an avatar + result <- get_institution_avatar(institution_id = 99999, vb = FALSE) + # This may return NULL either because institution doesn't exist or has no avatar + # Both outcomes are acceptable for this test + expect_true(is.null(result) || is.raw(result)) +}) + +test_that("get_institution_avatar works with verbose mode", { + # Institution ID 1 is known to have an avatar + result <- get_institution_avatar(institution_id = 1, vb = TRUE) + skip_if_null_response(result, "get_institution_avatar(institution_id = 1, vb = TRUE)") + + expect_type(result, "raw") + expect_gt(length(result), 0) +}) + +test_that("get_institution_avatar rejects invalid institution_id", { + # Negative ID + expect_error(get_institution_avatar(institution_id = -1)) + + # Zero ID + expect_error(get_institution_avatar(institution_id = 0)) + + # Non-numeric ID + expect_error(get_institution_avatar(institution_id = "1")) + expect_error(get_institution_avatar(institution_id = TRUE)) + expect_error(get_institution_avatar(institution_id = list(a = 1))) + + # Multiple values + expect_error(get_institution_avatar(institution_id = c(1, 2))) + + # Decimal/non-integer + expect_error(get_institution_avatar(institution_id = 1.5)) + expect_error(get_institution_avatar(institution_id = 2.7)) + + # NULL + expect_error(get_institution_avatar(institution_id = NULL)) + + # NA + expect_error(get_institution_avatar(institution_id = NA)) +}) + +test_that("get_institution_avatar rejects invalid dest_path", { + # Non-character dest_path + expect_error(get_institution_avatar(institution_id = 1, dest_path = 123)) + expect_error(get_institution_avatar(institution_id = 1, dest_path = TRUE)) + expect_error(get_institution_avatar(institution_id = 1, dest_path = list(a = 1))) + + # Multiple values + expect_error(get_institution_avatar(institution_id = 1, dest_path = c("file1.jpg", "file2.jpg"))) +}) + +test_that("get_institution_avatar rejects invalid vb parameter", { + expect_error(get_institution_avatar(institution_id = 1, vb = -1)) + expect_error(get_institution_avatar(institution_id = 1, vb = 3)) + expect_error(get_institution_avatar(institution_id = 1, vb = "a")) + expect_error(get_institution_avatar(institution_id = 1, vb = list(a = 1, b = 2))) + expect_error(get_institution_avatar(institution_id = 1, vb = c(TRUE, FALSE))) + expect_error(get_institution_avatar(institution_id = 1, vb = NULL)) +}) + +test_that("get_institution_avatar rejects invalid rq parameter", { + expect_error(get_institution_avatar(institution_id = 1, rq = "a")) + expect_error(get_institution_avatar(institution_id = 1, rq = -1)) + expect_error(get_institution_avatar(institution_id = 1, rq = c(2, 3))) + expect_error(get_institution_avatar(institution_id = 1, rq = list(a = 1, b = 2))) + expect_error(get_institution_avatar(institution_id = 1, rq = TRUE)) +}) + +test_that("get_institution_avatar creates parent directory if needed", { + # Institution ID 1 is known to have an avatar + # Create a path with non-existent parent directory + temp_dir <- tempfile() + temp_file <- file.path(temp_dir, "avatars", "test.jpg") + + result <- get_institution_avatar( + institution_id = 1, + dest_path = temp_file, + vb = FALSE + ) + skip_if_null_response(result, "get_institution_avatar(institution_id = 1, dest_path = ...)") + + expect_true(file.exists(result)) + expect_true(dir.exists(dirname(result))) + + # Clean up + unlink(temp_dir, recursive = TRUE) +}) + +test_that("get_institution_avatar works with custom request object", { + # Institution ID 1 is known to have an avatar + custom_rq <- databraryr::make_default_request() + + result <- get_institution_avatar(institution_id = 1, rq = custom_rq, vb = FALSE) + skip_if_null_response(result, "get_institution_avatar(institution_id = 1, rq = custom_rq)") + + expect_type(result, "raw") + expect_gt(length(result), 0) +}) + +test_that("get_institution_avatar returns same content for raw bytes and file", { + # Institution ID 1 is known to have an avatar + # Get as raw bytes + bytes_result <- get_institution_avatar(institution_id = 1, vb = FALSE) + skip_if_null_response(bytes_result, "get_institution_avatar(institution_id = 1) as bytes") + + # Get as file + temp_file <- tempfile(fileext = ".jpg") + file_result <- get_institution_avatar( + institution_id = 1, + dest_path = temp_file, + vb = FALSE + ) + skip_if_null_response(file_result, "get_institution_avatar(institution_id = 1, dest_path = ...) as file") + + # Read file and compare + file_bytes <- readBin(file_result, "raw", file.size(file_result)) + expect_equal(bytes_result, file_bytes) + + # Clean up + unlink(temp_file) +}) + +test_that("get_institution_avatar saves to directory with auto-determined filename", { + # Institution ID 1 is known to have an avatar + # Create a temporary directory + temp_dir <- tempfile() + dir.create(temp_dir) + + result <- get_institution_avatar( + institution_id = 1, + dest_path = temp_dir, + vb = FALSE + ) + skip_if_null_response(result, "get_institution_avatar(institution_id = 1, dest_path = temp_dir)") + + expect_type(result, "character") + expect_true(file.exists(result)) + expect_gt(file.size(result), 0) + + # Check that the file is in the temp_dir + expect_true(startsWith(result, normalizePath(temp_dir))) + + # Check that filename was auto-determined + filename <- basename(result) + expect_true(nchar(filename) > 0) + # The filename should either be from content-disposition header or our fallback + expect_true(filename == "institutions_1_avatar" || filename == "institution_1_avatar.jpg" || filename == "downloaded_file") + + # Clean up + unlink(temp_dir, recursive = TRUE) +}) \ No newline at end of file From 8b7d9f1e9e4fcc549934de79fa7f2a98f1a66534 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Wed, 10 Dec 2025 15:02:39 +0100 Subject: [PATCH 13/77] feat: add list_institutions() function with tests --- NAMESPACE | 1 + R/CONSTANTS.R | 1 + R/list_institutions.R | 93 +++++++++++++ man/list_institutions.Rd | 40 ++++++ tests/testthat/test-list_institutions.R | 170 ++++++++++++++++++++++++ 5 files changed, 305 insertions(+) create mode 100644 R/list_institutions.R create mode 100644 man/list_institutions.Rd create mode 100644 tests/testthat/test-list_institutions.R diff --git a/NAMESPACE b/NAMESPACE index cacbeefe..49f2bda9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -37,6 +37,7 @@ export(list_authorized_investigators) export(list_categories) export(list_folder_assets) export(list_institution_affiliates) +export(list_institutions) export(list_session_activity) export(list_session_assets) export(list_user_affiliates) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 7afef603..97199e5e 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -12,6 +12,7 @@ API_USER_SPONSORSHIPS <- "/users/%s/sponsorships/" API_USER_AFFILIATES <- "/users/%s/affiliates/" API_USER_AVATAR <- "/users/%s/avatar/" API_USERS_HISTORY <- "/users/%s/history/" +API_INSTITUTIONS_LIST <- "/institutions/" API_INSTITUTIONS <- "/institutions/%s/" API_INSTITUTION_AFFILIATES <- "/institutions/%s/affiliates/" API_INSTITUTION_AVATAR <- "/institutions/%s/avatar/" diff --git a/R/list_institutions.R b/R/list_institutions.R new file mode 100644 index 00000000..13d1392a --- /dev/null +++ b/R/list_institutions.R @@ -0,0 +1,93 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List Institutions +#' +#' @description Retrieve a list of all institutions registered with Databrary. +#' Optionally filter by search string. +#' +#' @param search_string Optional character string to filter institutions. If +#' `NULL` (the default), returns all institutions. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return A tibble containing institutions with their metadata including id, +#' name, url, date_signed, source, created_at, updated_at, has_avatar, +#' has_administrators, latitude, longitude, and manual_coordinates, or `NULL` +#' if no institutions are found. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # List all institutions +#' list_institutions() +#' +#' # List institutions filtered by search string +#' list_institutions(search_string = "university") +#' +#' # With verbose output +#' list_institutions(vb = TRUE) +#' } +#' } +#' @export +list_institutions <- function(search_string = NULL, + vb = options::opt("vb"), + rq = NULL) { + # Validate search_string + if (!is.null(search_string)) { + assertthat::assert_that(assertthat::is.string(search_string)) + } + + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Build params list + params <- list() + if (!is.null(search_string)) { + params$search <- search_string + } + + # Perform API call with pagination + results <- collect_paginated_get( + path = API_INSTITUTIONS_LIST, + params = params, + rq = rq, + vb = vb + ) + + if (is.null(results) || length(results) == 0) { + if (vb) { + if (is.null(search_string)) { + message("No institutions found.") + } else { + message("No institutions found matching '", search_string, "'.") + } + } + return(NULL) + } + + # Process results into tibble + purrr::map_dfr(results, function(entry) { + tibble::tibble( + institution_id = entry$id, + institution_name = entry$name, + institution_url = if (is.null(entry$url)) NA_character_ else entry$url, + institution_date_signed = if (is.null(entry$date_signed)) NA_character_ else as.character(entry$date_signed), + institution_source = if (is.null(entry$source)) NA_character_ else entry$source, + institution_created_at = if (is.null(entry$created_at)) NA_character_ else as.character(entry$created_at), + institution_updated_at = if (is.null(entry$updated_at)) NA_character_ else as.character(entry$updated_at), + institution_has_avatar = if (is.null(entry$has_avatar)) NA else entry$has_avatar, + institution_has_administrators = if (is.null(entry$has_administrators)) NA else entry$has_administrators, + institution_latitude = if (is.null(entry$latitude)) NA_real_ else as.numeric(entry$latitude), + institution_longitude = if (is.null(entry$longitude)) NA_real_ else as.numeric(entry$longitude), + institution_manual_coordinates = if (is.null(entry$manual_coordinates)) NA else entry$manual_coordinates + ) + }) +} \ No newline at end of file diff --git a/man/list_institutions.Rd b/man/list_institutions.Rd new file mode 100644 index 00000000..e6a7e159 --- /dev/null +++ b/man/list_institutions.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list_institutions.R +\name{list_institutions} +\alias{list_institutions} +\title{List Institutions} +\usage{ +list_institutions(search_string = NULL, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{search_string}{Optional character string to filter institutions. If +\code{NULL} (the default), returns all institutions.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A tibble containing institutions with their metadata including id, +name, url, date_signed, source, created_at, updated_at, has_avatar, +has_administrators, latitude, longitude, and manual_coordinates, or \code{NULL} +if no institutions are found. +} +\description{ +Retrieve a list of all institutions registered with Databrary. +Optionally filter by search string. +} +\examples{ +\donttest{ +\dontrun{ +# List all institutions +list_institutions() + +# List institutions filtered by search string +list_institutions(search_string = "university") + +# With verbose output +list_institutions(vb = TRUE) +} +} +} diff --git a/tests/testthat/test-list_institutions.R b/tests/testthat/test-list_institutions.R new file mode 100644 index 00000000..e0c14a64 --- /dev/null +++ b/tests/testthat/test-list_institutions.R @@ -0,0 +1,170 @@ +# list_institutions() --------------------------------------------------------- +login_test_account() + +test_that("list_institutions returns all institutions without search filter", { + result <- list_institutions(vb = FALSE) + skip_if_null_response(result, "list_institutions()") + + expect_s3_class(result, "tbl_df") + expect_named(result, c("institution_id", "institution_name", "institution_url", + "institution_date_signed", "institution_source", + "institution_created_at", "institution_updated_at", + "institution_has_avatar", "institution_has_administrators", + "institution_latitude", "institution_longitude", + "institution_manual_coordinates")) + expect_gt(nrow(result), 0) + + # Check column types + expect_true(is.numeric(result$institution_id) || is.integer(result$institution_id)) + expect_type(result$institution_name, "character") + expect_type(result$institution_url, "character") + expect_type(result$institution_date_signed, "character") + expect_type(result$institution_source, "character") + expect_type(result$institution_created_at, "character") + expect_type(result$institution_updated_at, "character") + expect_type(result$institution_has_avatar, "logical") + expect_type(result$institution_has_administrators, "logical") + expect_true(is.numeric(result$institution_latitude) || is.double(result$institution_latitude)) + expect_true(is.numeric(result$institution_longitude) || is.double(result$institution_longitude)) + expect_type(result$institution_manual_coordinates, "logical") +}) + +test_that("list_institutions filters by search string", { + result <- list_institutions(search_string = "university", vb = FALSE) + skip_if_null_response(result, "list_institutions(search_string = 'university')") + + expect_s3_class(result, "tbl_df") + expect_named(result, c("institution_id", "institution_name", "institution_url", + "institution_date_signed", "institution_source", + "institution_created_at", "institution_updated_at", + "institution_has_avatar", "institution_has_administrators", + "institution_latitude", "institution_longitude", + "institution_manual_coordinates")) + expect_gt(nrow(result), 0) + + # Check that results contain the search term (case insensitive) + expect_true(any(grepl("university", result$institution_name, ignore.case = TRUE))) +}) + +test_that("list_institutions works with verbose mode", { + result <- list_institutions(vb = TRUE) + skip_if_null_response(result, "list_institutions(vb = TRUE)") + + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) +}) + +test_that("list_institutions returns NULL for search with no matches", { + # Use a very unlikely search string + result <- list_institutions(search_string = "xyzabcdefghijklmnopqrstuvwxyz999999", vb = FALSE) + expect_null(result) +}) + +test_that("list_institutions rejects invalid search_string", { + # Non-character search_string + expect_error(list_institutions(search_string = 123)) + expect_error(list_institutions(search_string = TRUE)) + expect_error(list_institutions(search_string = list(a = 1))) + + # Multiple values + expect_error(list_institutions(search_string = c("test1", "test2"))) +}) + +test_that("list_institutions rejects invalid vb parameter", { + expect_error(list_institutions(vb = -1)) + expect_error(list_institutions(vb = 3)) + expect_error(list_institutions(vb = "a")) + expect_error(list_institutions(vb = list(a = 1, b = 2))) + expect_error(list_institutions(vb = c(TRUE, FALSE))) + expect_error(list_institutions(vb = NULL)) +}) + +test_that("list_institutions rejects invalid rq parameter", { + expect_error(list_institutions(rq = "a")) + expect_error(list_institutions(rq = -1)) + expect_error(list_institutions(rq = c(2, 3))) + expect_error(list_institutions(rq = list(a = 1, b = 2))) + expect_error(list_institutions(rq = TRUE)) +}) + +test_that("list_institutions result structure is consistent", { + result <- list_institutions(vb = FALSE) + skip_if_null_response(result, "list_institutions()") + + # Check that all expected fields exist + expect_true(all(c("institution_id", "institution_name", "institution_url", "institution_has_avatar") %in% names(result))) + + # Check that institution_id values are numeric + expect_true(is.numeric(result$institution_id) || is.integer(result$institution_id)) + + # Check that institution_name is never NA + expect_true(all(!is.na(result$institution_name))) +}) + +test_that("list_institutions handles NA values correctly", { + result <- list_institutions(vb = FALSE) + skip_if_null_response(result, "list_institutions()") + + # institution_url can be NA for institutions without a URL + expect_type(result$institution_url, "character") + + # institution_has_avatar can be NA for institutions without avatar info + expect_type(result$institution_has_avatar, "logical") +}) + +test_that("list_institutions works with custom request object", { + custom_rq <- databraryr::make_default_request() + result <- list_institutions(rq = custom_rq, vb = FALSE) + skip_if_null_response(result, "list_institutions(rq = custom_rq)") + + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) +}) + +test_that("list_institutions returns different results with and without search", { + # Get all institutions + all_institutions <- list_institutions(vb = FALSE) + skip_if_null_response(all_institutions, "list_institutions()") + + # Get filtered institutions + filtered_institutions <- list_institutions(search_string = "state", vb = FALSE) + + # If filtered results exist, they should be a subset of all institutions + if (!is.null(filtered_institutions)) { + expect_true(nrow(filtered_institutions) <= nrow(all_institutions)) + } +}) + +test_that("list_institutions returns unique institution IDs", { + result <- list_institutions(vb = FALSE) + skip_if_null_response(result, "list_institutions()") + + # Check that all institution IDs are unique + expect_equal(nrow(result), length(unique(result$institution_id))) +}) + +test_that("list_institutions search is case insensitive", { + result_lower <- list_institutions(search_string = "university", vb = FALSE) + result_upper <- list_institutions(search_string = "UNIVERSITY", vb = FALSE) + + # If both return results, they should be similar + if (!is.null(result_lower) && !is.null(result_upper)) { + # Both should have results with "university" in the name (case insensitive) + expect_true(any(grepl("university", result_lower$institution_name, ignore.case = TRUE))) + expect_true(any(grepl("university", result_upper$institution_name, ignore.case = TRUE))) + } +}) + +test_that("list_institutions can retrieve institutions with avatars", { + result <- list_institutions(vb = FALSE) + skip_if_null_response(result, "list_institutions()") + + # Filter institutions that have avatars + institutions_with_avatars <- result[!is.na(result$institution_has_avatar) & result$institution_has_avatar == TRUE, ] + + # There should be at least some institutions with avatars + if (nrow(institutions_with_avatars) > 0) { + expect_gt(nrow(institutions_with_avatars), 0) + expect_true(all(institutions_with_avatars$institution_has_avatar == TRUE)) + } +}) From 16d880040f6f943ba42d77f682776c6052c2446b Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Wed, 10 Dec 2025 15:16:31 +0100 Subject: [PATCH 14/77] feat: add get_user_avatar() function with tests --- NAMESPACE | 1 + R/get_user_avatar.R | 166 +++++++++++++++++++++ man/get_user_avatar.Rd | 48 ++++++ tests/testthat/test-get_user_avatar.R | 205 ++++++++++++++++++++++++++ 4 files changed, 420 insertions(+) create mode 100644 R/get_user_avatar.R create mode 100644 man/get_user_avatar.Rd create mode 100644 tests/testthat/test-get_user_avatar.R diff --git a/NAMESPACE b/NAMESPACE index 49f2bda9..1d62eff1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,6 +28,7 @@ export(get_session_by_id) export(get_session_by_name) export(get_supported_file_types) export(get_tag_by_id) +export(get_user_avatar) export(get_user_by_id) export(get_volume_by_id) export(get_volume_collaborator_by_id) diff --git a/R/get_user_avatar.R b/R/get_user_avatar.R new file mode 100644 index 00000000..ae174b48 --- /dev/null +++ b/R/get_user_avatar.R @@ -0,0 +1,166 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get User Avatar +#' +#' @description Download a user's avatar image from Databrary. Returns raw +#' bytes if no destination path is specified, or saves to disk and returns the +#' file path. +#' +#' @param user_id Numeric. The ID of the user whose avatar to download. +#' @param dest_path Optional character string specifying where to save the +#' avatar. Can be either a file path or a directory. If a directory is +#' provided, the filename will be automatically determined from the response +#' headers or will default to "user__avatar.jpg". If `NULL` (the +#' default), the function returns raw bytes instead of saving to disk. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @return If `dest_path` is `NULL`, returns raw bytes. If `dest_path` is +#' specified, returns the full path where the avatar was saved. Returns +#' `NULL` if the user has no avatar or if an error occurs. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Get avatar as raw bytes +#' avatar_bytes <- get_user_avatar(user_id = 5) +#' +#' # Save avatar to specific file +#' get_user_avatar(user_id = 5, dest_path = "avatar.jpg") +#' +#' # Save avatar to directory (filename auto-determined) +#' get_user_avatar(user_id = 5, dest_path = "~/avatars/") +#' +#' # With verbose output +#' get_user_avatar(user_id = 5, dest_path = "avatar.jpg", vb = TRUE) +#' } +#' } +#' @export +get_user_avatar <- function(user_id, + dest_path = NULL, + vb = options::opt("vb"), + rq = NULL) { + # Validate user_id + assertthat::assert_that(length(user_id) == 1) + assertthat::assert_that(is.numeric(user_id) || is.integer(user_id)) + assertthat::assert_that(user_id > 0) + + # Validate dest_path + if (!is.null(dest_path)) { + assertthat::assert_that(assertthat::is.string(dest_path)) + } + + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Build URL path + path <- sprintf(API_USER_AVATAR, user_id) + + if (vb) { + message("Getting user avatar for user ID: ", user_id) + } + + # Set up request + if (is.null(rq)) { + rq <- make_default_request() + } + + # Perform request + resp <- tryCatch( + { + rq |> + httr2::req_url_path_append(path) |> + httr2::req_error(is_error = function(resp) FALSE) |> + httr2::req_perform() + }, + error = function(e) { + if (vb) { + message("Error downloading user avatar: ", conditionMessage(e)) + } + return(NULL) + } + ) + + if (is.null(resp)) { + return(NULL) + } + + # Check for errors + if (httr2::resp_status(resp) != 200) { + if (vb) { + message( + "Failed to download user avatar. Status: ", + httr2::resp_status(resp) + ) + } + return(NULL) + } + + # Get avatar bytes + avatar_bytes <- httr2::resp_body_raw(resp) + + # If no destination path, return bytes + if (is.null(dest_path)) { + if (vb) { + message("Returning avatar as raw bytes (", length(avatar_bytes), " bytes)") + } + return(avatar_bytes) + } + + # Save to file + # Resolve destination path + # If dest_path is a directory, determine filename from response headers or URL + final_path <- dest_path + if (dir.exists(dest_path)) { + # Try to get filename from content-disposition header + filename <- "downloaded_file" + content_disp <- httr2::resp_header(resp, "content-disposition") + + if (!is.null(content_disp) && grepl("filename=", content_disp)) { + # Extract filename from content-disposition header + filename_match <- regmatches(content_disp, regexpr("filename=([^;]+)", content_disp)) + if (length(filename_match) > 0) { + filename <- sub("filename=", "", filename_match) + filename <- gsub('^"|"$', '', filename) # Remove quotes + filename <- trimws(filename) + } + } else { + # Fallback: use URL path basename + url_path <- sprintf(API_USER_AVATAR, user_id) + filename <- paste0("user_", user_id, "_avatar.jpg") + } + + final_path <- file.path(dest_path, filename) + } + + # Ensure parent directory exists + parent_dir <- dirname(final_path) + if (!dir.exists(parent_dir)) { + dir.create(parent_dir, recursive = TRUE) + } + + # Write to file + tryCatch( + { + writeBin(avatar_bytes, final_path) + if (vb) { + message("Avatar saved to: ", final_path) + } + return(normalizePath(final_path)) + }, + error = function(e) { + if (vb) { + message("Error saving avatar to file: ", conditionMessage(e)) + } + return(NULL) + } + ) +} \ No newline at end of file diff --git a/man/get_user_avatar.Rd b/man/get_user_avatar.Rd new file mode 100644 index 00000000..2b1b0f10 --- /dev/null +++ b/man/get_user_avatar.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_user_avatar.R +\name{get_user_avatar} +\alias{get_user_avatar} +\title{Get User Avatar} +\usage{ +get_user_avatar(user_id, dest_path = NULL, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{user_id}{Numeric. The ID of the user whose avatar to download.} + +\item{dest_path}{Optional character string specifying where to save the +avatar. Can be either a file path or a directory. If a directory is +provided, the filename will be automatically determined from the response +headers or will default to "user_\if{html}{\out{}}_avatar.jpg". If \code{NULL} (the +default), the function returns raw bytes instead of saving to disk.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +If \code{dest_path} is \code{NULL}, returns raw bytes. If \code{dest_path} is +specified, returns the full path where the avatar was saved. Returns +\code{NULL} if the user has no avatar or if an error occurs. +} +\description{ +Download a user's avatar image from Databrary. Returns raw +bytes if no destination path is specified, or saves to disk and returns the +file path. +} +\examples{ +\donttest{ +\dontrun{ +# Get avatar as raw bytes +avatar_bytes <- get_user_avatar(user_id = 5) + +# Save avatar to specific file +get_user_avatar(user_id = 5, dest_path = "avatar.jpg") + +# Save avatar to directory (filename auto-determined) +get_user_avatar(user_id = 5, dest_path = "~/avatars/") + +# With verbose output +get_user_avatar(user_id = 5, dest_path = "avatar.jpg", vb = TRUE) +} +} +} diff --git a/tests/testthat/test-get_user_avatar.R b/tests/testthat/test-get_user_avatar.R new file mode 100644 index 00000000..08fe7fe5 --- /dev/null +++ b/tests/testthat/test-get_user_avatar.R @@ -0,0 +1,205 @@ +# get_user_avatar() --------------------------------------------------------- +login_test_account() + +test_that("get_user_avatar returns raw bytes when dest_path is NULL", { + # User ID 5 is known to have an avatar + result <- get_user_avatar(user_id = 5, vb = FALSE) + skip_if_null_response(result, "get_user_avatar(user_id = 5)") + + expect_type(result, "raw") + expect_gt(length(result), 0) +}) + +test_that("get_user_avatar saves to file when dest_path is provided", { + # User ID 5 is known to have an avatar + temp_file <- tempfile(fileext = ".jpg") + + result <- get_user_avatar( + user_id = 5, + dest_path = temp_file, + vb = FALSE + ) + skip_if_null_response(result, "get_user_avatar(user_id = 5, dest_path = temp_file)") + + expect_type(result, "character") + expect_true(file.exists(result)) + expect_gt(file.size(result), 0) + + # Clean up + unlink(result) +}) + +test_that("get_user_avatar creates parent directories if needed", { + # User ID 5 is known to have an avatar + temp_dir <- tempfile() + nested_path <- file.path(temp_dir, "subdir", "avatar.jpg") + + result <- get_user_avatar( + user_id = 5, + dest_path = nested_path, + vb = FALSE + ) + skip_if_null_response(result, "get_user_avatar(user_id = 5, dest_path = nested_path)") + + expect_type(result, "character") + expect_true(file.exists(result)) + expect_gt(file.size(result), 0) + + # Clean up + unlink(temp_dir, recursive = TRUE) +}) + +test_that("get_user_avatar returns NULL for non-existent user", { + result <- get_user_avatar(user_id = 999999, vb = FALSE) + expect_null(result) +}) + +test_that("get_user_avatar works with verbose mode", { + # User ID 5 is known to have an avatar + result <- get_user_avatar(user_id = 5, vb = TRUE) + skip_if_null_response(result, "get_user_avatar(user_id = 5, vb = TRUE)") + + expect_type(result, "raw") + expect_gt(length(result), 0) +}) + +test_that("get_user_avatar rejects invalid user_id", { + # Non-numeric user_id + expect_error(get_user_avatar(user_id = "abc")) + expect_error(get_user_avatar(user_id = TRUE)) + expect_error(get_user_avatar(user_id = list(a = 1))) + + # Multiple values + expect_error(get_user_avatar(user_id = c(1, 2))) + + # Negative or zero user_id + expect_error(get_user_avatar(user_id = 0)) + expect_error(get_user_avatar(user_id = -1)) + + # NULL or NA user_id + expect_error(get_user_avatar(user_id = NULL)) + expect_error(get_user_avatar(user_id = NA)) +}) + +test_that("get_user_avatar rejects invalid dest_path", { + # Non-character dest_path + expect_error(get_user_avatar(user_id = 5, dest_path = 123)) + expect_error(get_user_avatar(user_id = 5, dest_path = TRUE)) + expect_error(get_user_avatar(user_id = 5, dest_path = list(a = 1))) + + # Multiple values + expect_error(get_user_avatar(user_id = 5, dest_path = c("path1", "path2"))) +}) + +test_that("get_user_avatar rejects invalid vb parameter", { + expect_error(get_user_avatar(user_id = 5, vb = -1)) + expect_error(get_user_avatar(user_id = 5, vb = 3)) + expect_error(get_user_avatar(user_id = 5, vb = "a")) + expect_error(get_user_avatar(user_id = 5, vb = list(a = 1, b = 2))) + expect_error(get_user_avatar(user_id = 5, vb = c(TRUE, FALSE))) + expect_error(get_user_avatar(user_id = 5, vb = NULL)) +}) + +test_that("get_user_avatar rejects invalid rq parameter", { + expect_error(get_user_avatar(user_id = 5, rq = "a")) + expect_error(get_user_avatar(user_id = 5, rq = -1)) + expect_error(get_user_avatar(user_id = 5, rq = c(2, 3))) + expect_error(get_user_avatar(user_id = 5, rq = list(a = 1, b = 2))) + expect_error(get_user_avatar(user_id = 5, rq = TRUE)) +}) + +test_that("get_user_avatar bytes and file content are identical", { + # User ID 5 is known to have an avatar + # Get bytes + bytes_result <- get_user_avatar(user_id = 5, vb = FALSE) + skip_if_null_response(bytes_result, "get_user_avatar(user_id = 5)") + + # Save to file + temp_file <- tempfile(fileext = ".jpg") + file_result <- get_user_avatar( + user_id = 5, + dest_path = temp_file, + vb = FALSE + ) + skip_if_null_response(file_result, "get_user_avatar(user_id = 5, dest_path = temp_file)") + + # Read file and compare + file_bytes <- readBin(file_result, "raw", file.info(file_result)$size) + expect_equal(bytes_result, file_bytes) + + # Clean up + unlink(file_result) +}) + +test_that("get_user_avatar saves to directory with auto-determined filename", { + # User ID 5 is known to have an avatar + # Create a temporary directory + temp_dir <- tempfile() + dir.create(temp_dir) + + result <- get_user_avatar( + user_id = 5, + dest_path = temp_dir, + vb = FALSE + ) + skip_if_null_response(result, "get_user_avatar(user_id = 5, dest_path = temp_dir)") + + expect_type(result, "character") + expect_true(file.exists(result)) + expect_gt(file.size(result), 0) + + # Check that the file is in the temp_dir + expect_true(startsWith(result, normalizePath(temp_dir))) + + # Check that filename was auto-determined + filename <- basename(result) + expect_true(nchar(filename) > 0) + # The filename should either be from content-disposition header or our fallback + # Accept any reasonable filename pattern + expect_true(grepl("avatar|user", filename, ignore.case = TRUE) || filename == "downloaded_file") + + # Clean up + unlink(temp_dir, recursive = TRUE) +}) + +test_that("get_user_avatar works with custom request object", { + custom_rq <- databraryr::make_default_request() + result <- get_user_avatar(user_id = 5, rq = custom_rq, vb = FALSE) + skip_if_null_response(result, "get_user_avatar(user_id = 5, rq = custom_rq)") + + expect_type(result, "raw") + expect_gt(length(result), 0) +}) + +test_that("get_user_avatar handles overwriting existing files", { + # User ID 5 is known to have an avatar + temp_file <- tempfile(fileext = ".jpg") + + # First write + result1 <- get_user_avatar( + user_id = 5, + dest_path = temp_file, + vb = FALSE + ) + skip_if_null_response(result1, "get_user_avatar(user_id = 5, dest_path = temp_file)") + + first_size <- file.size(result1) + + # Second write (overwrite) + result2 <- get_user_avatar( + user_id = 5, + dest_path = temp_file, + vb = FALSE + ) + skip_if_null_response(result2, "get_user_avatar(user_id = 5, dest_path = temp_file) [overwrite]") + + second_size <- file.size(result2) + + # Both should point to same file + expect_equal(result1, result2) + # Sizes should be the same (same avatar) + expect_equal(first_size, second_size) + + # Clean up + unlink(result2) +}) \ No newline at end of file From d8ceda29fb63a81f79c23be8c3675dafd27db1c9 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Fri, 12 Dec 2025 09:45:59 +0100 Subject: [PATCH 15/77] feat: add get_session_file function with tests --- NAMESPACE | 1 + R/get_session_file.R | 65 ++++++++++++++++++++++++++ man/get_session_file.Rd | 41 ++++++++++++++++ tests/testthat/test-get_session_file.R | 44 +++++++++++++++++ 4 files changed, 151 insertions(+) create mode 100644 R/get_session_file.R create mode 100644 man/get_session_file.Rd create mode 100644 tests/testthat/test-get_session_file.R diff --git a/NAMESPACE b/NAMESPACE index 1d62eff1..f27b9b0e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -26,6 +26,7 @@ export(get_permission_levels) export(get_release_levels) export(get_session_by_id) export(get_session_by_name) +export(get_session_file) export(get_supported_file_types) export(get_tag_by_id) export(get_user_avatar) diff --git a/R/get_session_file.R b/R/get_session_file.R new file mode 100644 index 00000000..895ce274 --- /dev/null +++ b/R/get_session_file.R @@ -0,0 +1,65 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get Session File Data From A Databrary Volume +#' +#' @param vol_id An integer indicating the volume identifier. Default is 1. +#' @param session_id An integer indicating a valid session/slot identifier +#' linked to a volume. Default value is 9807, the materials folder for volume 1. +#' @param file_id An integer indicating the file identifier. +#' @param rq An httr2 request object. +#' +#' @returns A JSON blob with the file data. If the user has previously logged +#' in to Databrary via `login_db()`, then files that have restricted access +#' can be downloaded, subject to the sharing release levels on those files. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' get_session_file(vol_id = 2, session_id = 11, file_id = 1) +#' } +#' } +#' @export +get_session_file <- + function(vol_id = 1, + session_id = 9807, + file_id, + vb = options::opt("vb"), + rq = NULL) { + + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id > 0) + assertthat::assert_that(length(vol_id) == 1) + + assertthat::assert_that(is.numeric(session_id)) + assertthat::assert_that(session_id > 0) + assertthat::assert_that(length(session_id) == 1) + + assertthat::assert_that(is.numeric(file_id)) + assertthat::assert_that(file_id > 0) + assertthat::assert_that(length(file_id) == 1) + + assertthat::assert_that(is.logical(vb)) + assertthat::assert_that(length(vb) == 1) + + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + file <- perform_api_get( + path = sprintf(API_SESSION_FILE_DETAIL, vol_id, session_id, file_id), + rq = rq, + vb = vb + ) + + if (is.null(file)) { + if (vb) { + message("Cannot access requested file ", file_id, " in session ", session_id, " of volume ", vol_id) + } + return(NULL) + } + + file + } diff --git a/man/get_session_file.Rd b/man/get_session_file.Rd new file mode 100644 index 00000000..041298ad --- /dev/null +++ b/man/get_session_file.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_session_file.R +\name{get_session_file} +\alias{get_session_file} +\title{Get Session File Data From A Databrary Volume} +\usage{ +get_session_file( + vol_id = 1, + session_id = 9807, + file_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{An integer indicating the volume identifier. Default is 1.} + +\item{session_id}{An integer indicating a valid session/slot identifier +linked to a volume. Default value is 9807, the materials folder for volume 1.} + +\item{file_id}{An integer indicating the file identifier.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An httr2 request object.} +} +\value{ +A JSON blob with the file data. If the user has previously logged +in to Databrary via \code{login_db()}, then files that have restricted access +can be downloaded, subject to the sharing release levels on those files. +} +\description{ +Get Session File Data From A Databrary Volume +} +\examples{ +\donttest{ +\dontrun{ +get_session_file(vol_id = 2, session_id = 11, file_id = 1) +} +} +} diff --git a/tests/testthat/test-get_session_file.R b/tests/testthat/test-get_session_file.R new file mode 100644 index 00000000..dd6e300b --- /dev/null +++ b/tests/testthat/test-get_session_file.R @@ -0,0 +1,44 @@ +# get_session_file ------------------------------------------------------- +test_that("get_session_file returns file metadata", { + login_test_account() + files <- list_volume_session_assets(vol_id = 2, session_id = 11) + skip_if_null_response(files, "list_volume_session_assets(vol_id = 2, session_id = 11)") + + target_file <- files$asset_id[1] + result <- get_session_file(vol_id = 2, session_id = 11, file_id = target_file) + skip_if_null_response(result, sprintf("get_session_file(vol_id = 2, session_id = 11, file_id = %s)", target_file)) + + expect_type(result, "list") + expect_equal(result$id, target_file) + expect_true(all(c("id", "name") %in% names(result))) +}) + +test_that("get_session_file rejects bad input parameters", { + expect_error(get_session_file(vol_id = "a", file_id = 1)) + expect_error(get_session_file(vol_id = c(1, 2), file_id = 1)) + expect_error(get_session_file(vol_id = TRUE, file_id = 1)) + expect_error(get_session_file(vol_id = list(a = 1), file_id = 1)) + expect_error(get_session_file(vol_id = -1, file_id = 1)) + + expect_error(get_session_file(session_id = "a", file_id = 1)) + expect_error(get_session_file(session_id = c(1, 2), file_id = 1)) + expect_error(get_session_file(session_id = TRUE, file_id = 1)) + expect_error(get_session_file(session_id = list(a = 1), file_id = 1)) + expect_error(get_session_file(session_id = -1, file_id = 1)) + + expect_error(get_session_file(file_id = "a")) + expect_error(get_session_file(file_id = c(1, 2))) + expect_error(get_session_file(file_id = TRUE)) + expect_error(get_session_file(file_id = list(a = 1))) + expect_error(get_session_file(file_id = -1)) + + expect_error(get_session_file(file_id = 1, vb = -1)) + expect_error(get_session_file(file_id = 1, vb = 3)) + expect_error(get_session_file(file_id = 1, vb = "a")) + expect_error(get_session_file(file_id = 1, vb = list(a = 1))) + + expect_error(get_session_file(file_id = 1, rq = "a")) + expect_error(get_session_file(file_id = 1, rq = -1)) + expect_error(get_session_file(file_id = 1, rq = c(2, 3))) + expect_error(get_session_file(file_id = 1, rq = list(a = 1))) +}) From 2d1737d9ce2b37d9bf105b51f018fbeca1e4d51e Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Fri, 12 Dec 2025 10:31:33 +0100 Subject: [PATCH 16/77] chore: remove get_file_duration --- NAMESPACE | 1 - R/utils.R | 298 +++++++++++++----------------------- man/get_file_duration.Rd | 40 ----- tests/testthat/test-utils.R | 34 +--- 4 files changed, 108 insertions(+), 265 deletions(-) delete mode 100644 man/get_file_duration.Rd diff --git a/NAMESPACE b/NAMESPACE index f27b9b0e..270686d9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -17,7 +17,6 @@ export(download_video) export(download_volume_zip) export(get_category_by_id) export(get_db_stats) -export(get_file_duration) export(get_folder_by_id) export(get_funder_by_id) export(get_institution_avatar) diff --git a/R/utils.R b/R/utils.R index f605de05..e1e1059f 100644 --- a/R/utils.R +++ b/R/utils.R @@ -8,215 +8,131 @@ #' NULL -#' Get Duration (In ms) Of A File. -#' -#' @param vol_id Volume ID. -#' @param session_id Session ID containing the asset. -#' @param asset_id Asset number. -#' @param types_w_durations Asset types that have valid durations. -#' @param rq An `httr2` request object. Default is NULL. + +#---------------------------------------------------------------------------- +#' Extract Databrary Permission Levels. #' -#' @returns Duration of a file in ms. +#' @returns An array with the permission levels that can be assigned to data. #' #' @inheritParams options_params #' #' @examples #' \donttest{ -#' get_file_duration() # default is a public video from volume 1 +#' get_permission_levels() #' } #' #' @export -get_file_duration <- function(vol_id = 2, - session_id = 9, - asset_id = 2, - types_w_durations = c(-600, -800), - vb = options::opt("vb"), - rq = NULL) { - assertthat::assert_that(is.numeric(vol_id)) - assertthat::assert_that(vol_id > 0) - assertthat::assert_that(length(vol_id) == 1) - - assertthat::assert_that(is.numeric(session_id)) - assertthat::assert_that(session_id > 0) - assertthat::assert_that(length(session_id) == 1) - - assertthat::assert_that(is.numeric(asset_id)) - assertthat::assert_that(asset_id > 0) - assertthat::assert_that(length(asset_id) == 1) - - assertthat::assert_that(is.atomic(types_w_durations)) - - assertthat::assert_that(is.logical(vb)) - assertthat::assert_that(length(vb) == 1) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - types_w_durations <- as.character(types_w_durations) - - asset <- perform_api_get( - path = sprintf(API_SESSION_FILE_DETAIL, vol_id, session_id, asset_id), - rq = rq, - vb = vb - ) - - if (is.null(asset)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(NULL) - } - - format <- asset$format - format_id_chr <- as.character(format$id) - - if (!is.na(format_id_chr) && !(format_id_chr %in% types_w_durations)) { - if (vb) { - message("Asset format does not include duration metadata.") - } - return(NULL) - } - - duration_value <- asset$duration - - if (is.null(duration_value)) { - if (vb) { - message("Duration metadata not available for the requested asset.") - } - return(NULL) - } - - duration_value <- suppressWarnings(as.numeric(duration_value)) - - if (is.na(duration_value)) { - return(NULL) - } - - round(duration_value * 1000) -} - - #---------------------------------------------------------------------------- - #' Extract Databrary Permission Levels. - #' - #' @returns An array with the permission levels that can be assigned to data. - #' - #' @inheritParams options_params - #' - #' @examples - #' \donttest{ - #' get_permission_levels() - #' } - #' - #' @export get_permission_levels <- function(vb = options::opt("vb")) { enums <- get_permission_levels_enums() enums$volume_access_levels } - #---------------------------------------------------------------------------- - #' Convert Timestamp String To ms. - #' - #' @param HHMMSSmmm a string in the format "HH:MM:SS:mmm" - #' - #' @returns A numeric value in ms from the input string. - #' - #' @examples - #' HHMMSSmmm_to_ms() # 01:01:01:333 in ms - #' @export - HHMMSSmmm_to_ms <- function(HHMMSSmmm = "01:01:01:333") { - # Check parameters - if (!is.character(HHMMSSmmm)) { - stop("HHMMSSmmm must be a string.") - } - - if (stringr::str_detect(HHMMSSmmm, - "([0-9]{2}):([0-9]{2}):([0-9]{2}):([0-9]{3})")) { - time_segs <- stringr::str_match(HHMMSSmmm, - "([0-9]{2}):([0-9]{2}):([0-9]{2}):([0-9]{3})") - as.numeric(time_segs[5]) + as.numeric(time_segs[4]) * - 1000 + as.numeric(time_segs[3]) * 1000 * 60 + - as.numeric(time_segs[2]) * 1000 * 60 * 60 - } else { - NULL - } +#---------------------------------------------------------------------------- +#' Convert Timestamp String To ms. +#' +#' @param HHMMSSmmm a string in the format "HH:MM:SS:mmm" +#' +#' @returns A numeric value in ms from the input string. +#' +#' @examples +#' HHMMSSmmm_to_ms() # 01:01:01:333 in ms +#' @export +HHMMSSmmm_to_ms <- function(HHMMSSmmm = "01:01:01:333") { + # Check parameters + if (!is.character(HHMMSSmmm)) { + stop("HHMMSSmmm must be a string.") } - #---------------------------------------------------------------------------- - #' Show Databrary Release Levels - #' - #' @returns A data frame with Databrary's release levels. - #' - #' @inheritParams options_params - #' - #' @examples - #' \donttest{ - #' get_release_levels() - #' } - #' - #' @export - get_release_levels <- function(vb = options::opt("vb")) { - enums <- get_release_levels_enums() - vapply(enums$levels, function(item) item$code, character(1)) + if (stringr::str_detect(HHMMSSmmm, + "([0-9]{2}):([0-9]{2}):([0-9]{2}):([0-9]{3})")) { + time_segs <- stringr::str_match(HHMMSSmmm, + "([0-9]{2}):([0-9]{2}):([0-9]{2}):([0-9]{3})") + as.numeric(time_segs[5]) + as.numeric(time_segs[4]) * + 1000 + as.numeric(time_segs[3]) * 1000 * 60 + + as.numeric(time_segs[2]) * 1000 * 60 * 60 + } else { + NULL } +} + +#---------------------------------------------------------------------------- +#' Show Databrary Release Levels +#' +#' @returns A data frame with Databrary's release levels. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' get_release_levels() +#' } +#' +#' @export +get_release_levels <- function(vb = options::opt("vb")) { +enums <- get_release_levels_enums() +vapply(enums$levels, function(item) item$code, character(1)) +} + +#---------------------------------------------------------------------------- +#' Extracts File Types Supported by Databrary. +#' +#' +#' @returns A data frame with the file types permitted on Databrary. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' get_supported_file_types() +#' } +#' +#' @export +get_supported_file_types <- function(vb = options::opt("vb")) { +constants <- assign_constants(vb = vb) +constants$format_df |> + dplyr::rename( + asset_type = name, + asset_type_id = id, + asset_category = category + ) +} + +#---------------------------------------------------------------------------- +#' Make Portable File Names +#' +#' @param fn Databrary party ID +#' @param replace_regex A character string. A regular expression to capture +#' the "non-portable" characters in fn. +#' @param replacement_char A character string. The character(s) that will +#' replace the non-portable characters. +#' +#' @returns A "cleaned" portable file name +#' +#' @inheritParams options_params +#' +make_fn_portable <- function(fn, + vb = options::opt("vb"), + replace_regex = "[ &\\!\\)\\(\\}\\{\\[\\]\\+\\=@#\\$%\\^\\*]", + replacement_char = "_") { + assertthat::is.string(fn) + assertthat::assert_that(!is.numeric(fn)) + assertthat::assert_that(!is.logical(fn)) + assertthat::assert_that(length(fn) == 1) - #---------------------------------------------------------------------------- - #' Extracts File Types Supported by Databrary. - #' - #' - #' @returns A data frame with the file types permitted on Databrary. - #' - #' @inheritParams options_params - #' - #' @examples - #' \donttest{ - #' get_supported_file_types() - #' } - #' - #' @export - get_supported_file_types <- function(vb = options::opt("vb")) { - constants <- assign_constants(vb = vb) - constants$format_df |> - dplyr::rename( - asset_type = name, - asset_type_id = id, - asset_category = category - ) - } + assertthat::assert_that(is.logical(vb)) + assertthat::assert_that(length(vb) == 1) + + assertthat::is.string(replace_regex) + assertthat::assert_that(length(replace_regex) == 1) - #---------------------------------------------------------------------------- - #' Make Portable File Names - #' - #' @param fn Databrary party ID - #' @param replace_regex A character string. A regular expression to capture - #' the "non-portable" characters in fn. - #' @param replacement_char A character string. The character(s) that will - #' replace the non-portable characters. - #' - #' @returns A "cleaned" portable file name - #' - #' @inheritParams options_params - #' - make_fn_portable <- function(fn, - vb = options::opt("vb"), - replace_regex = "[ &\\!\\)\\(\\}\\{\\[\\]\\+\\=@#\\$%\\^\\*]", - replacement_char = "_") { - assertthat::is.string(fn) - assertthat::assert_that(!is.numeric(fn)) - assertthat::assert_that(!is.logical(fn)) - assertthat::assert_that(length(fn) == 1) - - assertthat::assert_that(is.logical(vb)) - assertthat::assert_that(length(vb) == 1) - - assertthat::is.string(replace_regex) - assertthat::assert_that(length(replace_regex) == 1) - - assertthat::is.string(replacement_char) - assertthat::assert_that(length(replacement_char) == 1) - - if (vb) { - non_portable_chars <- stringr::str_detect(fn, replace_regex) - message("There are ", sum(non_portable_chars), " in ", fn) - } - new_fn <- stringr::str_replace_all(fn, replace_regex, replacement_char) - new_fn + assertthat::is.string(replacement_char) + assertthat::assert_that(length(replacement_char) == 1) + + if (vb) { + non_portable_chars <- stringr::str_detect(fn, replace_regex) + message("There are ", sum(non_portable_chars), " in ", fn) } + new_fn <- stringr::str_replace_all(fn, replace_regex, replacement_char) + new_fn +} \ No newline at end of file diff --git a/man/get_file_duration.Rd b/man/get_file_duration.Rd deleted file mode 100644 index 2f85028d..00000000 --- a/man/get_file_duration.Rd +++ /dev/null @@ -1,40 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{get_file_duration} -\alias{get_file_duration} -\title{Get Duration (In ms) Of A File.} -\usage{ -get_file_duration( - vol_id = 2, - session_id = 9, - asset_id = 2, - types_w_durations = c(-600, -800), - vb = options::opt("vb"), - rq = NULL -) -} -\arguments{ -\item{vol_id}{Volume ID.} - -\item{session_id}{Session ID containing the asset.} - -\item{asset_id}{Asset number.} - -\item{types_w_durations}{Asset types that have valid durations.} - -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - -\item{rq}{An \code{httr2} request object. Default is NULL.} -} -\value{ -Duration of a file in ms. -} -\description{ -Get Duration (In ms) Of A File. -} -\examples{ -\donttest{ -get_file_duration() # default is a public video from volume 1 -} - -} diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index d0da8d1b..6286b45e 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1,38 +1,6 @@ -# get_file_duration --------------------------------------------------------- -test_that("get_file_duration returns duration metadata for a known asset", { - login_test_account() - result <- get_file_duration() - skip_if_null_response(result, "get_file_duration()") - expect_true(is.numeric(result) && length(result) == 1) - - asset_detail <- perform_api_get( - path = sprintf(API_SESSION_FILE_DETAIL, 2, 9, 2), - vb = FALSE - ) - expect_true("thumbnail_url" %in% names(asset_detail)) - expect_true(is.null(asset_detail$thumbnail_url) || nzchar(asset_detail$thumbnail_url)) -}) - -test_that("get_file_duration rejects bad input parameters", { - expect_error(get_file_duration(vol_id = "a")) - expect_error(get_file_duration(vol_id = -1)) - expect_error(get_file_duration(vol_id = c(1, 3))) - - expect_error(get_file_duration(session_id = "a")) - expect_error(get_file_duration(session_id = -1)) - expect_error(get_file_duration(session_id = c(1, 3))) - - expect_error(get_file_duration(asset_id = "a")) - expect_error(get_file_duration(asset_id = -1)) - expect_error(get_file_duration(asset_id = c(1, 3))) - - expect_error(get_file_duration(vb = "a")) - expect_error(get_file_duration(vb = -1)) - expect_error(get_file_duration(vb = c(2, 3))) -}) - # get_permission_levels ------------------------------------------------------- test_that("get_permission_levels returns a character array", { + login_test_account() levels <- get_permission_levels() expect_true(is.character(levels)) expect_true(length(levels) > 0) From be72a51a5eae2ef88291c25119bdd02868403205 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Fri, 12 Dec 2025 15:30:50 +0100 Subject: [PATCH 17/77] =?UTF-8?q?=1Bfeat:=20add=20get=5Ffolder=5Ffile=20fu?= =?UTF-8?q?nction=20with=20tests?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- NAMESPACE | 1 + R/CONSTANTS.R | 1 + R/get_folder_file.R | 65 +++++++++++++++++++++++++++ man/get_folder_file.Rd | 41 +++++++++++++++++ tests/testthat/test-get_folder_file.R | 44 ++++++++++++++++++ 5 files changed, 152 insertions(+) create mode 100644 R/get_folder_file.R create mode 100644 man/get_folder_file.Rd create mode 100644 tests/testthat/test-get_folder_file.R diff --git a/NAMESPACE b/NAMESPACE index 270686d9..a406a9d6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,6 +18,7 @@ export(download_volume_zip) export(get_category_by_id) export(get_db_stats) export(get_folder_by_id) +export(get_folder_file) export(get_funder_by_id) export(get_institution_avatar) export(get_institution_by_id) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 97199e5e..ec0a15e7 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -36,6 +36,7 @@ API_SESSION_DOWNLOAD_LINK <- "/volumes/%s/sessions/%s/download-link/" API_SESSION_CSV_DOWNLOAD_LINK <- "/volumes/%s/sessions/%s/csv-download-link/" API_FOLDER_DETAIL <- "/volumes/%s/folders/%s/" API_FOLDER_FILES <- "/volumes/%s/folders/%s/files/" +API_FOLDER_FILES_DETAIL <- "/volumes/%s/folders/%s/files/%s/" API_FOLDER_DOWNLOAD_LINK <- "/volumes/%s/folders/%s/download-link/" API_FOLDER_FILE_DOWNLOAD_LINK <- "/volumes/%s/folders/%s/files/%s/download-link/" API_VOLUME_DOWNLOAD_LINK <- "/volumes/%s/download-link/" diff --git a/R/get_folder_file.R b/R/get_folder_file.R new file mode 100644 index 00000000..997ca29c --- /dev/null +++ b/R/get_folder_file.R @@ -0,0 +1,65 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get Session File Data From A Databrary Volume +#' +#' @param vol_id An integer indicating the volume identifier. Default is 1. +#' @param folder_id An integer indicating a valid folder identifier +#' linked to a volume. Default value is 9807, the materials folder for volume 1. +#' @param file_id An integer indicating the file identifier. +#' @param rq An httr2 request object. +#' +#' @returns A JSON blob with the file data. If the user has previously logged +#' in to Databrary via `login_db()`, then files that have restricted access +#' can be downloaded, subject to the sharing release levels on those files. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' get_session_file(vol_id = 2, session_id = 11, file_id = 1) +#' } +#' } +#' @export +get_folder_file <- + function(vol_id = 1, + folder_id = 9807, + file_id, + vb = options::opt("vb"), + rq = NULL) { + + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id > 0) + assertthat::assert_that(length(vol_id) == 1) + + assertthat::assert_that(is.numeric(folder_id)) + assertthat::assert_that(folder_id > 0) + assertthat::assert_that(length(folder_id) == 1) + + assertthat::assert_that(is.numeric(file_id)) + assertthat::assert_that(file_id > 0) + assertthat::assert_that(length(file_id) == 1) + + assertthat::assert_that(is.logical(vb)) + assertthat::assert_that(length(vb) == 1) + + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + file <- perform_api_get( + path = sprintf(API_FOLDER_FILES_DETAIL, vol_id, folder_id, file_id), + rq = rq, + vb = vb + ) + + if (is.null(file)) { + if (vb) { + message("Cannot access requested file ", file_id, " in folder ", folder_id, " of volume ", vol_id) + } + return(NULL) + } + + file + } diff --git a/man/get_folder_file.Rd b/man/get_folder_file.Rd new file mode 100644 index 00000000..6154145f --- /dev/null +++ b/man/get_folder_file.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_folder_file.R +\name{get_folder_file} +\alias{get_folder_file} +\title{Get Session File Data From A Databrary Volume} +\usage{ +get_folder_file( + vol_id = 1, + folder_id = 9807, + file_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{An integer indicating the volume identifier. Default is 1.} + +\item{folder_id}{An integer indicating a valid folder identifier +linked to a volume. Default value is 9807, the materials folder for volume 1.} + +\item{file_id}{An integer indicating the file identifier.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An httr2 request object.} +} +\value{ +A JSON blob with the file data. If the user has previously logged +in to Databrary via \code{login_db()}, then files that have restricted access +can be downloaded, subject to the sharing release levels on those files. +} +\description{ +Get Session File Data From A Databrary Volume +} +\examples{ +\donttest{ +\dontrun{ +get_session_file(vol_id = 2, session_id = 11, file_id = 1) +} +} +} diff --git a/tests/testthat/test-get_folder_file.R b/tests/testthat/test-get_folder_file.R new file mode 100644 index 00000000..21e88c0d --- /dev/null +++ b/tests/testthat/test-get_folder_file.R @@ -0,0 +1,44 @@ +# get_folder_file ------------------------------------------------------- +test_that("get_folder_file returns file metadata", { + login_test_account() + files <- list_folder_assets(vol_id = 1, folder_id = 1) + skip_if_null_response(files, "list_folder_assets(vol_id = 1, folder_id = 1)") + + target_file <- files$asset_id[1] + result <- get_folder_file(vol_id = 1, folder_id = 1, file_id = target_file) + skip_if_null_response(result, sprintf("get_folder_file(vol_id = 1, folder_id = 1, file_id = %s)", target_file)) + + expect_type(result, "list") + expect_equal(result$id, target_file) + expect_true(all(c("id", "name") %in% names(result))) +}) + +test_that("get_folder_file rejects bad input parameters", { + expect_error(get_folder_file(vol_id = "a", file_id = 1)) + expect_error(get_folder_file(vol_id = c(1, 2), file_id = 1)) + expect_error(get_folder_file(vol_id = TRUE, file_id = 1)) + expect_error(get_folder_file(vol_id = list(a = 1), file_id = 1)) + expect_error(get_folder_file(vol_id = -1, file_id = 1)) + + expect_error(get_folder_file(folder_id = "a", file_id = 1)) + expect_error(get_folder_file(folder_id = c(1, 2), file_id = 1)) + expect_error(get_folder_file(folder_id = TRUE, file_id = 1)) + expect_error(get_folder_file(folder_id = list(a = 1), file_id = 1)) + expect_error(get_folder_file(folder_id = -1, file_id = 1)) + + expect_error(get_folder_file(file_id = "a")) + expect_error(get_folder_file(file_id = c(1, 2))) + expect_error(get_folder_file(file_id = TRUE)) + expect_error(get_folder_file(file_id = list(a = 1))) + expect_error(get_folder_file(file_id = -1)) + + expect_error(get_folder_file(file_id = 1, vb = -1)) + expect_error(get_folder_file(file_id = 1, vb = 3)) + expect_error(get_folder_file(file_id = 1, vb = "a")) + expect_error(get_folder_file(file_id = 1, vb = list(a = 1))) + + expect_error(get_folder_file(file_id = 1, rq = "a")) + expect_error(get_folder_file(file_id = 1, rq = -1)) + expect_error(get_folder_file(file_id = 1, rq = c(2, 3))) + expect_error(get_folder_file(file_id = 1, rq = list(a = 1))) +}) From c8cc694456d3df4b2d31c6f17cd630d06c52f9e9 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Tue, 16 Dec 2025 10:39:06 +0100 Subject: [PATCH 18/77] chore: format changed files --- R/get_category_by_id.R | 16 +-- R/get_db_stats.R | 111 ++++++++++++++------- R/get_folder_file.R | 22 +++-- R/get_funder_by_id.R | 16 +-- R/get_institution_avatar.R | 155 ++++++++++++++++++------------ R/get_session_file.R | 22 +++-- R/get_tag_by_id.R | 10 +- R/get_user_avatar.R | 25 +++-- R/get_volume_collaborator_by_id.R | 37 ++++--- R/get_volume_record_by_id.R | 30 ++++-- R/list_categories.R | 9 +- R/list_institutions.R | 64 +++++++++--- R/list_volume_records.R | 70 +++++++++++--- 13 files changed, 397 insertions(+), 190 deletions(-) diff --git a/R/get_category_by_id.R b/R/get_category_by_id.R index 1b137692..2119cf04 100644 --- a/R/get_category_by_id.R +++ b/R/get_category_by_id.R @@ -28,15 +28,19 @@ NULL #' } #' } #' @export -get_category_by_id <- function(category_id = 1, - vb = options::opt("vb"), - rq = NULL) { +get_category_by_id <- function( + category_id = 1, + vb = options::opt("vb"), + rq = NULL +) { # Validate category_id assertthat::assert_that(is.numeric(category_id)) assertthat::assert_that(length(category_id) == 1) assertthat::assert_that(category_id > 0) - assertthat::assert_that(category_id == floor(category_id), - msg = "category_id must be an integer") + assertthat::assert_that( + category_id == floor(category_id), + msg = "category_id must be an integer" + ) # Validate vb assertthat::assert_that(length(vb) == 1) @@ -83,4 +87,4 @@ get_category_by_id <- function(category_id = 1, category_description = category$description, metrics = metrics ) -} \ No newline at end of file +} diff --git a/R/get_db_stats.R b/R/get_db_stats.R index 239ac0f2..35809aec 100644 --- a/R/get_db_stats.R +++ b/R/get_db_stats.R @@ -1,6 +1,6 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL #' Get Stats About Databrary. @@ -11,11 +11,11 @@ NULL #' @param type Type of Databrary report to run "institutions", "people", "data" #' @param rq An `httr2` request object. #' -#' @returns A data frame with the requested data or NULL if there is +#' @returns A data frame with the requested data or NULL if there is #' no new information. #' #' @inheritParams options_params -#' +#' #' @examples #' \donttest{ #' get_db_stats() @@ -24,33 +24,34 @@ NULL #' get_db_stats("places") # Information about the newest institutions. #' } #' @export -get_db_stats <- function(type = "stats", - vb = options::opt("vb"), - rq = NULL) { +get_db_stats <- function(type = "stats", vb = options::opt("vb"), rq = NULL) { # Check parameters assertthat::assert_that(length(type) == 1) assertthat::assert_that(is.character(type)) assertthat::assert_that( - type %in% c( - "institutions", - "places", - "people", - "researchers", - "investigators", - "datasets", - "data", - "volumes", - "stats", - "numbers" - ) + type %in% + c( + "institutions", + "places", + "people", + "researchers", + "investigators", + "datasets", + "data", + "volumes", + "stats", + "numbers" + ) ) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - + + assertthat::assert_that( + is.null(rq) | + ("httr2_request" %in% class(rq)) + ) + if (is.null(rq)) { if (vb) { message("\nNULL request object. Will generate default.") @@ -63,27 +64,67 @@ get_db_stats <- function(type = "stats", rq = rq, vb = vb ) - + if (is.null(stats)) { message("Cannot access requested resource on Databrary. Exiting.") return(NULL) } - + if (type %in% c("stats", "numbers")) { # Map new API field names to output tibble::tibble( date = Sys.time(), - institutions = if (!is.null(stats$institutions)) stats$institutions else NA_integer_, - affiliates = if (!is.null(stats$affiliates)) stats$affiliates else NA_integer_, - investigators = if (!is.null(stats$investigators)) stats$investigators else NA_integer_, - hours_of_recordings = if (!is.null(stats$hours_of_recordings)) stats$hours_of_recordings else NA_integer_, + institutions = if (!is.null(stats$institutions)) { + stats$institutions + } else { + NA_integer_ + }, + affiliates = if (!is.null(stats$affiliates)) { + stats$affiliates + } else { + NA_integer_ + }, + investigators = if (!is.null(stats$investigators)) { + stats$investigators + } else { + NA_integer_ + }, + hours_of_recordings = if (!is.null(stats$hours_of_recordings)) { + stats$hours_of_recordings + } else { + NA_integer_ + }, # Legacy fields (may not be present in new API) - authorized_users = if (!is.null(stats$authorized_users)) stats$authorized_users else NA_integer_, - total_volumes = if (!is.null(stats$total_volumes)) stats$total_volumes else NA_integer_, - public_volumes = if (!is.null(stats$public_volumes)) stats$public_volumes else NA_integer_, - total_files = if (!is.null(stats$total_files)) stats$total_files else NA_integer_, - total_duration_hours = if (!is.null(stats$total_duration_hours)) stats$total_duration_hours else NA_real_, - total_storage_tb = if (!is.null(stats$total_storage_tb)) stats$total_storage_tb else NA_real_ + authorized_users = if (!is.null(stats$authorized_users)) { + stats$authorized_users + } else { + NA_integer_ + }, + total_volumes = if (!is.null(stats$total_volumes)) { + stats$total_volumes + } else { + NA_integer_ + }, + public_volumes = if (!is.null(stats$public_volumes)) { + stats$public_volumes + } else { + NA_integer_ + }, + total_files = if (!is.null(stats$total_files)) { + stats$total_files + } else { + NA_integer_ + }, + total_duration_hours = if (!is.null(stats$total_duration_hours)) { + stats$total_duration_hours + } else { + NA_real_ + }, + total_storage_tb = if (!is.null(stats$total_storage_tb)) { + stats$total_storage_tb + } else { + NA_real_ + } ) } else { # For other types, return the raw stats as a tibble diff --git a/R/get_folder_file.R b/R/get_folder_file.R index 997ca29c..57bc7e39 100644 --- a/R/get_folder_file.R +++ b/R/get_folder_file.R @@ -25,12 +25,13 @@ NULL #' } #' @export get_folder_file <- - function(vol_id = 1, - folder_id = 9807, - file_id, - vb = options::opt("vb"), - rq = NULL) { - + function( + vol_id = 1, + folder_id = 9807, + file_id, + vb = options::opt("vb"), + rq = NULL + ) { assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) assertthat::assert_that(length(vol_id) == 1) @@ -56,7 +57,14 @@ get_folder_file <- if (is.null(file)) { if (vb) { - message("Cannot access requested file ", file_id, " in folder ", folder_id, " of volume ", vol_id) + message( + "Cannot access requested file ", + file_id, + " in folder ", + folder_id, + " of volume ", + vol_id + ) } return(NULL) } diff --git a/R/get_funder_by_id.R b/R/get_funder_by_id.R index 01c688ed..b13c765a 100644 --- a/R/get_funder_by_id.R +++ b/R/get_funder_by_id.R @@ -27,15 +27,19 @@ NULL #' } #' } #' @export -get_funder_by_id <- function(funder_id = 1, - vb = options::opt("vb"), - rq = NULL) { +get_funder_by_id <- function( + funder_id = 1, + vb = options::opt("vb"), + rq = NULL +) { # Validate funder_id assertthat::assert_that(is.numeric(funder_id)) assertthat::assert_that(length(funder_id) == 1) assertthat::assert_that(funder_id > 0) - assertthat::assert_that(funder_id == floor(funder_id), - msg = "funder_id must be an integer") + assertthat::assert_that( + funder_id == floor(funder_id), + msg = "funder_id must be an integer" + ) # Validate vb assertthat::assert_that(length(vb) == 1) @@ -64,4 +68,4 @@ get_funder_by_id <- function(funder_id = 1, funder_name = funder$name, funder_is_approved = funder$is_approved ) -} \ No newline at end of file +} diff --git a/R/get_institution_avatar.R b/R/get_institution_avatar.R index 2ce3535e..836dcc64 100644 --- a/R/get_institution_avatar.R +++ b/R/get_institution_avatar.R @@ -47,16 +47,20 @@ NULL #' } #' } #' @export -get_institution_avatar <- function(institution_id = 1, - dest_path = NULL, - vb = options::opt("vb"), - rq = NULL) { +get_institution_avatar <- function( + institution_id = 1, + dest_path = NULL, + vb = options::opt("vb"), + rq = NULL +) { # Validate institution_id assertthat::assert_that(is.numeric(institution_id)) assertthat::assert_that(length(institution_id) == 1) assertthat::assert_that(institution_id > 0) - assertthat::assert_that(institution_id == floor(institution_id), - msg = "institution_id must be an integer") + assertthat::assert_that( + institution_id == floor(institution_id), + msg = "institution_id must be an integer" + ) # Validate dest_path if (!is.null(dest_path)) { @@ -92,72 +96,95 @@ get_institution_avatar <- function(institution_id = 1, } # Perform request - tryCatch({ - resp <- httr2::req_perform(req) - - # Check response status - status <- httr2::resp_status(resp) - if (status != 200) { - if (vb) { - message("Institution ", institution_id, " avatar not found or inaccessible (status: ", status, ")") + tryCatch( + { + resp <- httr2::req_perform(req) + + # Check response status + status <- httr2::resp_status(resp) + if (status != 200) { + if (vb) { + message( + "Institution ", + institution_id, + " avatar not found or inaccessible (status: ", + status, + ")" + ) + } + return(NULL) } - return(NULL) - } - # Get raw bytes - avatar_bytes <- httr2::resp_body_raw(resp) + # Get raw bytes + avatar_bytes <- httr2::resp_body_raw(resp) - if (is.null(dest_path)) { - # Return raw bytes - if (vb) { - message("Downloaded ", length(avatar_bytes), " bytes") - } - return(avatar_bytes) - } else { - # Resolve destination path - # If dest_path is a directory, determine filename from response headers or URL - final_path <- dest_path - if (dir.exists(dest_path)) { - # Try to get filename from content-disposition header - filename <- "downloaded_file" - content_disp <- httr2::resp_header(resp, "content-disposition") - - if (!is.null(content_disp) && grepl("filename=", content_disp)) { - # Extract filename from content-disposition header - filename_match <- regmatches(content_disp, regexpr("filename=([^;]+)", content_disp)) - if (length(filename_match) > 0) { - filename <- sub("filename=", "", filename_match) - filename <- gsub('^"|"$', '', filename) # Remove quotes - filename <- trimws(filename) - } - } else { - # Fallback: use URL path basename - url_path <- sprintf(API_INSTITUTION_AVATAR, institution_id) - filename <- paste0("institution_", institution_id, "_avatar.jpg") + if (is.null(dest_path)) { + # Return raw bytes + if (vb) { + message("Downloaded ", length(avatar_bytes), " bytes") } + return(avatar_bytes) + } else { + # Resolve destination path + # If dest_path is a directory, determine filename from response headers or URL + final_path <- dest_path + if (dir.exists(dest_path)) { + # Try to get filename from content-disposition header + filename <- "downloaded_file" + content_disp <- httr2::resp_header(resp, "content-disposition") + + if (!is.null(content_disp) && grepl("filename=", content_disp)) { + # Extract filename from content-disposition header + filename_match <- regmatches( + content_disp, + regexpr("filename=([^;]+)", content_disp) + ) + if (length(filename_match) > 0) { + filename <- sub("filename=", "", filename_match) + filename <- gsub('^"|"$', '', filename) # Remove quotes + filename <- trimws(filename) + } + } else { + # Fallback: use URL path basename + url_path <- sprintf(API_INSTITUTION_AVATAR, institution_id) + filename <- paste0("institution_", institution_id, "_avatar.jpg") + } - final_path <- file.path(dest_path, filename) - } + final_path <- file.path(dest_path, filename) + } - # Create parent directory if needed - parent_dir <- dirname(final_path) - if (!dir.exists(parent_dir)) { - dir.create(parent_dir, recursive = TRUE, showWarnings = FALSE) - } + # Create parent directory if needed + parent_dir <- dirname(final_path) + if (!dir.exists(parent_dir)) { + dir.create(parent_dir, recursive = TRUE, showWarnings = FALSE) + } - # Save to file - writeBin(avatar_bytes, final_path) + # Save to file + writeBin(avatar_bytes, final_path) + + if (vb) { + message( + "Saved avatar to: ", + final_path, + " (", + length(avatar_bytes), + " bytes)" + ) + } + return(normalizePath(final_path)) + } + }, + error = function(e) { if (vb) { - message("Saved avatar to: ", final_path, " (", length(avatar_bytes), " bytes)") + message( + "Error downloading avatar for institution ", + institution_id, + ": ", + e$message + ) } - - return(normalizePath(final_path)) - } - }, error = function(e) { - if (vb) { - message("Error downloading avatar for institution ", institution_id, ": ", e$message) + return(NULL) } - return(NULL) - }) -} \ No newline at end of file + ) +} diff --git a/R/get_session_file.R b/R/get_session_file.R index 895ce274..404d3ff7 100644 --- a/R/get_session_file.R +++ b/R/get_session_file.R @@ -25,12 +25,13 @@ NULL #' } #' @export get_session_file <- - function(vol_id = 1, - session_id = 9807, - file_id, - vb = options::opt("vb"), - rq = NULL) { - + function( + vol_id = 1, + session_id = 9807, + file_id, + vb = options::opt("vb"), + rq = NULL + ) { assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) assertthat::assert_that(length(vol_id) == 1) @@ -56,7 +57,14 @@ get_session_file <- if (is.null(file)) { if (vb) { - message("Cannot access requested file ", file_id, " in session ", session_id, " of volume ", vol_id) + message( + "Cannot access requested file ", + file_id, + " in session ", + session_id, + " of volume ", + vol_id + ) } return(NULL) } diff --git a/R/get_tag_by_id.R b/R/get_tag_by_id.R index 6f303145..529ea006 100644 --- a/R/get_tag_by_id.R +++ b/R/get_tag_by_id.R @@ -27,15 +27,15 @@ NULL #' } #' } #' @export -get_tag_by_id <- function(tag_id = 1, - vb = options::opt("vb"), - rq = NULL) { +get_tag_by_id <- function(tag_id = 1, vb = options::opt("vb"), rq = NULL) { # Validate tag_id assertthat::assert_that(is.numeric(tag_id)) assertthat::assert_that(length(tag_id) == 1) assertthat::assert_that(tag_id > 0) - assertthat::assert_that(tag_id == floor(tag_id), - msg = "tag_id must be an integer") + assertthat::assert_that( + tag_id == floor(tag_id), + msg = "tag_id must be an integer" + ) # Validate vb assertthat::assert_that(length(vb) == 1) diff --git a/R/get_user_avatar.R b/R/get_user_avatar.R index ae174b48..c9fa961b 100644 --- a/R/get_user_avatar.R +++ b/R/get_user_avatar.R @@ -40,10 +40,12 @@ NULL #' } #' } #' @export -get_user_avatar <- function(user_id, - dest_path = NULL, - vb = options::opt("vb"), - rq = NULL) { +get_user_avatar <- function( + user_id, + dest_path = NULL, + vb = options::opt("vb"), + rq = NULL +) { # Validate user_id assertthat::assert_that(length(user_id) == 1) assertthat::assert_that(is.numeric(user_id) || is.integer(user_id)) @@ -110,7 +112,11 @@ get_user_avatar <- function(user_id, # If no destination path, return bytes if (is.null(dest_path)) { if (vb) { - message("Returning avatar as raw bytes (", length(avatar_bytes), " bytes)") + message( + "Returning avatar as raw bytes (", + length(avatar_bytes), + " bytes)" + ) } return(avatar_bytes) } @@ -126,10 +132,13 @@ get_user_avatar <- function(user_id, if (!is.null(content_disp) && grepl("filename=", content_disp)) { # Extract filename from content-disposition header - filename_match <- regmatches(content_disp, regexpr("filename=([^;]+)", content_disp)) + filename_match <- regmatches( + content_disp, + regexpr("filename=([^;]+)", content_disp) + ) if (length(filename_match) > 0) { filename <- sub("filename=", "", filename_match) - filename <- gsub('^"|"$', '', filename) # Remove quotes + filename <- gsub('^"|"$', '', filename) # Remove quotes filename <- trimws(filename) } } else { @@ -163,4 +172,4 @@ get_user_avatar <- function(user_id, return(NULL) } ) -} \ No newline at end of file +} diff --git a/R/get_volume_collaborator_by_id.R b/R/get_volume_collaborator_by_id.R index 8137eea0..6819184c 100644 --- a/R/get_volume_collaborator_by_id.R +++ b/R/get_volume_collaborator_by_id.R @@ -32,23 +32,29 @@ NULL #' } #' } #' @export -get_volume_collaborator_by_id <- function(vol_id = 1, - collaborator_id = 1, - vb = options::opt("vb"), - rq = NULL) { +get_volume_collaborator_by_id <- function( + vol_id = 1, + collaborator_id = 1, + vb = options::opt("vb"), + rq = NULL +) { # Validate vol_id assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(vol_id >= 1) - assertthat::assert_that(vol_id == floor(vol_id), - msg = "vol_id must be an integer") + assertthat::assert_that( + vol_id == floor(vol_id), + msg = "vol_id must be an integer" + ) # Validate collaborator_id assertthat::assert_that(is.numeric(collaborator_id)) assertthat::assert_that(length(collaborator_id) == 1) assertthat::assert_that(collaborator_id > 0) - assertthat::assert_that(collaborator_id == floor(collaborator_id), - msg = "collaborator_id must be an integer") + assertthat::assert_that( + collaborator_id == floor(collaborator_id), + msg = "collaborator_id must be an integer" + ) # Validate vb assertthat::assert_that(length(vb) == 1) @@ -66,7 +72,13 @@ get_volume_collaborator_by_id <- function(vol_id = 1, if (is.null(collaborator)) { if (vb) { - message("Collaborator ", collaborator_id, " in volume ", vol_id, " not found or inaccessible.") + message( + "Collaborator ", + collaborator_id, + " in volume ", + vol_id, + " not found or inaccessible." + ) } return(NULL) } @@ -108,7 +120,10 @@ get_volume_collaborator_by_id <- function(vol_id = 1, # Process sponsored_users if present sponsored_users <- NULL - if (!is.null(collaborator$sponsored_users) && length(collaborator$sponsored_users) > 0) { + if ( + !is.null(collaborator$sponsored_users) && + length(collaborator$sponsored_users) > 0 + ) { sponsored_users <- lapply(collaborator$sponsored_users, function(u) { list( user_id = u$id, @@ -131,4 +146,4 @@ get_volume_collaborator_by_id <- function(vol_id = 1, expiration_date = collaborator$expiration_date, sponsored_users = sponsored_users ) -} \ No newline at end of file +} diff --git a/R/get_volume_record_by_id.R b/R/get_volume_record_by_id.R index 5638cef8..ea263481 100644 --- a/R/get_volume_record_by_id.R +++ b/R/get_volume_record_by_id.R @@ -31,23 +31,29 @@ NULL #' } #' } #' @export -get_volume_record_by_id <- function(vol_id = 1, - record_id = 1, - vb = options::opt("vb"), - rq = NULL) { +get_volume_record_by_id <- function( + vol_id = 1, + record_id = 1, + vb = options::opt("vb"), + rq = NULL +) { # Validate vol_id assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(vol_id >= 1) - assertthat::assert_that(vol_id == floor(vol_id), - msg = "vol_id must be an integer") + assertthat::assert_that( + vol_id == floor(vol_id), + msg = "vol_id must be an integer" + ) # Validate record_id assertthat::assert_that(is.numeric(record_id)) assertthat::assert_that(length(record_id) == 1) assertthat::assert_that(record_id > 0) - assertthat::assert_that(record_id == floor(record_id), - msg = "record_id must be an integer") + assertthat::assert_that( + record_id == floor(record_id), + msg = "record_id must be an integer" + ) # Validate vb assertthat::assert_that(length(vb) == 1) @@ -65,7 +71,13 @@ get_volume_record_by_id <- function(vol_id = 1, if (is.null(record)) { if (vb) { - message("Record ", record_id, " in volume ", vol_id, " not found or inaccessible.") + message( + "Record ", + record_id, + " in volume ", + vol_id, + " not found or inaccessible." + ) } return(NULL) } diff --git a/R/list_categories.R b/R/list_categories.R index 338a8b84..dcc2c9d8 100644 --- a/R/list_categories.R +++ b/R/list_categories.R @@ -27,8 +27,7 @@ NULL #' } #' } #' @export -list_categories <- function(vb = options::opt("vb"), - rq = NULL) { +list_categories <- function(vb = options::opt("vb"), rq = NULL) { # Validate vb assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) @@ -72,7 +71,11 @@ list_categories <- function(vb = options::opt("vb"), tibble::tibble( category_id = category$id, category_name = category$name, - category_description = if (is.null(category$description)) NA_character_ else category$description, + category_description = if (is.null(category$description)) { + NA_character_ + } else { + category$description + }, metrics = list(metrics) ) }) diff --git a/R/list_institutions.R b/R/list_institutions.R index 13d1392a..f86d3b50 100644 --- a/R/list_institutions.R +++ b/R/list_institutions.R @@ -33,9 +33,11 @@ NULL #' } #' } #' @export -list_institutions <- function(search_string = NULL, - vb = options::opt("vb"), - rq = NULL) { +list_institutions <- function( + search_string = NULL, + vb = options::opt("vb"), + rq = NULL +) { # Validate search_string if (!is.null(search_string)) { assertthat::assert_that(assertthat::is.string(search_string)) @@ -79,15 +81,51 @@ list_institutions <- function(search_string = NULL, institution_id = entry$id, institution_name = entry$name, institution_url = if (is.null(entry$url)) NA_character_ else entry$url, - institution_date_signed = if (is.null(entry$date_signed)) NA_character_ else as.character(entry$date_signed), - institution_source = if (is.null(entry$source)) NA_character_ else entry$source, - institution_created_at = if (is.null(entry$created_at)) NA_character_ else as.character(entry$created_at), - institution_updated_at = if (is.null(entry$updated_at)) NA_character_ else as.character(entry$updated_at), - institution_has_avatar = if (is.null(entry$has_avatar)) NA else entry$has_avatar, - institution_has_administrators = if (is.null(entry$has_administrators)) NA else entry$has_administrators, - institution_latitude = if (is.null(entry$latitude)) NA_real_ else as.numeric(entry$latitude), - institution_longitude = if (is.null(entry$longitude)) NA_real_ else as.numeric(entry$longitude), - institution_manual_coordinates = if (is.null(entry$manual_coordinates)) NA else entry$manual_coordinates + institution_date_signed = if (is.null(entry$date_signed)) { + NA_character_ + } else { + as.character(entry$date_signed) + }, + institution_source = if (is.null(entry$source)) { + NA_character_ + } else { + entry$source + }, + institution_created_at = if (is.null(entry$created_at)) { + NA_character_ + } else { + as.character(entry$created_at) + }, + institution_updated_at = if (is.null(entry$updated_at)) { + NA_character_ + } else { + as.character(entry$updated_at) + }, + institution_has_avatar = if (is.null(entry$has_avatar)) { + NA + } else { + entry$has_avatar + }, + institution_has_administrators = if (is.null(entry$has_administrators)) { + NA + } else { + entry$has_administrators + }, + institution_latitude = if (is.null(entry$latitude)) { + NA_real_ + } else { + as.numeric(entry$latitude) + }, + institution_longitude = if (is.null(entry$longitude)) { + NA_real_ + } else { + as.numeric(entry$longitude) + }, + institution_manual_coordinates = if (is.null(entry$manual_coordinates)) { + NA + } else { + entry$manual_coordinates + } ) }) -} \ No newline at end of file +} diff --git a/R/list_volume_records.R b/R/list_volume_records.R index c67ffdf3..69b61ad5 100644 --- a/R/list_volume_records.R +++ b/R/list_volume_records.R @@ -34,24 +34,30 @@ NULL #' } #' } #' @export -list_volume_records <- function(vol_id = 1, - category_id = NULL, - vb = options::opt("vb"), - rq = NULL) { +list_volume_records <- function( + vol_id = 1, + category_id = NULL, + vb = options::opt("vb"), + rq = NULL +) { # Validate vol_id assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - assertthat::assert_that(vol_id == floor(vol_id), - msg = "vol_id must be an integer") + assertthat::assert_that( + vol_id == floor(vol_id), + msg = "vol_id must be an integer" + ) # Validate category_id if (!is.null(category_id)) { assertthat::assert_that(length(category_id) == 1) assertthat::assert_that(is.numeric(category_id)) assertthat::assert_that(category_id > 0) - assertthat::assert_that(category_id == floor(category_id), - msg = "category_id must be an integer") + assertthat::assert_that( + category_id == floor(category_id), + msg = "category_id must be an integer" + ) } # Validate vb @@ -94,13 +100,41 @@ list_volume_records <- function(vol_id = 1, age_is_blurred <- NA if (!is.null(record$age)) { - age_years <- if (!is.null(record$age$years)) record$age$years else NA_integer_ - age_months <- if (!is.null(record$age$months)) record$age$months else NA_integer_ - age_days <- if (!is.null(record$age$days)) record$age$days else NA_integer_ - age_total_days <- if (!is.null(record$age$total_days)) record$age$total_days else NA_integer_ - age_formatted <- if (!is.null(record$age$formatted_value)) record$age$formatted_value else NA_character_ - age_is_estimated <- if (!is.null(record$age$is_estimated)) record$age$is_estimated else NA - age_is_blurred <- if (!is.null(record$age$is_blurred)) record$age$is_blurred else NA + age_years <- if (!is.null(record$age$years)) { + record$age$years + } else { + NA_integer_ + } + age_months <- if (!is.null(record$age$months)) { + record$age$months + } else { + NA_integer_ + } + age_days <- if (!is.null(record$age$days)) { + record$age$days + } else { + NA_integer_ + } + age_total_days <- if (!is.null(record$age$total_days)) { + record$age$total_days + } else { + NA_integer_ + } + age_formatted <- if (!is.null(record$age$formatted_value)) { + record$age$formatted_value + } else { + NA_character_ + } + age_is_estimated <- if (!is.null(record$age$is_estimated)) { + record$age$is_estimated + } else { + NA + } + age_is_blurred <- if (!is.null(record$age$is_blurred)) { + record$age$is_blurred + } else { + NA + } } tibble::tibble( @@ -108,7 +142,11 @@ list_volume_records <- function(vol_id = 1, record_volume = record$volume, record_category_id = record$category_id, record_measures = list(record$measures), - record_birthday = if (is.null(record$birthday)) NA_character_ else as.character(record$birthday), + record_birthday = if (is.null(record$birthday)) { + NA_character_ + } else { + as.character(record$birthday) + }, age_years = age_years, age_months = age_months, age_days = age_days, From 09e2238eb4b3df4c326bb63aa800402b7e05ec96 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Tue, 16 Dec 2025 10:42:13 +0100 Subject: [PATCH 19/77] fix(doc): fix documentation for get_folder_file. --- R/get_folder_file.R | 2 +- man/get_folder_file.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/get_folder_file.R b/R/get_folder_file.R index 57bc7e39..14999688 100644 --- a/R/get_folder_file.R +++ b/R/get_folder_file.R @@ -20,7 +20,7 @@ NULL #' @examples #' \donttest{ #' \dontrun{ -#' get_session_file(vol_id = 2, session_id = 11, file_id = 1) +#' get_folder_file(vol_id = 2, folder_id = 11, file_id = 1) #' } #' } #' @export diff --git a/man/get_folder_file.Rd b/man/get_folder_file.Rd index 6154145f..41889851 100644 --- a/man/get_folder_file.Rd +++ b/man/get_folder_file.Rd @@ -35,7 +35,7 @@ Get Session File Data From A Databrary Volume \examples{ \donttest{ \dontrun{ -get_session_file(vol_id = 2, session_id = 11, file_id = 1) +get_folder_file(vol_id = 2, folder_id = 11, file_id = 1) } } } From 00340d20f94ad28867faa7f1e0564f486939cb46 Mon Sep 17 00:00:00 2001 From: rogilmore Date: Mon, 2 Feb 2026 07:46:32 -0500 Subject: [PATCH 20/77] Test push to github with trivial change to CONSTANTS. --- R/CONSTANTS.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index ec0a15e7..36e1c0b7 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -1,7 +1,8 @@ #' Load Package-wide Constants into Local Environment #' #' -DATABRARY_BASE_URL <- Sys.getenv("DATABRARY_BASE_URL", "https://api.stg-databrary.its.nyu.edu") +# DATABRARY_BASE_URL <- Sys.getenv("DATABRARY_BASE_URL", "https://api.stg-databrary.its.nyu.edu") +DATABRARY_BASE_URL <- Sys.getenv("DATABRARY_BASE_URL", "https://api.databrary.org") API_ACTIVITY_SUMMARY <- "/statistics/summary/" API_GROUPED_FORMATS <- "/grouped-formats/" From 7dcbe6b8579d4988b29d7aad43f584d395c41bce Mon Sep 17 00:00:00 2001 From: rogilmore Date: Mon, 2 Feb 2026 07:46:32 -0500 Subject: [PATCH 21/77] Add doc strings to header for `vb` parameter for all documented functions; Changed some default parameters to make function testing easier. --- R/CONSTANTS.R | 3 +- R/assign_constants.R | 1 + R/download_folder_asset.R | 14 +- R/download_folder_assets_fr_df.R | 29 ++-- R/download_folder_zip.R | 15 +- R/download_session_asset.R | 73 +++++---- R/download_session_assets_fr_df.R | 26 +-- R/download_session_csv.R | 14 +- R/download_session_zip.R | 12 +- R/download_single_folder_asset_fr_df.R | 47 +++--- R/download_single_session_asset_fr_df.R | 46 +++--- R/download_video.R | 23 +-- R/download_volume_zip.R | 3 +- R/get_category_by_id.R | 29 ++-- R/get_db_stats.R | 1 + R/get_folder_by_id.R | 22 +-- R/get_folder_file.R | 30 ++-- R/get_funder_by_id.R | 27 ++-- R/get_institution_avatar.R | 202 ++++++++++++------------ R/get_institution_by_id.R | 3 +- R/get_session_by_id.R | 1 + R/get_session_by_name.R | 18 ++- R/get_session_file.R | 30 ++-- R/get_tag_by_id.R | 36 ++--- R/get_user_avatar.R | 122 +++++++------- R/get_user_by_id.R | 18 ++- R/get_volume_by_id.R | 3 +- R/get_volume_collaborator_by_id.R | 50 +++--- R/get_volume_record_by_id.R | 5 +- R/list_asset_formats.R | 4 + R/list_authorized_investigators.R | 18 ++- R/list_categories.R | 23 ++- R/list_folder_assets.R | 37 +++-- R/list_institution_affiliates.R | 26 ++- R/list_institutions.R | 29 ++-- R/list_session_activity.R | 57 ++++--- R/list_session_assets.R | 1 + R/list_user_affiliates.R | 11 +- R/list_user_history.R | 18 +-- R/list_user_sponsors.R | 27 ++-- R/list_user_volumes.R | 7 +- R/list_users.R | 1 + R/list_volume_activity.R | 5 +- R/list_volume_assets.R | 3 +- R/list_volume_collaborators.R | 91 ++++++++--- R/list_volume_folders.R | 19 +-- R/list_volume_funding.R | 9 +- R/list_volume_info.R | 5 +- R/list_volume_links.R | 7 +- R/list_volume_records.R | 42 +++-- R/list_volume_session_assets.R | 3 +- R/list_volume_sessions.R | 3 +- R/list_volume_tags.R | 3 +- R/list_volumes.R | 3 +- R/login_db.R | 2 +- R/logout_db.R | 2 +- R/make_default_request.R | 1 + R/make_login_client.R | 1 + R/search_for_funder.R | 3 +- R/search_for_tags.R | 1 + R/search_institutions.R | 31 ++-- R/search_users.R | 1 + R/search_volumes.R | 1 + R/whoami.R | 32 ++-- 64 files changed, 785 insertions(+), 645 deletions(-) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index ec0a15e7..36e1c0b7 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -1,7 +1,8 @@ #' Load Package-wide Constants into Local Environment #' #' -DATABRARY_BASE_URL <- Sys.getenv("DATABRARY_BASE_URL", "https://api.stg-databrary.its.nyu.edu") +# DATABRARY_BASE_URL <- Sys.getenv("DATABRARY_BASE_URL", "https://api.stg-databrary.its.nyu.edu") +DATABRARY_BASE_URL <- Sys.getenv("DATABRARY_BASE_URL", "https://api.databrary.org") API_ACTIVITY_SUMMARY <- "/statistics/summary/" API_GROUPED_FORMATS <- "/grouped-formats/" diff --git a/R/assign_constants.R b/R/assign_constants.R index 3ebb5c6e..25360652 100644 --- a/R/assign_constants.R +++ b/R/assign_constants.R @@ -5,6 +5,7 @@ NULL #' Download Databrary Constants From API. #' +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to NULL. #' #' @returns A data frame with the constants. diff --git a/R/download_folder_asset.R b/R/download_folder_asset.R index 9ad295d2..9081a1dd 100644 --- a/R/download_folder_asset.R +++ b/R/download_folder_asset.R @@ -17,6 +17,7 @@ NULL #' asset. Defaults to the API-provided file name. #' @param target_dir Character string. Directory where the file will be saved. #' Default is `tempdir()`. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Default is `NULL`, in which case a #' default authenticated request is generated. #' @param timeout_secs Numeric. Timeout (seconds) applied to the download @@ -31,16 +32,16 @@ NULL #' \donttest{ #' \dontrun{ #' download_folder_asset() # Default public asset in folder 1 of volume 1 -#' download_folder_asset(vol_id = 1, folder_id = 2, asset_id = 3, -#' file_name = "example.mp4") +#' download_folder_asset(vol_id = 1, folder_id = 8460, asset_id = 19919, +#' file_name = "video.mp4") #' } #' } #' #' @export download_folder_asset <- function(vol_id = 1, - folder_id = 1, - asset_id = 1, - file_name = NULL, + folder_id = 8460, + asset_id = 19919, + file_name = "video.mp4", target_dir = tempdir(), timeout_secs = REQUEST_TIMEOUT, vb = options::opt("vb"), @@ -122,6 +123,3 @@ download_folder_asset <- function(vol_id = 1, vb = vb ) } - - - diff --git a/R/download_folder_assets_fr_df.R b/R/download_folder_assets_fr_df.R index ae1ef3de..aa92a404 100644 --- a/R/download_folder_assets_fr_df.R +++ b/R/download_folder_assets_fr_df.R @@ -21,6 +21,7 @@ NULL #' @param make_portable_fn Logical. When `TRUE`, filenames are sanitized via #' `make_fn_portable()`. #' @param timeout_secs Numeric. Timeout applied to each download request. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An optional `httr2` request object reused when requesting signed #' links. #' @@ -57,7 +58,7 @@ download_folder_assets_fr_df <- call. = FALSE ) } - + assertthat::assert_that(length(target_dir) == 1) assertthat::assert_that(is.character(target_dir)) if (dir.exists(target_dir)) { @@ -68,32 +69,35 @@ download_folder_assets_fr_df <- return(NULL) } } else { - dir.create(target_dir, recursive = TRUE, showWarnings = FALSE) + dir.create(target_dir, + recursive = TRUE, + showWarnings = FALSE) } assertthat::is.writeable(target_dir) - + assertthat::assert_that(length(add_folder_subdir) == 1) assertthat::assert_that(is.logical(add_folder_subdir)) - + assertthat::assert_that(length(overwrite) == 1) assertthat::assert_that(is.logical(overwrite)) - + assertthat::assert_that(length(make_portable_fn) == 1) assertthat::assert_that(is.logical(make_portable_fn)) - + assertthat::is.number(timeout_secs) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + + assertthat::assert_that(is.null(rq) || + ("httr2_request" %in% class(rq))) + if (vb) { message("Downloading n=", nrow(folder_df), " files to ", target_dir) } - + purrr::map( seq_len(nrow(folder_df)), download_single_folder_asset_fr_df, @@ -109,6 +113,3 @@ download_folder_assets_fr_df <- ) |> purrr::list_c() } - - - diff --git a/R/download_folder_zip.R b/R/download_folder_zip.R index 4323306b..4a762446 100644 --- a/R/download_folder_zip.R +++ b/R/download_folder_zip.R @@ -13,6 +13,7 @@ NULL #' #' @param vol_id Volume identifier for the folder. #' @param folder_id Folder identifier scoped within the specified volume. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Default is `NULL`, in which case a #' default authenticated request is generated. #' @@ -36,19 +37,17 @@ download_folder_zip <- function(vol_id = 1, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + assertthat::assert_that(length(folder_id) == 1) assertthat::assert_that(is.numeric(folder_id)) assertthat::assert_that(folder_id >= 1) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + + assertthat::assert_that(is.null(rq) || + ("httr2_request" %in% class(rq))) + path <- sprintf(API_FOLDER_DOWNLOAD_LINK, vol_id, folder_id) request_processing_task(path = path, rq = rq, vb = vb) } - - - diff --git a/R/download_session_asset.R b/R/download_session_asset.R index 89217ea6..f85687c5 100644 --- a/R/download_session_asset.R +++ b/R/download_session_asset.R @@ -17,10 +17,12 @@ NULL #' API-provided file name. #' @param target_dir Character string. Directory where the file will be saved. #' Default is `tempdir()`. -#' @param rq An `httr2` request object. Default is `NULL`, in which case a -#' default authenticated request is generated. #' @param timeout_secs Numeric. Timeout (seconds) applied to the download #' request. Default is `REQUEST_TIMEOUT`. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @param rq An `httr2` request object. Default is `NULL`, in which case a +#' default authenticated request is generated. + #' #' @returns The path to the downloaded file (character string) or `NULL` if the #' download fails. @@ -47,73 +49,70 @@ download_session_asset <- function(vol_id = 1, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) - + assertthat::assert_that(length(asset_id) == 1) assertthat::assert_that(is.numeric(asset_id)) assertthat::assert_that(asset_id >= 1) - + if (!is.null(file_name)) { assertthat::assert_that(length(file_name) == 1) assertthat::assert_that(is.character(file_name)) } - + assertthat::assert_that(length(target_dir) == 1) assertthat::assert_that(is.character(target_dir)) assertthat::assert_that(dir.exists(target_dir)) - + assertthat::is.number(timeout_secs) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + + assertthat::assert_that(is.null(rq) || + ("httr2_request" %in% class(rq))) + path <- sprintf(API_FILES_DOWNLOAD_LINK, vol_id, session_id, asset_id) link <- request_signed_download_link(path = path, rq = rq, vb = vb) - + if (is.null(link)) { return(NULL) } - + resolved_name <- if (!is.null(file_name)) { file_name } else if (!is.null(link$file_name)) { link$file_name } else { - paste0( - session_id, - "-", - asset_id, - "-", - format(Sys.time(), "%F-%H%M-%S"), - ".bin" - ) + paste0(session_id, + "-", + asset_id, + "-", + format(Sys.time(), "%F-%H%M-%S"), + ".bin") } - + dest_path <- file.path(target_dir, resolved_name) - + if (file.exists(dest_path)) { - dest_path <- file.path( - target_dir, - paste0( - tools::file_path_sans_ext(resolved_name), - "-", - format(Sys.time(), "%F-%H%M-%S"), - ifelse( - nzchar(tools::file_ext(resolved_name)), - paste0(".", tools::file_ext(resolved_name)), - "" - ) - ) - ) + dest_path <- file.path(target_dir, + paste0( + tools::file_path_sans_ext(resolved_name), + "-", + format(Sys.time(), "%F-%H%M-%S"), + ifelse( + nzchar(tools::file_ext(resolved_name)), + paste0(".", tools::file_ext(resolved_name)), + "" + ) + )) } - + download_signed_file( download_url = link$download_url, dest_path = dest_path, diff --git a/R/download_session_assets_fr_df.R b/R/download_session_assets_fr_df.R index b34b5fcb..f26cda2c 100644 --- a/R/download_session_assets_fr_df.R +++ b/R/download_session_assets_fr_df.R @@ -21,6 +21,7 @@ NULL #' @param make_portable_fn Logical. When `TRUE`, filenames are sanitized via #' `make_fn_portable()`. #' @param timeout_secs Numeric. Timeout applied to each download request. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An optional `httr2` request object reused when requesting signed #' links. #' @@ -56,7 +57,7 @@ download_session_assets_fr_df <- call. = FALSE ) } - + assertthat::assert_that(length(target_dir) == 1) assertthat::assert_that(is.character(target_dir)) if (dir.exists(target_dir)) { @@ -67,32 +68,35 @@ download_session_assets_fr_df <- return(NULL) } } else { - dir.create(target_dir, recursive = TRUE, showWarnings = FALSE) + dir.create(target_dir, + recursive = TRUE, + showWarnings = FALSE) } assertthat::is.writeable(target_dir) - + assertthat::assert_that(length(add_session_subdir) == 1) assertthat::assert_that(is.logical(add_session_subdir)) - + assertthat::assert_that(length(overwrite) == 1) assertthat::assert_that(is.logical(overwrite)) - + assertthat::assert_that(length(make_portable_fn) == 1) assertthat::assert_that(is.logical(make_portable_fn)) - + assertthat::is.number(timeout_secs) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + + assertthat::assert_that(is.null(rq) || + ("httr2_request" %in% class(rq))) + if (vb) { message("Downloading n=", nrow(session_df), " files to ", target_dir) } - + purrr::map( seq_len(nrow(session_df)), download_single_session_asset_fr_df, diff --git a/R/download_session_csv.R b/R/download_session_csv.R index 87e6f400..90db279e 100644 --- a/R/download_session_csv.R +++ b/R/download_session_csv.R @@ -14,6 +14,7 @@ NULL #' @param vol_id Integer. Target volume identifier. Default is 1. #' @param session_id Optional integer. When provided, requests a session-level #' CSV export. When `NULL`, a volume-level CSV export is requested. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Default is `NULL`, meaning a default #' authenticated request is generated. #' @@ -41,23 +42,24 @@ download_session_csv <- function(vol_id = 1, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + if (!is.null(session_id)) { assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) } - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + + assertthat::assert_that(is.null(rq) || + ("httr2_request" %in% class(rq))) + path <- if (is.null(session_id)) { sprintf(API_VOLUME_CSV_DOWNLOAD_LINK, vol_id) } else { sprintf(API_SESSION_CSV_DOWNLOAD_LINK, vol_id, session_id) } - + request_processing_task(path = path, rq = rq, vb = vb) } diff --git a/R/download_session_zip.R b/R/download_session_zip.R index 440a1be3..066b774f 100644 --- a/R/download_session_zip.R +++ b/R/download_session_zip.R @@ -13,6 +13,7 @@ NULL #' #' @param vol_id Volume identifier that owns the session. #' @param session_id Session identifier within the volume. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Default is `NULL`, in which case a #' default authenticated request is generated. #' @@ -36,16 +37,17 @@ download_session_zip <- function(vol_id = 31, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + + assertthat::assert_that(is.null(rq) || + ("httr2_request" %in% class(rq))) + path <- sprintf(API_SESSION_DOWNLOAD_LINK, vol_id, session_id) request_processing_task(path = path, rq = rq, vb = vb) } diff --git a/R/download_single_folder_asset_fr_df.R b/R/download_single_folder_asset_fr_df.R index 807c5945..98fc2e60 100644 --- a/R/download_single_folder_asset_fr_df.R +++ b/R/download_single_folder_asset_fr_df.R @@ -19,6 +19,7 @@ NULL #' @param make_portable_fn Logical. When `TRUE`, filenames are sanitized via #' `make_fn_portable()`. #' @param timeout_secs Numeric. Timeout applied to the signed download request. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq Optional `httr2` request object reused to request signed links. #' #' @returns Path to the downloaded asset or `NULL` if the download fails. @@ -38,7 +39,7 @@ download_single_folder_asset_fr_df <- function(i = NULL, assertthat::assert_that(length(i) == 1) assertthat::is.number(i) assertthat::assert_that(i > 0) - + assertthat::assert_that(is.data.frame(folder_df)) required_cols <- c("vol_id", "folder_id", "asset_id", "asset_name") missing_cols <- setdiff(required_cols, names(folder_df)) @@ -49,30 +50,34 @@ download_single_folder_asset_fr_df <- function(i = NULL, call. = FALSE ) } - + assertthat::assert_that(length(target_dir) == 1) assertthat::is.string(target_dir) - assertthat::assert_that(dir.exists(target_dir) || dir.create(target_dir, recursive = TRUE, showWarnings = FALSE)) + assertthat::assert_that( + dir.exists(target_dir) || + dir.create(target_dir, recursive = TRUE, showWarnings = FALSE) + ) assertthat::is.writeable(target_dir) - + assertthat::assert_that(length(add_folder_subdir) == 1) assertthat::assert_that(is.logical(add_folder_subdir)) - + assertthat::assert_that(length(overwrite) == 1) assertthat::assert_that(is.logical(overwrite)) - + assertthat::assert_that(length(make_portable_fn) == 1) assertthat::assert_that(is.logical(make_portable_fn)) - + assertthat::is.number(timeout_secs) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + + assertthat::assert_that(is.null(rq) || + ("httr2_request" %in% class(rq))) + this_asset <- folder_df[i, , drop = FALSE] if (nrow(this_asset) == 0) { if (vb) { @@ -80,7 +85,7 @@ download_single_folder_asset_fr_df <- function(i = NULL, } return(NULL) } - + dest_dir <- if (isTRUE(add_folder_subdir)) { file.path(target_dir, this_asset$folder_id) } else { @@ -89,31 +94,32 @@ download_single_folder_asset_fr_df <- function(i = NULL, dir.create(dest_dir, recursive = TRUE, showWarnings = FALSE) assertthat::assert_that(dir.exists(dest_dir)) assertthat::is.writeable(dest_dir) - + base_name <- this_asset$asset_name if (is.null(base_name) || is.na(base_name) || base_name == "") { base_name <- paste0("asset-", this_asset$asset_id) } - + extension <- "" if ("format_extension" %in% names(this_asset)) { ext_value <- this_asset$format_extension - if (!is.null(ext_value) && !is.na(ext_value) && nzchar(ext_value)) { + if (!is.null(ext_value) && + !is.na(ext_value) && nzchar(ext_value)) { if (tools::file_ext(base_name) != ext_value) { extension <- paste0(".", ext_value) } } } - + candidate_name <- paste0(base_name, extension) - + if (make_portable_fn) { if (vb) { message("Making file name '", candidate_name, "' portable.") } candidate_name <- make_fn_portable(candidate_name, vb = vb) } - + dest_file <- file.path(dest_dir, candidate_name) if (file.exists(dest_file) && !overwrite) { if (vb) { @@ -133,7 +139,7 @@ download_single_folder_asset_fr_df <- function(i = NULL, ) dest_file <- file.path(dest_dir, candidate_name) } - + download_folder_asset( vol_id = this_asset$vol_id, folder_id = this_asset$folder_id, @@ -145,6 +151,3 @@ download_single_folder_asset_fr_df <- function(i = NULL, rq = rq ) } - - - diff --git a/R/download_single_session_asset_fr_df.R b/R/download_single_session_asset_fr_df.R index ce4fe68a..d96fc7eb 100644 --- a/R/download_single_session_asset_fr_df.R +++ b/R/download_single_session_asset_fr_df.R @@ -1,6 +1,6 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL #' Download a Single Asset From a Session Data Frame Row. @@ -19,6 +19,7 @@ NULL #' @param make_portable_fn Logical. When `TRUE`, filenames are sanitized via #' `make_fn_portable()`. #' @param timeout_secs Numeric. Timeout applied to the signed download request. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq Optional `httr2` request object reused to request signed links. #' #' @returns Path to the downloaded asset or `NULL` if the download fails. @@ -38,7 +39,7 @@ download_single_session_asset_fr_df <- function(i = NULL, assertthat::assert_that(length(i) == 1) assertthat::is.number(i) assertthat::assert_that(i > 0) - + assertthat::assert_that(is.data.frame(session_df)) required_cols <- c("vol_id", "session_id", "asset_id", "asset_name") missing_cols <- setdiff(required_cols, names(session_df)) @@ -49,30 +50,34 @@ download_single_session_asset_fr_df <- function(i = NULL, call. = FALSE ) } - + assertthat::assert_that(length(target_dir) == 1) assertthat::is.string(target_dir) - assertthat::assert_that(dir.exists(target_dir) || dir.create(target_dir, recursive = TRUE, showWarnings = FALSE)) + assertthat::assert_that( + dir.exists(target_dir) || + dir.create(target_dir, recursive = TRUE, showWarnings = FALSE) + ) assertthat::is.writeable(target_dir) - + assertthat::assert_that(length(add_session_subdir) == 1) assertthat::assert_that(is.logical(add_session_subdir)) - + assertthat::assert_that(length(overwrite) == 1) assertthat::assert_that(is.logical(overwrite)) - + assertthat::assert_that(length(make_portable_fn) == 1) assertthat::assert_that(is.logical(make_portable_fn)) - + assertthat::is.number(timeout_secs) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + + assertthat::assert_that(is.null(rq) || + ("httr2_request" %in% class(rq))) + this_asset <- session_df[i, , drop = FALSE] if (nrow(this_asset) == 0) { if (vb) { @@ -80,7 +85,7 @@ download_single_session_asset_fr_df <- function(i = NULL, } return(NULL) } - + dest_dir <- if (isTRUE(add_session_subdir)) { file.path(target_dir, this_asset$session_id) } else { @@ -89,31 +94,32 @@ download_single_session_asset_fr_df <- function(i = NULL, dir.create(dest_dir, recursive = TRUE, showWarnings = FALSE) assertthat::assert_that(dir.exists(dest_dir)) assertthat::is.writeable(dest_dir) - + base_name <- this_asset$asset_name if (is.null(base_name) || is.na(base_name) || base_name == "") { base_name <- paste0("asset-", this_asset$asset_id) } - + extension <- "" if ("format_extension" %in% names(this_asset)) { ext_value <- this_asset$format_extension - if (!is.null(ext_value) && !is.na(ext_value) && nzchar(ext_value)) { + if (!is.null(ext_value) && + !is.na(ext_value) && nzchar(ext_value)) { if (tools::file_ext(base_name) != ext_value) { extension <- paste0(".", ext_value) } } } - + candidate_name <- paste0(base_name, extension) - + if (make_portable_fn) { if (vb) { message("Making file name '", candidate_name, "' portable.") } candidate_name <- make_fn_portable(candidate_name, vb = vb) } - + dest_file <- file.path(dest_dir, candidate_name) if (file.exists(dest_file) && !overwrite) { if (vb) { @@ -133,7 +139,7 @@ download_single_session_asset_fr_df <- function(i = NULL, ) dest_file <- file.path(dest_dir, candidate_name) } - + download_session_asset( vol_id = this_asset$vol_id, session_id = this_asset$session_id, diff --git a/R/download_video.R b/R/download_video.R index 8e24daec..471f376e 100644 --- a/R/download_video.R +++ b/R/download_video.R @@ -12,6 +12,7 @@ NULL #' value. #' @param target_dir Directory to save the downloaded file. Defaults to #' `tempdir()`. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq Optional `httr2` request object reused when requesting the signed #' link. #' @@ -39,15 +40,15 @@ download_video <- function(vol_id = 1, assertthat::assert_that(length(asset_id) == 1) assertthat::assert_that(is.numeric(asset_id)) assertthat::assert_that(asset_id >= 1) - + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) - + assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + if (!is.null(file_name)) { assertthat::assert_that(length(file_name) == 1) assertthat::assert_that(is.character(file_name)) @@ -55,17 +56,21 @@ download_video <- function(vol_id = 1, stop("file_name must end with '.mp4' when provided.", call. = FALSE) } } - + assertthat::assert_that(length(target_dir) == 1) assertthat::assert_that(is.character(target_dir)) - assertthat::assert_that(dir.exists(target_dir) || dir.create(target_dir, recursive = TRUE, showWarnings = FALSE)) + assertthat::assert_that( + dir.exists(target_dir) || + dir.create(target_dir, recursive = TRUE, showWarnings = FALSE) + ) assertthat::is.writeable(target_dir) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + + assertthat::assert_that(is.null(rq) || + ("httr2_request" %in% class(rq))) + download_session_asset( vol_id = vol_id, session_id = session_id, diff --git a/R/download_volume_zip.R b/R/download_volume_zip.R index 8d44338c..89177938 100644 --- a/R/download_volume_zip.R +++ b/R/download_volume_zip.R @@ -11,7 +11,8 @@ NULL #' descriptor. When the archive is ready, Databrary emails a signed download #' link to the authenticated user. #' -#' @param vol_id Volume identifier. +#' @param vol_id An integer. Volume identifier. Default is 31. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Default is `NULL`, in which case a #' default authenticated request is generated. #' diff --git a/R/get_category_by_id.R b/R/get_category_by_id.R index 2119cf04..e9b02665 100644 --- a/R/get_category_by_id.R +++ b/R/get_category_by_id.R @@ -10,6 +10,7 @@ NULL #' that define data collection fields. #' #' @param category_id Numeric category identifier. Must be a positive integer. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @return A list with the category's metadata including id, name, description, @@ -28,41 +29,37 @@ NULL #' } #' } #' @export -get_category_by_id <- function( - category_id = 1, - vb = options::opt("vb"), - rq = NULL -) { +get_category_by_id <- function(category_id = 1, + vb = options::opt("vb"), + rq = NULL) { # Validate category_id assertthat::assert_that(is.numeric(category_id)) assertthat::assert_that(length(category_id) == 1) assertthat::assert_that(category_id > 0) - assertthat::assert_that( - category_id == floor(category_id), - msg = "category_id must be an integer" - ) - + assertthat::assert_that(category_id == floor(category_id), msg = "category_id must be an integer") + # Validate vb assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - + # Validate rq - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + # Perform API call category <- perform_api_get( path = sprintf(API_CATEGORY_DETAIL, category_id), rq = rq, vb = vb ) - + if (is.null(category)) { if (vb) { message("Category ", category_id, " not found or inaccessible.") } return(NULL) } - + # Process metrics if present metrics <- NULL if (!is.null(category$metrics) && length(category$metrics) > 0) { @@ -79,7 +76,7 @@ get_category_by_id <- function( ) }) } - + # Return structured list list( category_id = category$id, diff --git a/R/get_db_stats.R b/R/get_db_stats.R index 35809aec..a92ab4a5 100644 --- a/R/get_db_stats.R +++ b/R/get_db_stats.R @@ -9,6 +9,7 @@ NULL #' the institutions, people, and data hosted on 'Databrary.org'. #' #' @param type Type of Databrary report to run "institutions", "people", "data" +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. #' #' @returns A data frame with the requested data or NULL if there is diff --git a/R/get_folder_by_id.R b/R/get_folder_by_id.R index 025b85c8..731b0082 100644 --- a/R/get_folder_by_id.R +++ b/R/get_folder_by_id.R @@ -7,6 +7,7 @@ NULL #' #' @param folder_id Folder identifier within the specified volume. #' @param vol_id Volume identifier containing the folder. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @returns A list representing the folder metadata, or `NULL` when the folder @@ -28,29 +29,32 @@ get_folder_by_id <- function(folder_id = 1, assertthat::assert_that(length(folder_id) == 1) assertthat::assert_that(is.numeric(folder_id)) assertthat::assert_that(folder_id >= 1) - + assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + folder <- perform_api_get( path = sprintf(API_FOLDER_DETAIL, vol_id, folder_id), rq = rq, vb = vb ) - + if (is.null(folder)) { if (vb) { - message("Cannot access requested folder ", folder_id, " in volume ", vol_id) + message("Cannot access requested folder ", + folder_id, + " in volume ", + vol_id) } return(NULL) } - + folder } - diff --git a/R/get_folder_file.R b/R/get_folder_file.R index 14999688..bbe78442 100644 --- a/R/get_folder_file.R +++ b/R/get_folder_file.R @@ -9,6 +9,7 @@ NULL #' @param folder_id An integer indicating a valid folder identifier #' linked to a volume. Default value is 9807, the materials folder for volume 1. #' @param file_id An integer indicating the file identifier. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An httr2 request object. #' #' @returns A JSON blob with the file data. If the user has previously logged @@ -25,36 +26,35 @@ NULL #' } #' @export get_folder_file <- - function( - vol_id = 1, - folder_id = 9807, - file_id, - vb = options::opt("vb"), - rq = NULL - ) { + function(vol_id = 1, + folder_id = 9807, + file_id, + vb = options::opt("vb"), + rq = NULL) { assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) assertthat::assert_that(length(vol_id) == 1) - + assertthat::assert_that(is.numeric(folder_id)) assertthat::assert_that(folder_id > 0) assertthat::assert_that(length(folder_id) == 1) - + assertthat::assert_that(is.numeric(file_id)) assertthat::assert_that(file_id > 0) assertthat::assert_that(length(file_id) == 1) - + assertthat::assert_that(is.logical(vb)) assertthat::assert_that(length(vb) == 1) - - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + file <- perform_api_get( path = sprintf(API_FOLDER_FILES_DETAIL, vol_id, folder_id, file_id), rq = rq, vb = vb ) - + if (is.null(file)) { if (vb) { message( @@ -68,6 +68,6 @@ get_folder_file <- } return(NULL) } - + file } diff --git a/R/get_funder_by_id.R b/R/get_funder_by_id.R index b13c765a..1d46b3f1 100644 --- a/R/get_funder_by_id.R +++ b/R/get_funder_by_id.R @@ -9,6 +9,7 @@ NULL #' Databrary using its unique identifier. #' #' @param funder_id Numeric funder identifier. Must be a positive integer. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @return A list with the funder's metadata including id, name, and approval @@ -27,41 +28,37 @@ NULL #' } #' } #' @export -get_funder_by_id <- function( - funder_id = 1, - vb = options::opt("vb"), - rq = NULL -) { +get_funder_by_id <- function(funder_id = 1, + vb = options::opt("vb"), + rq = NULL) { # Validate funder_id assertthat::assert_that(is.numeric(funder_id)) assertthat::assert_that(length(funder_id) == 1) assertthat::assert_that(funder_id > 0) - assertthat::assert_that( - funder_id == floor(funder_id), - msg = "funder_id must be an integer" - ) - + assertthat::assert_that(funder_id == floor(funder_id), msg = "funder_id must be an integer") + # Validate vb assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - + # Validate rq - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + # Perform API call funder <- perform_api_get( path = sprintf(API_FUNDER_DETAIL, funder_id), rq = rq, vb = vb ) - + if (is.null(funder)) { if (vb) { message("Funder ", funder_id, " not found or inaccessible.") } return(NULL) } - + # Return structured list list( funder_id = funder$id, diff --git a/R/get_institution_avatar.R b/R/get_institution_avatar.R index 836dcc64..3df9ba2f 100644 --- a/R/get_institution_avatar.R +++ b/R/get_institution_avatar.R @@ -16,6 +16,7 @@ NULL #' provided, the filename will be determined from the response headers or #' will default to `institution__avatar.jpg`. If `NULL` (the default), #' the raw image bytes are returned instead of being saved to disk. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @return If `dest_path` is provided, returns the full path to the saved @@ -47,144 +48,137 @@ NULL #' } #' } #' @export -get_institution_avatar <- function( - institution_id = 1, - dest_path = NULL, - vb = options::opt("vb"), - rq = NULL -) { +get_institution_avatar <- function(institution_id = 1, + dest_path = NULL, + vb = options::opt("vb"), + rq = NULL) { # Validate institution_id assertthat::assert_that(is.numeric(institution_id)) assertthat::assert_that(length(institution_id) == 1) assertthat::assert_that(institution_id > 0) - assertthat::assert_that( - institution_id == floor(institution_id), - msg = "institution_id must be an integer" - ) - + assertthat::assert_that(institution_id == floor(institution_id), msg = "institution_id must be an integer") + # Validate dest_path if (!is.null(dest_path)) { assertthat::assert_that(assertthat::is.string(dest_path)) } - + # Validate vb assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - + # Validate rq - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + # Build URL avatar_url <- sprintf(API_INSTITUTION_AVATAR, institution_id) full_url <- paste0(DATABRARY_BASE_URL, avatar_url) - + # Create request if (is.null(rq)) { req <- make_default_request() } else { req <- rq } - + # Build the request with the avatar URL req <- req %>% httr2::req_url(full_url) %>% httr2::req_method("GET") %>% - httr2::req_error(is_error = function(resp) FALSE) - + httr2::req_error( + is_error = function(resp) + FALSE + ) + if (vb) { message("Requesting avatar for institution ", institution_id) } - + # Perform request - tryCatch( - { - resp <- httr2::req_perform(req) - - # Check response status - status <- httr2::resp_status(resp) - if (status != 200) { - if (vb) { - message( - "Institution ", - institution_id, - " avatar not found or inaccessible (status: ", - status, - ")" - ) - } - return(NULL) - } - - # Get raw bytes - avatar_bytes <- httr2::resp_body_raw(resp) - - if (is.null(dest_path)) { - # Return raw bytes - if (vb) { - message("Downloaded ", length(avatar_bytes), " bytes") - } - return(avatar_bytes) - } else { - # Resolve destination path - # If dest_path is a directory, determine filename from response headers or URL - final_path <- dest_path - if (dir.exists(dest_path)) { - # Try to get filename from content-disposition header - filename <- "downloaded_file" - content_disp <- httr2::resp_header(resp, "content-disposition") - - if (!is.null(content_disp) && grepl("filename=", content_disp)) { - # Extract filename from content-disposition header - filename_match <- regmatches( - content_disp, - regexpr("filename=([^;]+)", content_disp) - ) - if (length(filename_match) > 0) { - filename <- sub("filename=", "", filename_match) - filename <- gsub('^"|"$', '', filename) # Remove quotes - filename <- trimws(filename) - } - } else { - # Fallback: use URL path basename - url_path <- sprintf(API_INSTITUTION_AVATAR, institution_id) - filename <- paste0("institution_", institution_id, "_avatar.jpg") - } - - final_path <- file.path(dest_path, filename) - } - - # Create parent directory if needed - parent_dir <- dirname(final_path) - if (!dir.exists(parent_dir)) { - dir.create(parent_dir, recursive = TRUE, showWarnings = FALSE) - } - - # Save to file - writeBin(avatar_bytes, final_path) - - if (vb) { - message( - "Saved avatar to: ", - final_path, - " (", - length(avatar_bytes), - " bytes)" - ) - } - - return(normalizePath(final_path)) - } - }, - error = function(e) { + tryCatch({ + resp <- httr2::req_perform(req) + + # Check response status + status <- httr2::resp_status(resp) + if (status != 200) { if (vb) { message( - "Error downloading avatar for institution ", + "Institution ", institution_id, - ": ", - e$message + " avatar not found or inaccessible (status: ", + status, + ")" ) } return(NULL) } - ) + + # Get raw bytes + avatar_bytes <- httr2::resp_body_raw(resp) + + if (is.null(dest_path)) { + # Return raw bytes + if (vb) { + message("Downloaded ", length(avatar_bytes), " bytes") + } + return(avatar_bytes) + } else { + # Resolve destination path + # If dest_path is a directory, determine filename from response headers or URL + final_path <- dest_path + if (dir.exists(dest_path)) { + # Try to get filename from content-disposition header + filename <- "downloaded_file" + content_disp <- httr2::resp_header(resp, "content-disposition") + + if (!is.null(content_disp) && + grepl("filename=", content_disp)) { + # Extract filename from content-disposition header + filename_match <- regmatches(content_disp, + regexpr("filename=([^;]+)", content_disp)) + if (length(filename_match) > 0) { + filename <- sub("filename=", "", filename_match) + filename <- gsub('^"|"$', '', filename) # Remove quotes + filename <- trimws(filename) + } + } else { + # Fallback: use URL path basename + url_path <- sprintf(API_INSTITUTION_AVATAR, institution_id) + filename <- paste0("institution_", institution_id, "_avatar.jpg") + } + + final_path <- file.path(dest_path, filename) + } + + # Create parent directory if needed + parent_dir <- dirname(final_path) + if (!dir.exists(parent_dir)) { + dir.create(parent_dir, + recursive = TRUE, + showWarnings = FALSE) + } + + # Save to file + writeBin(avatar_bytes, final_path) + + if (vb) { + message("Saved avatar to: ", + final_path, + " (", + length(avatar_bytes), + " bytes)") + } + + return(normalizePath(final_path)) + } + }, error = function(e) { + if (vb) { + message("Error downloading avatar for institution ", + institution_id, + ": ", + e$message) + } + return(NULL) + }) } diff --git a/R/get_institution_by_id.R b/R/get_institution_by_id.R index 267717c3..49c69653 100644 --- a/R/get_institution_by_id.R +++ b/R/get_institution_by_id.R @@ -5,7 +5,8 @@ NULL #' Get institution metadata #' -#' @param institution_id Institution identifier. +#' @param institution_id Institution identifier. Must be a positive integer. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @inheritParams options_params #' #' @return List of institution metadata or NULL when inaccessible. diff --git a/R/get_session_by_id.R b/R/get_session_by_id.R index 8f1d561b..aa6980ae 100644 --- a/R/get_session_by_id.R +++ b/R/get_session_by_id.R @@ -8,6 +8,7 @@ NULL #' @param session_id An integer indicating a valid session/slot identifier #' linked to a volume. Default value is 9807, the materials folder for volume 1. #' @param vol_id An integer indicating the volume identifier. Default is 1. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An httr2 request object. #' #' @returns A JSON blob with the session data. If the user has previously logged diff --git a/R/get_session_by_name.R b/R/get_session_by_name.R index 83defef3..5150cbb4 100644 --- a/R/get_session_by_name.R +++ b/R/get_session_by_name.R @@ -8,6 +8,7 @@ NULL #' @param session_name A string. The name of the target session. Defaults to "Advisory #' Board Meeting", the name of several of the sessions in the public Volume 1. #' @param vol_id An integer indicating the volume identifier. Default is 1. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An httr2 request, such as that generated by `make_default_request()`. #' #' @returns One or more JSON blobs (as lists) whose session name(s) match @@ -41,7 +42,8 @@ get_session_by_name <- assertthat::assert_that(is.logical(vb)) assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) sessions <- collect_paginated_get( path = sprintf(API_VOLUME_SESSIONS, vol_id), @@ -49,13 +51,19 @@ get_session_by_name <- rq = rq, vb = vb ) - + if (is.null(sessions) || length(sessions) == 0) { - if (vb) message("No sessions named '", session_name, "' in volume ", vol_id) + if (vb) + message("No sessions named '", session_name, "' in volume ", vol_id) return(NULL) } - + purrr::map(sessions, function(session) { - databraryr::get_session_by_id(session_id = session$id, vol_id = vol_id, vb = vb, rq = rq) + databraryr::get_session_by_id( + session_id = session$id, + vol_id = vol_id, + vb = vb, + rq = rq + ) }) } \ No newline at end of file diff --git a/R/get_session_file.R b/R/get_session_file.R index 404d3ff7..9e7e4532 100644 --- a/R/get_session_file.R +++ b/R/get_session_file.R @@ -9,6 +9,7 @@ NULL #' @param session_id An integer indicating a valid session/slot identifier #' linked to a volume. Default value is 9807, the materials folder for volume 1. #' @param file_id An integer indicating the file identifier. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An httr2 request object. #' #' @returns A JSON blob with the file data. If the user has previously logged @@ -25,36 +26,35 @@ NULL #' } #' @export get_session_file <- - function( - vol_id = 1, - session_id = 9807, - file_id, - vb = options::opt("vb"), - rq = NULL - ) { + function(vol_id = 1, + session_id = 9807, + file_id, + vb = options::opt("vb"), + rq = NULL) { assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) assertthat::assert_that(length(vol_id) == 1) - + assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id > 0) assertthat::assert_that(length(session_id) == 1) - + assertthat::assert_that(is.numeric(file_id)) assertthat::assert_that(file_id > 0) assertthat::assert_that(length(file_id) == 1) - + assertthat::assert_that(is.logical(vb)) assertthat::assert_that(length(vb) == 1) - - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + file <- perform_api_get( path = sprintf(API_SESSION_FILE_DETAIL, vol_id, session_id, file_id), rq = rq, vb = vb ) - + if (is.null(file)) { if (vb) { message( @@ -68,6 +68,6 @@ get_session_file <- } return(NULL) } - + file } diff --git a/R/get_tag_by_id.R b/R/get_tag_by_id.R index 529ea006..92fd8afa 100644 --- a/R/get_tag_by_id.R +++ b/R/get_tag_by_id.R @@ -9,6 +9,7 @@ NULL #' Databrary using its unique identifier. #' #' @param tag_id Numeric tag identifier. Must be a positive integer. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @return A list with the tag's metadata including id and name, @@ -27,40 +28,35 @@ NULL #' } #' } #' @export -get_tag_by_id <- function(tag_id = 1, vb = options::opt("vb"), rq = NULL) { +get_tag_by_id <- function(tag_id = 1, + vb = options::opt("vb"), + rq = NULL) { # Validate tag_id assertthat::assert_that(is.numeric(tag_id)) assertthat::assert_that(length(tag_id) == 1) assertthat::assert_that(tag_id > 0) - assertthat::assert_that( - tag_id == floor(tag_id), - msg = "tag_id must be an integer" - ) - + assertthat::assert_that(tag_id == floor(tag_id), msg = "tag_id must be an integer") + # Validate vb assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - + # Validate rq - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + # Perform API call - tag <- perform_api_get( - path = sprintf(API_TAG_DETAIL, tag_id), - rq = rq, - vb = vb - ) - + tag <- perform_api_get(path = sprintf(API_TAG_DETAIL, tag_id), + rq = rq, + vb = vb) + if (is.null(tag)) { if (vb) { message("Tag ", tag_id, " not found or inaccessible.") } return(NULL) } - + # Return structured list - list( - tag_id = tag$id, - tag_name = tag$name - ) + list(tag_id = tag$id, tag_name = tag$name) } diff --git a/R/get_user_avatar.R b/R/get_user_avatar.R index c9fa961b..eaa84f98 100644 --- a/R/get_user_avatar.R +++ b/R/get_user_avatar.R @@ -40,87 +40,83 @@ NULL #' } #' } #' @export -get_user_avatar <- function( - user_id, - dest_path = NULL, - vb = options::opt("vb"), - rq = NULL -) { +get_user_avatar <- function(user_id, + dest_path = NULL, + vb = options::opt("vb"), + rq = NULL) { # Validate user_id assertthat::assert_that(length(user_id) == 1) - assertthat::assert_that(is.numeric(user_id) || is.integer(user_id)) + assertthat::assert_that(is.numeric(user_id) || + is.integer(user_id)) assertthat::assert_that(user_id > 0) - + # Validate dest_path if (!is.null(dest_path)) { assertthat::assert_that(assertthat::is.string(dest_path)) } - + # Validate vb assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - + # Validate rq - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + # Build URL path path <- sprintf(API_USER_AVATAR, user_id) - + if (vb) { message("Getting user avatar for user ID: ", user_id) } - + # Set up request if (is.null(rq)) { rq <- make_default_request() } - + # Perform request - resp <- tryCatch( - { - rq |> - httr2::req_url_path_append(path) |> - httr2::req_error(is_error = function(resp) FALSE) |> - httr2::req_perform() - }, - error = function(e) { - if (vb) { - message("Error downloading user avatar: ", conditionMessage(e)) - } - return(NULL) + resp <- tryCatch({ + rq |> + httr2::req_url_path_append(path) |> + httr2::req_error( + is_error = function(resp) + FALSE + ) |> + httr2::req_perform() + }, error = function(e) { + if (vb) { + message("Error downloading user avatar: ", conditionMessage(e)) } - ) - + return(NULL) + }) + if (is.null(resp)) { return(NULL) } - + # Check for errors if (httr2::resp_status(resp) != 200) { if (vb) { - message( - "Failed to download user avatar. Status: ", - httr2::resp_status(resp) - ) + message("Failed to download user avatar. Status: ", + httr2::resp_status(resp)) } return(NULL) } - + # Get avatar bytes avatar_bytes <- httr2::resp_body_raw(resp) - + # If no destination path, return bytes if (is.null(dest_path)) { if (vb) { - message( - "Returning avatar as raw bytes (", - length(avatar_bytes), - " bytes)" - ) + message("Returning avatar as raw bytes (", + length(avatar_bytes), + " bytes)") } return(avatar_bytes) } - + # Save to file # Resolve destination path # If dest_path is a directory, determine filename from response headers or URL @@ -129,13 +125,12 @@ get_user_avatar <- function( # Try to get filename from content-disposition header filename <- "downloaded_file" content_disp <- httr2::resp_header(resp, "content-disposition") - - if (!is.null(content_disp) && grepl("filename=", content_disp)) { + + if (!is.null(content_disp) && + grepl("filename=", content_disp)) { # Extract filename from content-disposition header - filename_match <- regmatches( - content_disp, - regexpr("filename=([^;]+)", content_disp) - ) + filename_match <- regmatches(content_disp, + regexpr("filename=([^;]+)", content_disp)) if (length(filename_match) > 0) { filename <- sub("filename=", "", filename_match) filename <- gsub('^"|"$', '', filename) # Remove quotes @@ -146,30 +141,27 @@ get_user_avatar <- function( url_path <- sprintf(API_USER_AVATAR, user_id) filename <- paste0("user_", user_id, "_avatar.jpg") } - + final_path <- file.path(dest_path, filename) } - + # Ensure parent directory exists parent_dir <- dirname(final_path) if (!dir.exists(parent_dir)) { dir.create(parent_dir, recursive = TRUE) } - + # Write to file - tryCatch( - { - writeBin(avatar_bytes, final_path) - if (vb) { - message("Avatar saved to: ", final_path) - } - return(normalizePath(final_path)) - }, - error = function(e) { - if (vb) { - message("Error saving avatar to file: ", conditionMessage(e)) - } - return(NULL) + tryCatch({ + writeBin(avatar_bytes, final_path) + if (vb) { + message("Avatar saved to: ", final_path) } - ) + return(normalizePath(final_path)) + }, error = function(e) { + if (vb) { + message("Error saving avatar to file: ", conditionMessage(e)) + } + return(NULL) + }) } diff --git a/R/get_user_by_id.R b/R/get_user_by_id.R index 52bc3ae0..f5455c9e 100644 --- a/R/get_user_by_id.R +++ b/R/get_user_by_id.R @@ -5,7 +5,8 @@ NULL #' Get public profile information for a Databrary user #' -#' @param user_id User identifier. +#' @param user_id User identifier. Must be a positive integer. Default is 6. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @inheritParams options_params #' #' @return A list with the user's public metadata. @@ -14,23 +15,25 @@ get_user_by_id <- function(user_id = 6, vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(is.numeric(user_id), length(user_id) == 1, user_id > 0) - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + user <- perform_api_get( path = sprintf(API_USER_DETAIL, user_id), rq = rq, vb = vb ) - + if (is.null(user)) { - if (vb) message("User ", user_id, " not found or inaccessible.") + if (vb) + message("User ", user_id, " not found or inaccessible.") return(NULL) } - + affiliation <- user$affiliation institution_name <- affiliation$name institution_id <- affiliation$id - + tibble::tibble( id = user$id, prename = user$first_name, @@ -43,4 +46,3 @@ get_user_by_id <- function(user_id = 6, ) %>% as.list() } - diff --git a/R/get_volume_by_id.R b/R/get_volume_by_id.R index 9480730e..94b11352 100644 --- a/R/get_volume_by_id.R +++ b/R/get_volume_by_id.R @@ -5,7 +5,8 @@ NULL #' Get Summary Data About A Databrary Volume #' -#' @param vol_id Volume ID. +#' @param vol_id Volume ID. Must be a positive integer. Default is 1. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. If NULL (the default), a new request #' is generated using `make_default_request()`. To access restricted data, #' the user must login with a specific request object using `login_db()`. diff --git a/R/get_volume_collaborator_by_id.R b/R/get_volume_collaborator_by_id.R index 6819184c..0420dce7 100644 --- a/R/get_volume_collaborator_by_id.R +++ b/R/get_volume_collaborator_by_id.R @@ -12,6 +12,7 @@ NULL #' #' @param vol_id Target volume number. Must be a positive integer. #' @param collaborator_id Numeric collaborator identifier. Must be a positive integer. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @return A list with the collaborator's metadata including id, volume, user @@ -32,44 +33,37 @@ NULL #' } #' } #' @export -get_volume_collaborator_by_id <- function( - vol_id = 1, - collaborator_id = 1, - vb = options::opt("vb"), - rq = NULL -) { +get_volume_collaborator_by_id <- function(vol_id = 1, + collaborator_id = 1, + vb = options::opt("vb"), + rq = NULL) { # Validate vol_id assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(vol_id >= 1) - assertthat::assert_that( - vol_id == floor(vol_id), - msg = "vol_id must be an integer" - ) - + assertthat::assert_that(vol_id == floor(vol_id), msg = "vol_id must be an integer") + # Validate collaborator_id assertthat::assert_that(is.numeric(collaborator_id)) assertthat::assert_that(length(collaborator_id) == 1) assertthat::assert_that(collaborator_id > 0) - assertthat::assert_that( - collaborator_id == floor(collaborator_id), - msg = "collaborator_id must be an integer" - ) - + assertthat::assert_that(collaborator_id == floor(collaborator_id), msg = "collaborator_id must be an integer") + # Validate vb assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - + # Validate rq - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + # Perform API call collaborator <- perform_api_get( path = sprintf(API_VOLUME_COLLABORATOR_DETAIL, vol_id, collaborator_id), rq = rq, vb = vb ) - + if (is.null(collaborator)) { if (vb) { message( @@ -82,7 +76,7 @@ get_volume_collaborator_by_id <- function( } return(NULL) } - + # Process user information user <- NULL if (!is.null(collaborator$user)) { @@ -95,7 +89,7 @@ get_volume_collaborator_by_id <- function( has_avatar = collaborator$user$has_avatar ) } - + # Process sponsor information sponsor <- NULL if (!is.null(collaborator$sponsor)) { @@ -106,7 +100,7 @@ get_volume_collaborator_by_id <- function( email = collaborator$sponsor$email ) } - + # Process sponsorship information sponsorship <- NULL if (!is.null(collaborator$sponsorship)) { @@ -117,13 +111,11 @@ get_volume_collaborator_by_id <- function( status = collaborator$sponsorship$status ) } - + # Process sponsored_users if present sponsored_users <- NULL - if ( - !is.null(collaborator$sponsored_users) && - length(collaborator$sponsored_users) > 0 - ) { + if (!is.null(collaborator$sponsored_users) && + length(collaborator$sponsored_users) > 0) { sponsored_users <- lapply(collaborator$sponsored_users, function(u) { list( user_id = u$id, @@ -133,7 +125,7 @@ get_volume_collaborator_by_id <- function( ) }) } - + # Return structured list list( collaborator_id = collaborator$id, diff --git a/R/get_volume_record_by_id.R b/R/get_volume_record_by_id.R index ea263481..aadf2447 100644 --- a/R/get_volume_record_by_id.R +++ b/R/get_volume_record_by_id.R @@ -10,8 +10,9 @@ NULL #' Records contain participant information including age, birthday, category, #' and associated measures collected during sessions. #' -#' @param vol_id Target volume number. Must be a positive integer. -#' @param record_id Numeric record identifier. Must be a positive integer. +#' @param vol_id Target volume number. Must be a positive integer. Default is 1. +#' @param record_id Numeric record identifier. Must be a positive integer. Default is 1. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @return A list with the record's metadata including id, volume, category_id, diff --git a/R/list_asset_formats.R b/R/list_asset_formats.R index 5720a8be..6c2ec3db 100644 --- a/R/list_asset_formats.R +++ b/R/list_asset_formats.R @@ -5,6 +5,10 @@ NULL #' List Stored Assets (Files) By Type. #' +#' @description List the data (file) formats supported by Databrary. +#' +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' #' @returns A data frame with information about the data formats Databrary #' supports. #' diff --git a/R/list_authorized_investigators.R b/R/list_authorized_investigators.R index e6419454..85d96982 100644 --- a/R/list_authorized_investigators.R +++ b/R/list_authorized_investigators.R @@ -5,6 +5,12 @@ NULL #' List authorized investigators for an institution #' +#' @description Lists the authorized investigators at an institution. +#' +#' @param institution_id Institution identifier. Must be a positive integer. Default is 12. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' #' @inheritParams list_institution_affiliates #' #' @return Tibble of investigators; NULL if none. @@ -12,19 +18,21 @@ NULL list_authorized_investigators <- function(institution_id = 12, vb = options::opt("vb"), rq = NULL) { - assertthat::assert_that(is.numeric(institution_id), length(institution_id) == 1, institution_id > 0) + assertthat::assert_that(is.numeric(institution_id), + length(institution_id) == 1, + institution_id > 0) assertthat::assert_that(is.logical(vb), length(vb) == 1) - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + affiliates <- list_institution_affiliates(institution_id, vb = vb, rq = rq) if (is.null(affiliates)) { return(NULL) } - + investigators <- affiliates |> dplyr::filter(.data$role == "investigator") if (nrow(investigators) == 0) { return(NULL) } investigators } - diff --git a/R/list_categories.R b/R/list_categories.R index dcc2c9d8..603a95a1 100644 --- a/R/list_categories.R +++ b/R/list_categories.R @@ -9,6 +9,7 @@ NULL #' define different types of data collection sessions and include nested #' metrics that specify the data fields collected for each category. #' +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @return A tibble containing metadata for each category including id, name, @@ -31,29 +32,27 @@ list_categories <- function(vb = options::opt("vb"), rq = NULL) { # Validate vb assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - + # Validate rq - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + # Perform API call - categories <- perform_api_get( - path = API_CATEGORIES, - rq = rq, - vb = vb - ) - + categories <- perform_api_get(path = API_CATEGORIES, rq = rq, vb = vb) + if (is.null(categories) || length(categories) == 0) { if (vb) { message("No categories available.") } return(NULL) } - + # Process categories into tibble purrr::map_dfr(categories, function(category) { # Process metrics if present metrics <- NULL - if (!is.null(category$metrics) && length(category$metrics) > 0) { + if (!is.null(category$metrics) && + length(category$metrics) > 0) { metrics <- lapply(category$metrics, function(metric) { list( metric_id = metric$id, @@ -67,7 +66,7 @@ list_categories <- function(vb = options::opt("vb"), rq = NULL) { ) }) } - + tibble::tibble( category_id = category$id, category_name = category$name, diff --git a/R/list_folder_assets.R b/R/list_folder_assets.R index ccbac127..2ce1d87d 100644 --- a/R/list_folder_assets.R +++ b/R/list_folder_assets.R @@ -5,8 +5,11 @@ NULL #' List Assets Within a Databrary Folder. #' -#' @param folder_id Folder identifier scoped to the given volume. +#' @param folder_id Folder identifier scoped to the given volume. Must be a +#' positive integer. Default is 1. #' @param vol_id Volume containing the folder. Required for Django API calls. +#' Must be a positive integer. Default is 1. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @returns A tibble with metadata for files contained in the folder, or @@ -28,49 +31,52 @@ list_folder_assets <- function(folder_id = 1, assertthat::assert_that(length(folder_id) == 1) assertthat::assert_that(is.numeric(folder_id)) assertthat::assert_that(folder_id >= 1) - + if (is.null(vol_id)) { - stop("vol_id must be supplied for list_folder_assets(); folder identifiers are scoped to volumes.", - call. = FALSE) + stop( + "vol_id must be supplied for list_folder_assets(); folder identifiers are scoped to volumes.", + call. = FALSE + ) } - + assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + folder <- databraryr::get_folder_by_id( folder_id = folder_id, vol_id = vol_id, vb = vb, rq = rq ) - + if (is.null(folder)) { return(NULL) } - + files <- collect_paginated_get( path = sprintf(API_FOLDER_FILES, vol_id, folder_id), rq = rq, vb = vb ) - + if (is.null(files) || length(files) == 0) { if (vb) { message("No assets for folder_id ", folder_id) } return(NULL) } - + file_rows <- purrr::map_dfr(files, function(file) { format <- file$format uploader <- file$uploader - + tibble::tibble( asset_id = file$id, asset_name = file$name, @@ -90,7 +96,7 @@ list_folder_assets <- function(folder_id = 1, asset_thumbnail_url = file$thumbnail_url ) }) - + file_rows %>% dplyr::mutate( folder_id = folder_id, @@ -100,4 +106,3 @@ list_folder_assets <- function(folder_id = 1, folder_source_date = folder$source_date ) } - diff --git a/R/list_institution_affiliates.R b/R/list_institution_affiliates.R index 127c1a1a..a05508b6 100644 --- a/R/list_institution_affiliates.R +++ b/R/list_institution_affiliates.R @@ -5,7 +5,10 @@ NULL #' List affiliates for an institution #' -#' @param institution_id Institution identifier. +#' @param institution_id Institution identifier. Must be a positive integer. Default is 12. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' #' @inheritParams options_params #' #' @return Tibble of affiliates with roles and expiration dates. @@ -13,20 +16,28 @@ NULL list_institution_affiliates <- function(institution_id = 12, vb = options::opt("vb"), rq = NULL) { - assertthat::assert_that(is.numeric(institution_id), length(institution_id) == 1, institution_id > 0) - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + assertthat::assert_that(is.numeric(institution_id), + length(institution_id) == 1, + institution_id > 0) + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + affiliates <- collect_paginated_get( path = sprintf(API_INSTITUTION_AFFILIATES, institution_id), rq = rq, vb = vb ) - + if (is.null(affiliates) || length(affiliates) == 0) { - if (vb) message("No affiliates for institution ", institution_id) + if (vb) + message("No affiliates for institution ", institution_id) return(NULL) } - + purrr::map_dfr(affiliates, function(entry) { user <- entry$user tibble::tibble( @@ -42,4 +53,3 @@ list_institution_affiliates <- function(institution_id = 12, ) }) } - diff --git a/R/list_institutions.R b/R/list_institutions.R index f86d3b50..e6854a46 100644 --- a/R/list_institutions.R +++ b/R/list_institutions.R @@ -10,6 +10,7 @@ NULL #' #' @param search_string Optional character string to filter institutions. If #' `NULL` (the default), returns all institutions. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @return A tibble containing institutions with their metadata including id, @@ -33,29 +34,28 @@ NULL #' } #' } #' @export -list_institutions <- function( - search_string = NULL, - vb = options::opt("vb"), - rq = NULL -) { +list_institutions <- function(search_string = NULL, + vb = options::opt("vb"), + rq = NULL) { # Validate search_string if (!is.null(search_string)) { assertthat::assert_that(assertthat::is.string(search_string)) } - + # Validate vb assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - + # Validate rq - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + # Build params list params <- list() if (!is.null(search_string)) { params$search <- search_string } - + # Perform API call with pagination results <- collect_paginated_get( path = API_INSTITUTIONS_LIST, @@ -63,7 +63,7 @@ list_institutions <- function( rq = rq, vb = vb ) - + if (is.null(results) || length(results) == 0) { if (vb) { if (is.null(search_string)) { @@ -74,13 +74,16 @@ list_institutions <- function( } return(NULL) } - + # Process results into tibble purrr::map_dfr(results, function(entry) { tibble::tibble( institution_id = entry$id, institution_name = entry$name, - institution_url = if (is.null(entry$url)) NA_character_ else entry$url, + institution_url = if (is.null(entry$url)) + NA_character_ + else + entry$url, institution_date_signed = if (is.null(entry$date_signed)) { NA_character_ } else { diff --git a/R/list_session_activity.R b/R/list_session_activity.R index 915906e4..2e761f9f 100644 --- a/R/list_session_activity.R +++ b/R/list_session_activity.R @@ -5,11 +5,12 @@ NULL #' List Activity History in Databrary Session. #' -#' For an accessible session, returns the logged history events associated with +#' @description For an accessible session, returns the logged history events associated with #' the session. Requires authenticated access with sufficient permissions. #' -#' @param vol_id Volume identifier (required by the Django API). -#' @param session_id Session identifier. +#' @param vol_id Volume identifier (required by the Django API). Must be a positive integer. +#' @param session_id Session identifier. Must be a positive integer. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. When `NULL`, a #' default request is generated, but this will only permit public information #' to be returned. @@ -35,34 +36,35 @@ list_session_activity <- assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) - + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id > 0) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + if (is.null(rq)) { rq <- databraryr::make_default_request() } rq <- httr2::req_timeout(rq, REQUEST_TIMEOUT_VERY_LONG) - + activities <- collect_paginated_get( path = sprintf(API_VOLUME_HISTORY, vol_id), rq = rq, vb = vb ) - + if (is.null(activities) || length(activities) == 0) { if (vb) { message("No activity history available for volume ", vol_id) } return(NULL) } - + session_details <- databraryr::get_session_by_id( session_id = session_id, vol_id = vol_id, @@ -73,7 +75,7 @@ list_session_activity <- if (!is.null(session_details)) { session_name <- session_details$name } - + session_entries <- purrr::keep(activities, function(entry) { session_identifier <- entry$session_id if (is.null(session_identifier) && !is.null(entry$session)) { @@ -84,25 +86,28 @@ list_session_activity <- session_identifier <- session_value } } - + if (!is.null(session_identifier)) { return(isTRUE(session_identifier == session_id)) } - + if (!is.null(session_name) && !is.null(entry$name)) { return(isTRUE(entry$name == session_name)) } - + FALSE }) - + if (length(session_entries) == 0) { if (vb) { - message("No activity history for session ", session_id, " within volume ", vol_id) + message("No activity history for session ", + session_id, + " within volume ", + vol_id) } return(NULL) } - + purrr::map_dfr(session_entries, function(entry) { history_user <- entry$history_user folder_id <- entry$folder_id @@ -114,15 +119,21 @@ list_session_activity <- folder_id <- folder } } - + safe_int <- function(value) { - if (is.null(value)) NA_integer_ else value + if (is.null(value)) + NA_integer_ + else + value } - + safe_chr <- function(value) { - if (is.null(value)) NA_character_ else value + if (is.null(value)) + NA_character_ + else + value } - + tibble::tibble( event_type = entry$type, event_timestamp = entry$timestamp, diff --git a/R/list_session_assets.R b/R/list_session_assets.R index 270658ec..af1b4c52 100644 --- a/R/list_session_assets.R +++ b/R/list_session_assets.R @@ -17,6 +17,7 @@ NULL #' @param vol_id Optional integer. The volume containing the session. Recent #' versions of the Databrary API require this value to be supplied because #' session identifiers are scoped to volumes. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. If NULL, a default request is generated #' from databraryr::make_default_request(). #' diff --git a/R/list_user_affiliates.R b/R/list_user_affiliates.R index 28876019..4550aded 100644 --- a/R/list_user_affiliates.R +++ b/R/list_user_affiliates.R @@ -5,7 +5,10 @@ NULL #' List affiliates for a user #' -#' @param user_id User identifier. +#' @param user_id User identifier. Must be an integer. Default is 6. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' #' @inheritParams options_params #' #' @return Tibble of affiliates for the user. @@ -16,6 +19,12 @@ list_user_affiliates <- function(user_id = 6, assertthat::assert_that(is.numeric(user_id), length(user_id) == 1, user_id > 0) assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + affiliates <- collect_paginated_get( path = sprintf(API_USER_AFFILIATES, user_id), rq = rq, diff --git a/R/list_user_history.R b/R/list_user_history.R index baa70ce5..c1f8721e 100644 --- a/R/list_user_history.R +++ b/R/list_user_history.R @@ -9,7 +9,8 @@ NULL #' user. Access is restricted to administrators and authorized investigators #' with sufficient privileges. #' -#' @param user_id Target user identifier. +#' @param user_id Target user identifier. Must be a positive integer. Default is 22582. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @return A tibble containing authentication and activity events for the @@ -30,25 +31,26 @@ list_user_history <- function(user_id = 22582, assertthat::assert_that(is.numeric(user_id)) assertthat::assert_that(length(user_id) == 1) assertthat::assert_that(user_id > 0) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + history <- collect_paginated_get( path = sprintf(API_USERS_HISTORY, user_id), rq = rq, vb = vb ) - + if (is.null(history) || length(history) == 0) { if (vb) { message("No activity history available for user ", user_id) } return(NULL) } - + purrr::map_dfr(history, function(entry) { tibble::tibble( user_id = user_id, @@ -61,5 +63,3 @@ list_user_history <- function(user_id = 22582, ) }) } - - diff --git a/R/list_user_sponsors.R b/R/list_user_sponsors.R index 880e3d58..fae5445e 100644 --- a/R/list_user_sponsors.R +++ b/R/list_user_sponsors.R @@ -8,27 +8,35 @@ NULL #' @param user_id User identifier. #' @inheritParams options_params #' -#' @return Tibble of sponsors for the user. +#' @returns Tibble of sponsors for the user. #' @export list_user_sponsors <- function(user_id = 6, - vb = options::opt("vb"), - rq = NULL) { + vb = options::opt("vb"), + rq = NULL) { assertthat::assert_that(is.numeric(user_id), length(user_id) == 1, user_id > 0) - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + sponsorships <- collect_paginated_get( path = sprintf(API_USER_SPONSORSHIPS, user_id), rq = rq, vb = vb ) - + if (is.null(sponsorships) || length(sponsorships) == 0) { - if (vb) message("No sponsorships for user ", user_id) + if (vb) + message("No sponsorships for user ", user_id) return(NULL) } - + user <- get_user_by_id(user_id, vb = vb, rq = rq) - + purrr::map_dfr(sponsorships, function(entry) { sponsor <- entry$user tibble::tibble( @@ -47,4 +55,3 @@ list_user_sponsors <- function(user_id = 6, ) }) } - diff --git a/R/list_user_volumes.R b/R/list_user_volumes.R index 5ed63a00..e4448814 100644 --- a/R/list_user_volumes.R +++ b/R/list_user_volumes.R @@ -3,9 +3,12 @@ #' NULL -#' List volumes associated with a user +#' List Volumes Associated With A User #' -#' @param user_id User identifier. +#' @param user_id User identifier. Must be a positive integer. Default is 6. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @param rq An `httr2` request object. Default is NULL. +#' #' @inheritParams options_params #' #' @return Tibble of volumes the user owns or collaborates on. diff --git a/R/list_users.R b/R/list_users.R index 745916a5..1a35ab9a 100644 --- a/R/list_users.R +++ b/R/list_users.R @@ -19,6 +19,7 @@ NULL #' response to authorized investigators. #' @param has_api_access Optional logical value restricting the response to #' accounts with API access enabled. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @return A tibble containing directory metadata for each user, or `NULL` when diff --git a/R/list_volume_activity.R b/R/list_volume_activity.R index cbef27f8..80a36a67 100644 --- a/R/list_volume_activity.R +++ b/R/list_volume_activity.R @@ -5,10 +5,11 @@ NULL #' List Activity In A Databrary Volume #' -#' If a user has access to a volume, this command lists the modification +#' @description If a user has access to a volume, this command lists the modification #' history of the volume as a #' -#' @param vol_id Selected volume number. +#' @param vol_id Selected volume number. Must be a positive integer. Default is 1892. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to NULL. #' #' @returns A list with the activity history on a volume. diff --git a/R/list_volume_assets.R b/R/list_volume_assets.R index d9c038ca..c7531bb2 100644 --- a/R/list_volume_assets.R +++ b/R/list_volume_assets.R @@ -5,7 +5,8 @@ NULL #' List Assets in Databrary Volume. #' -#' @param vol_id Target volume number. Default is 1. +#' @param vol_id Target volume number. Must be a positive integer. Default is 1. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Default is NULL. #' #' @returns A data frame with information about all assets in a volume. diff --git a/R/list_volume_collaborators.R b/R/list_volume_collaborators.R index 9b73f4a0..369e9c3b 100644 --- a/R/list_volume_collaborators.R +++ b/R/list_volume_collaborators.R @@ -8,7 +8,8 @@ NULL #' @description Retrieve collaboration metadata for a specified volume, #' including sponsor details and access levels. #' -#' @param vol_id Target volume number. +#' @param vol_id Target volume number. Must be a positive integer. Default is 1. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @return A tibble summarizing collaborator relationships on the volume, or @@ -24,57 +25,95 @@ NULL #' } #' @export list_volume_collaborators <- function(vol_id = 1, - vb = options::opt("vb"), - rq = NULL) { + vb = options::opt("vb"), + rq = NULL) { assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + collaborators <- perform_api_get( path = sprintf(API_VOLUME_COLLABORATORS, vol_id), rq = rq, vb = vb ) - + if (is.null(collaborators) || length(collaborators) == 0) { if (vb) { message("No collaborators found for volume ", vol_id) } return(NULL) } - + purrr::map_dfr(collaborators, function(entry) { user <- entry$user sponsor <- entry$sponsor - - sponsor_id <- if (!is.null(sponsor)) sponsor$id else NA_integer_ - sponsor_first <- if (!is.null(sponsor)) sponsor$first_name else NA_character_ - sponsor_last <- if (!is.null(sponsor)) sponsor$last_name else NA_character_ - sponsor_email <- if (!is.null(sponsor)) sponsor$email else NA_character_ - + + sponsor_id <- if (!is.null(sponsor)) + sponsor$id + else + NA_integer_ + sponsor_first <- if (!is.null(sponsor)) + sponsor$first_name + else + NA_character_ + sponsor_last <- if (!is.null(sponsor)) + sponsor$last_name + else + NA_character_ + sponsor_email <- if (!is.null(sponsor)) + sponsor$email + else + NA_character_ + tibble::tibble( collaborator_id = entry$id, volume_id = vol_id, - collaborator_user_id = if (is.null(user)) NA_integer_ else user$id, - collaborator_first_name = if (is.null(user)) NA_character_ else user$first_name, - collaborator_last_name = if (is.null(user)) NA_character_ else user$last_name, - collaborator_email = if (is.null(user)) NA_character_ else user$email, - collaborator_is_authorized_investigator = if (is.null(user$is_authorized_investigator)) NA else user$is_authorized_investigator, - collaborator_has_avatar = if (is.null(user$has_avatar)) NA else user$has_avatar, + collaborator_user_id = if (is.null(user)) + NA_integer_ + else + user$id, + collaborator_first_name = if (is.null(user)) + NA_character_ + else + user$first_name, + collaborator_last_name = if (is.null(user)) + NA_character_ + else + user$last_name, + collaborator_email = if (is.null(user)) + NA_character_ + else + user$email, + collaborator_is_authorized_investigator = if (is.null(user$is_authorized_investigator)) + NA + else + user$is_authorized_investigator, + collaborator_has_avatar = if (is.null(user$has_avatar)) + NA + else + user$has_avatar, sponsor_user_id = sponsor_id, sponsor_first_name = sponsor_first, sponsor_last_name = sponsor_last, sponsor_email = sponsor_email, - access_level = if (is.null(entry$access_level)) NA_character_ else entry$access_level, - is_publicly_visible = if (is.null(entry$is_publicly_visible)) NA else entry$is_publicly_visible, - expiration_date = if (is.null(entry$expiration_date)) NA_character_ else entry$expiration_date + access_level = if (is.null(entry$access_level)) + NA_character_ + else + entry$access_level, + is_publicly_visible = if (is.null(entry$is_publicly_visible)) + NA + else + entry$is_publicly_visible, + expiration_date = if (is.null(entry$expiration_date)) + NA_character_ + else + entry$expiration_date ) }) } - - diff --git a/R/list_volume_folders.R b/R/list_volume_folders.R index ea19094b..52a66ca3 100644 --- a/R/list_volume_folders.R +++ b/R/list_volume_folders.R @@ -5,7 +5,8 @@ NULL #' List Folders in a Databrary Volume. #' -#' @param vol_id Target volume number. +#' @param vol_id Target volume number. Must be a positive integer. Default is 1. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @returns A tibble with metadata about folders in the selected volume, or @@ -26,31 +27,32 @@ list_volume_folders <- function(vol_id = 1, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + folders <- collect_paginated_get( path = sprintf(API_VOLUME_FOLDERS, vol_id), rq = rq, vb = vb ) - + if (is.null(folders) || length(folders) == 0) { if (vb) { message("No folders available for volume ", vol_id) } return(NULL) } - + purrr::map_dfr(folders, function(folder) { volume_value <- folder$volume if (is.null(volume_value)) { volume_value <- vol_id } - + tibble::tibble( folder_id = folder$id, folder_name = folder$name, @@ -66,4 +68,3 @@ list_volume_folders <- function(vol_id = 1, ) }) } - diff --git a/R/list_volume_funding.R b/R/list_volume_funding.R index 64240d53..dd26495f 100644 --- a/R/list_volume_funding.R +++ b/R/list_volume_funding.R @@ -6,8 +6,9 @@ NULL #' Lists Funders Associated With a Databrary Volume. #' #' @param vol_id Target volume number. -#' @param add_id A logical value. Include the volume ID in the output. +#' @param add_id A logical value. Include the volume ID in the output. #' Default is TRUE. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. #' #' @returns A data frame with funder information for the volume. @@ -51,18 +52,18 @@ list_volume_funding <- function(vol_id = 1, if (vb) message("Summarizing funding for n=", length(vol_id), " volumes.") - + purrr::map(vol_id, function(id) { fundings <- perform_api_get( path = sprintf(API_VOLUME_FUNDINGS, id), rq = rq, vb = vb ) - + if (is.null(fundings) || length(fundings) == 0) { return(NULL) } - + rows <- purrr::map_dfr(fundings, function(entry) { funder <- entry$funder tibble::tibble( diff --git a/R/list_volume_info.R b/R/list_volume_info.R index 842f2ccf..3f24b0a2 100644 --- a/R/list_volume_info.R +++ b/R/list_volume_info.R @@ -5,8 +5,9 @@ NULL #' List Basic Volume Info. #' -#' @param vol_id Target volume number. -#' @param rq An `httr2` request object. If NULL (the default) +#' @param vol_id Target volume number. Must be a positive integer. Defaults to 1. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @param rq An `httr2` request object. If NULL (the default). #' a request will be generated, but this will only permit public information #' to be returned. #' diff --git a/R/list_volume_links.R b/R/list_volume_links.R index ced97f18..07e5b715 100644 --- a/R/list_volume_links.R +++ b/R/list_volume_links.R @@ -5,7 +5,8 @@ NULL #' Retrieves URL Links From A Databrary Volume. #' -#' @param vol_id Target volume number. +#' @param vol_id Target volume number. Must be a positive integer. Default is 1. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. #' #' @returns A data frame with the requested data. @@ -35,11 +36,11 @@ list_volume_links <- function(vol_id = 1, rq = rq, vb = vb ) - + if (is.null(links) || length(links) == 0) { return(NULL) } - + purrr::map_dfr(links, function(link) { tibble::tibble( link_id = link$id, diff --git a/R/list_volume_records.R b/R/list_volume_records.R index 69b61ad5..969c86b5 100644 --- a/R/list_volume_records.R +++ b/R/list_volume_records.R @@ -12,6 +12,7 @@ NULL #' @param vol_id Target volume number. Must be a positive integer. #' @param category_id Optional numeric category identifier to filter records #' by category type. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @return A tibble containing metadata for each record including id, volume, @@ -34,45 +35,38 @@ NULL #' } #' } #' @export -list_volume_records <- function( - vol_id = 1, - category_id = NULL, - vb = options::opt("vb"), - rq = NULL -) { +list_volume_records <- function(vol_id = 1, + category_id = NULL, + vb = options::opt("vb"), + rq = NULL) { # Validate vol_id assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - assertthat::assert_that( - vol_id == floor(vol_id), - msg = "vol_id must be an integer" - ) - + assertthat::assert_that(vol_id == floor(vol_id), msg = "vol_id must be an integer") + # Validate category_id if (!is.null(category_id)) { assertthat::assert_that(length(category_id) == 1) assertthat::assert_that(is.numeric(category_id)) assertthat::assert_that(category_id > 0) - assertthat::assert_that( - category_id == floor(category_id), - msg = "category_id must be an integer" - ) + assertthat::assert_that(category_id == floor(category_id), msg = "category_id must be an integer") } - + # Validate vb assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - + # Validate rq - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + # Build params list params <- list() if (!is.null(category_id)) { params$category_id <- category_id } - + # Perform API call records <- collect_paginated_get( path = sprintf(API_VOLUME_RECORDS, vol_id), @@ -80,14 +74,14 @@ list_volume_records <- function( rq = rq, vb = vb ) - + if (is.null(records) || length(records) == 0) { if (vb) { message("No records found for volume ", vol_id) } return(NULL) } - + # Process records into tibble purrr::map_dfr(records, function(record) { # Process age if present @@ -98,7 +92,7 @@ list_volume_records <- function( age_formatted <- NA_character_ age_is_estimated <- NA age_is_blurred <- NA - + if (!is.null(record$age)) { age_years <- if (!is.null(record$age$years)) { record$age$years @@ -136,7 +130,7 @@ list_volume_records <- function( NA } } - + tibble::tibble( record_id = record$id, record_volume = record$volume, diff --git a/R/list_volume_session_assets.R b/R/list_volume_session_assets.R index 851fad24..09ff76d3 100644 --- a/R/list_volume_session_assets.R +++ b/R/list_volume_session_assets.R @@ -13,8 +13,9 @@ NULL #' requre the volume ID. The `list_volume_session_assets()` *requires* a volume #' ID. #' -#' @param vol_id Target volume number. +#' @param vol_id Target volume number. Must be a positive integer. #' @param session_id The session number in the selected volume. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. #' #' @returns A data frame with information about all assets in a volume. diff --git a/R/list_volume_sessions.R b/R/list_volume_sessions.R index d8020b29..d0a78ba9 100644 --- a/R/list_volume_sessions.R +++ b/R/list_volume_sessions.R @@ -5,9 +5,10 @@ NULL #' List Sessions in Databrary Volume. #' -#' @param vol_id Target volume number. +#' @param vol_id Target volume number. Must be a positive integer. Default is 1. #' @param include_vol_data A Boolean value. Include volume-level metadata #' or not. Default is FALSE. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. If NULL (the default) #' a request will be generated, but this will only permit public information #' to be returned. diff --git a/R/list_volume_tags.R b/R/list_volume_tags.R index ddb63768..b048bcac 100644 --- a/R/list_volume_tags.R +++ b/R/list_volume_tags.R @@ -5,7 +5,8 @@ NULL #' Lists Keywords And Tags For A Volume. #' -#' @param vol_id Target volume number. +#' @param vol_id Target volume number. Must be a positive integer. Default is 1. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Default is NULL. #' #' @returns A data frame with the requested data. diff --git a/R/list_volumes.R b/R/list_volumes.R index 7409bbd0..49cbf7d0 100644 --- a/R/list_volumes.R +++ b/R/list_volumes.R @@ -12,9 +12,10 @@ NULL #' description. #' @param ordering Optional character string indicating the sort field accepted #' by the API (e.g., `"title"`, `"-title"`). +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' -#' @return A tibble summarizing each accessible volume, or `NULL` when no +#' @returns A tibble summarizing each accessible volume, or `NULL` when no #' volumes match the supplied filters. #' #' @inheritParams options_params diff --git a/R/login_db.R b/R/login_db.R index 67b0251b..876cbf81 100644 --- a/R/login_db.R +++ b/R/login_db.R @@ -11,7 +11,7 @@ #' update stored credentials in keyring/keychain. #' @param SERVICE A character label for stored credentials in the keyring. #' Default is `org.databrary.databraryr`. -#' @param vb Show verbose messages. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' #' @returns Logical value indicating whether log in is successful or not. #' diff --git a/R/logout_db.R b/R/logout_db.R index 4cf1ea11..325f8234 100644 --- a/R/logout_db.R +++ b/R/logout_db.R @@ -5,7 +5,7 @@ NULL #' Log Out of Databrary.org. #' -#' @param rq An `httr2` request object. Defaults to NULL. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' #' @returns TRUE if logging out succeeds, FALSE otherwise. #' diff --git a/R/make_default_request.R b/R/make_default_request.R index aab67b5d..8ba8d226 100644 --- a/R/make_default_request.R +++ b/R/make_default_request.R @@ -8,6 +8,7 @@ #' Defaults to `TRUE` since all API calls now require authentication. #' @param refresh When `with_token = TRUE`, determines whether to refresh the #' cached token if it is near expiry. Defaults to `TRUE`. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' #' @returns An `httr2_request` object configured for the Databrary API. #' diff --git a/R/make_login_client.R b/R/make_login_client.R index 338a9254..1fd97438 100644 --- a/R/make_login_client.R +++ b/R/make_login_client.R @@ -9,6 +9,7 @@ NULL #' @param password Databrary password (not recommended as it will displayed as you type) #' @param store A boolean value. If TRUE store/retrieve credentials from the system keyring/keychain. #' @param overwrite A boolean value. If TRUE and store is TRUE, overwrite/ update stored credentials in keyring/keychain. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param SERVICE A character label for stored credentials in the keyring. Default is "databrary" #' @param rq An `httr2` request object. Defaults to NULL. #' diff --git a/R/search_for_funder.R b/R/search_for_funder.R index 0b0928b8..06f2cd54 100644 --- a/R/search_for_funder.R +++ b/R/search_for_funder.R @@ -5,9 +5,10 @@ NULL #' Report Information About A Funder. #' -#' @param search_string String to search. +#' @param search_string String to search. Default is "national science foundation". #' @param approved_only Logical. When TRUE (default) only approved funders are #' returned. Set to FALSE to include unapproved funders as well. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Default is NULL. #' #' @returns A data frame with information about the funder. diff --git a/R/search_for_tags.R b/R/search_for_tags.R index 873690a1..b0e72b69 100644 --- a/R/search_for_tags.R +++ b/R/search_for_tags.R @@ -6,6 +6,7 @@ NULL #' Search For Tags on Volumes or Sessions. #' #' @param search_string String to search. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Default is NULL. #' #' @returns An array of tags that match the tag_string. diff --git a/R/search_institutions.R b/R/search_institutions.R index c5b0ecc1..f5436449 100644 --- a/R/search_institutions.R +++ b/R/search_institutions.R @@ -10,6 +10,7 @@ NULL #' #' @param search_string Character string describing the institution search #' query. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @return A tibble containing matching institutions ordered by relevance, or @@ -30,31 +31,41 @@ search_institutions <- function(search_string, assertthat::assert_that(assertthat::is.string(search_string)) assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + results <- collect_paginated_get( path = API_SEARCH_INSTITUTIONS, params = list(q = search_string), rq = rq, vb = vb ) - + if (is.null(results) || length(results) == 0) { if (vb) { - message("No institutions matched the search query '", search_string, "'.") + message("No institutions matched the search query '", + search_string, + "'.") } return(NULL) } - + purrr::map_dfr(results, function(entry) { tibble::tibble( institution_id = entry$id, institution_name = entry$name, - institution_url = if (is.null(entry$url)) NA_character_ else entry$url, - institution_has_avatar = if (is.null(entry$has_avatar)) NA else entry$has_avatar, - score = if (is.null(entry$score)) NA_real_ else entry$score + institution_url = if (is.null(entry$url)) + NA_character_ + else + entry$url, + institution_has_avatar = if (is.null(entry$has_avatar)) + NA + else + entry$has_avatar, + score = if (is.null(entry$score)) + NA_real_ + else + entry$score ) }) } - - diff --git a/R/search_users.R b/R/search_users.R index 4b803304..3a5e40d3 100644 --- a/R/search_users.R +++ b/R/search_users.R @@ -9,6 +9,7 @@ NULL #' email address. #' #' @param search_string Character string describing the search query. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @return A tibble containing user matches ordered by relevance, or `NULL` diff --git a/R/search_volumes.R b/R/search_volumes.R index 16bce781..15a66d2f 100644 --- a/R/search_volumes.R +++ b/R/search_volumes.R @@ -9,6 +9,7 @@ NULL #' endpoint. #' #' @param search_string Character string describing the volume search query. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @return A tibble containing matching volumes ordered by relevance, or `NULL` diff --git a/R/whoami.R b/R/whoami.R index 16954138..b8227887 100644 --- a/R/whoami.R +++ b/R/whoami.R @@ -5,8 +5,10 @@ #' `login_db()`. #' #' @inheritParams options_params +#' #' @param refresh Whether to attempt automatic token refresh when the current #' access token is expired. Defaults to `TRUE`. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' #' @returns A list containing `auth_method` and `user` fields (both lists) or #' `NULL` if the request fails due to lack of authentication. @@ -17,22 +19,24 @@ #' whoami() #' } #' @export -whoami <- function(refresh = TRUE, vb = options::opt("vb")) { +whoami <- function(refresh = TRUE, + vb = options::opt("vb")) { assertthat::assert_that(is.logical(refresh), length(refresh) == 1) assertthat::assert_that(is.logical(vb), length(vb) == 1) - + req <- tryCatch( make_default_request(refresh = refresh, vb = vb), error = function(err) { - if (vb) message("Authentication required: ", conditionMessage(err)) + if (vb) + message("Authentication required: ", conditionMessage(err)) NULL } ) - + if (is.null(req)) { return(NULL) } - + resp <- tryCatch( req |> httr2::req_url(OAUTH_TEST_URL) |> @@ -42,22 +46,28 @@ whoami <- function(refresh = TRUE, vb = options::opt("vb")) { if (vb) { message("whoami request failed: ", conditionMessage(err)) message("whoami -> request url: ", OAUTH_TEST_URL) - message("whoami -> authorization header: ", if (!is.null(req$headers$Authorization)) req$headers$Authorization else "") + message( + "whoami -> authorization header: ", + if (!is.null(req$headers$Authorization)) + req$headers$Authorization + else + "" + ) } NULL } ) - + if (is.null(resp)) { return(NULL) } - + status <- httr2::resp_status(resp) if (status >= 400) { - if (vb) message(httr2_error_message(resp)) + if (vb) + message(httr2_error_message(resp)) return(NULL) } - + httr2::resp_body_json(resp, simplifyVector = TRUE) } - From f1865ba37433499b237d217d7c5bbc4c16c5941e Mon Sep 17 00:00:00 2001 From: rogilmore Date: Mon, 2 Feb 2026 13:08:36 -0500 Subject: [PATCH 22/77] Change parameter documentation to include more useful default values; minor edits to function documentation; add .progress parameter to some `purrr()` calls; comment-out legacy checks on rq parameter for some functions. --- R/get_db_stats.R | 35 +++++++++++++------- R/get_folder_file.R | 4 +-- R/get_session_by_id.R | 4 +-- R/get_session_by_name.R | 4 +-- R/get_session_file.R | 16 ++++----- R/get_volume_collaborator_by_id.R | 5 +-- R/list_folder_assets.R | 6 ++-- R/list_user_volumes.R | 2 +- R/list_volume_activity.R | 12 +++---- R/list_volume_assets.R | 17 +++++----- R/list_volume_collaborators.R | 2 +- R/list_volume_funding.R | 15 +++++---- R/list_volume_records.R | 15 ++++++++- R/list_volume_session_assets.R | 55 ++++++++++++++++++------------- R/list_volume_sessions.R | 4 +++ R/list_volume_tags.R | 6 ++++ R/list_volumes.R | 5 ++- 17 files changed, 128 insertions(+), 79 deletions(-) diff --git a/R/get_db_stats.R b/R/get_db_stats.R index a92ab4a5..6447ffb3 100644 --- a/R/get_db_stats.R +++ b/R/get_db_stats.R @@ -5,11 +5,11 @@ NULL #' Get Stats About Databrary. #' -#' `get_db_stats` returns basic summary information about -#' the institutions, people, and data hosted on 'Databrary.org'. +#' Returns basic summary information about +#' the institutions, people, and video data hosted on Databrary. #' #' @param type Type of Databrary report to run "institutions", "people", "data" -#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @param vb Show verbose messages. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. #' #' @returns A data frame with the requested data or NULL if there is @@ -21,8 +21,6 @@ NULL #' \donttest{ #' get_db_stats() #' get_db_stats("stats") -#' get_db_stats("people") # Information about the newest authorized investigators. -#' get_db_stats("places") # Information about the newest institutions. #' } #' @export get_db_stats <- function(type = "stats", vb = options::opt("vb"), rq = NULL) { @@ -45,6 +43,19 @@ get_db_stats <- function(type = "stats", vb = options::opt("vb"), rq = NULL) { ) ) + if (!type %in% c( + "institutions", + "people", + "researchers", + "investigators", + "data", + "stats", + "numbers" + )) { + if (vb) + message("Legacy parameter not supported in new API") + } + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) @@ -53,13 +64,13 @@ get_db_stats <- function(type = "stats", vb = options::opt("vb"), rq = NULL) { ("httr2_request" %in% class(rq)) ) - if (is.null(rq)) { - if (vb) { - message("\nNULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } + # if (is.null(rq)) { + # if (vb) { + # message("\nNULL request object. Will generate default.") + # message("Not logged in. Only public information will be returned.") + # } + # rq <- databraryr::make_default_request() + # } stats <- perform_api_get( path = API_ACTIVITY_SUMMARY, rq = rq, diff --git a/R/get_folder_file.R b/R/get_folder_file.R index bbe78442..042a011e 100644 --- a/R/get_folder_file.R +++ b/R/get_folder_file.R @@ -8,7 +8,7 @@ NULL #' @param vol_id An integer indicating the volume identifier. Default is 1. #' @param folder_id An integer indicating a valid folder identifier #' linked to a volume. Default value is 9807, the materials folder for volume 1. -#' @param file_id An integer indicating the file identifier. +#' @param file_id An integer indicating the file identifier. Default is 1. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An httr2 request object. #' @@ -28,7 +28,7 @@ NULL get_folder_file <- function(vol_id = 1, folder_id = 9807, - file_id, + file_id = 1, vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(is.numeric(vol_id)) diff --git a/R/get_session_by_id.R b/R/get_session_by_id.R index aa6980ae..b6f636d7 100644 --- a/R/get_session_by_id.R +++ b/R/get_session_by_id.R @@ -6,7 +6,7 @@ NULL #' Get Session (Slot) Data From A Databrary Volume #' #' @param session_id An integer indicating a valid session/slot identifier -#' linked to a volume. Default value is 9807, the materials folder for volume 1. +#' linked to a volume. Default value is 6256 in volume 1. #' @param vol_id An integer indicating the volume identifier. Default is 1. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An httr2 request object. @@ -25,7 +25,7 @@ NULL #' } #' @export get_session_by_id <- - function(session_id = 9807, + function(session_id = 6256, vol_id = 1, vb = options::opt("vb"), rq = NULL) { diff --git a/R/get_session_by_name.R b/R/get_session_by_name.R index 5150cbb4..80f97a2e 100644 --- a/R/get_session_by_name.R +++ b/R/get_session_by_name.R @@ -3,11 +3,11 @@ #' NULL -#' Get Session (Slot) Data From A Databrary Volume By Session Name. +#' Get Session Data From A Databrary Volume By Session Name. #' #' @param session_name A string. The name of the target session. Defaults to "Advisory #' Board Meeting", the name of several of the sessions in the public Volume 1. -#' @param vol_id An integer indicating the volume identifier. Default is 1. +#' @param vol_id Volume identifier. Must be an integer. Default is 1. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An httr2 request, such as that generated by `make_default_request()`. #' diff --git a/R/get_session_file.R b/R/get_session_file.R index 9e7e4532..35d7cd5e 100644 --- a/R/get_session_file.R +++ b/R/get_session_file.R @@ -7,28 +7,28 @@ NULL #' #' @param vol_id An integer indicating the volume identifier. Default is 1. #' @param session_id An integer indicating a valid session/slot identifier -#' linked to a volume. Default value is 9807, the materials folder for volume 1. -#' @param file_id An integer indicating the file identifier. +#' linked to a volume. Default value is 9578. +#' @param file_id An integer indicating the file identifier. The default is +#' 27227. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An httr2 request object. #' -#' @returns A JSON blob with the file data. If the user has previously logged -#' in to Databrary via `login_db()`, then files that have restricted access -#' can be downloaded, subject to the sharing release levels on those files. +#' @returns Metadata about the file if the user has read privileges. #' #' @inheritParams options_params #' #' @examples #' \donttest{ #' \dontrun{ -#' get_session_file(vol_id = 2, session_id = 11, file_id = 1) +#' get_session_file(vol_id = 2, session_id = 11, file_id = 3) +#' # A video from volume 1, session 11. #' } #' } #' @export get_session_file <- function(vol_id = 1, - session_id = 9807, - file_id, + session_id = 9578, + file_id = 27227, vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(is.numeric(vol_id)) diff --git a/R/get_volume_collaborator_by_id.R b/R/get_volume_collaborator_by_id.R index 0420dce7..64a95bff 100644 --- a/R/get_volume_collaborator_by_id.R +++ b/R/get_volume_collaborator_by_id.R @@ -10,8 +10,9 @@ NULL #' collaborator details including user information, sponsor details, access #' level, and visibility settings. #' -#' @param vol_id Target volume number. Must be a positive integer. -#' @param collaborator_id Numeric collaborator identifier. Must be a positive integer. +#' @param vol_id Target volume number. Must be a positive integer. Default is 1. +#' @param collaborator_id Numeric collaborator identifier. +#' Must be a positive integer. Default is 1. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' diff --git a/R/list_folder_assets.R b/R/list_folder_assets.R index 2ce1d87d..95d0ebe5 100644 --- a/R/list_folder_assets.R +++ b/R/list_folder_assets.R @@ -6,7 +6,7 @@ NULL #' List Assets Within a Databrary Folder. #' #' @param folder_id Folder identifier scoped to the given volume. Must be a -#' positive integer. Default is 1. +#' positive integer. Default is 9807. #' @param vol_id Volume containing the folder. Required for Django API calls. #' Must be a positive integer. Default is 1. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. @@ -24,8 +24,8 @@ NULL #' } #' } #' @export -list_folder_assets <- function(folder_id = 1, - vol_id = NULL, +list_folder_assets <- function(folder_id = 9807, + vol_id = 1, vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(length(folder_id) == 1) diff --git a/R/list_user_volumes.R b/R/list_user_volumes.R index e4448814..0b8bdc6f 100644 --- a/R/list_user_volumes.R +++ b/R/list_user_volumes.R @@ -44,7 +44,7 @@ list_user_volumes <- function(user_id = 6, vol_access_level = entry$access_level, vol_sharing_level = entry$sharing_level ) - }) %>% + }, .progress = TRUE) %>% purrr::list_rbind() %>% dplyr::mutate(user_id = user_df$id, user_prename = user_df$prename, diff --git a/R/list_volume_activity.R b/R/list_volume_activity.R index 80a36a67..1dda6da7 100644 --- a/R/list_volume_activity.R +++ b/R/list_volume_activity.R @@ -6,9 +6,9 @@ NULL #' List Activity In A Databrary Volume #' #' @description If a user has access to a volume, this command lists the modification -#' history of the volume as a +#' history of the volume. #' -#' @param vol_id Selected volume number. Must be a positive integer. Default is 1892. +#' @param vol_id Selected volume number. Must be a positive integer. Default is NULL. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to NULL. #' @@ -19,15 +19,15 @@ NULL #' @examples #' \donttest{ #' \dontrun{ -#' # The following will only return output if the user has write privileges +#' # The following will only return output if the user has *write* privileges #' # on the volume. #' -#' list_volume_activity(vol_id = 1892) # Activity on volume 1892. +#' list_volume_activity(vol_id) #' } #' } #' @export list_volume_activity <- - function(vol_id = 1892, + function(vol_id = NULL, vb = options::opt("vb"), rq = NULL) { # Check parameters @@ -104,5 +104,5 @@ list_volume_activity <- folder_id = safe_int(folder_id), deleted_at = entry$deleted_at ) - }) + }, .progress = TRUE) } diff --git a/R/list_volume_assets.R b/R/list_volume_assets.R index c7531bb2..fcb7ec04 100644 --- a/R/list_volume_assets.R +++ b/R/list_volume_assets.R @@ -31,14 +31,15 @@ list_volume_assets <- function(vol_id = 1, assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) + # Not needed for DB2 API. Delete # Handle NULL rq - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } + # if (is.null(rq)) { + # if (vb) { + # message("NULL request object. Will generate default.") + # message("Not logged in. Only public information will be returned.") + # } + # rq <- databraryr::make_default_request() + # } sessions <- collect_paginated_get( path = sprintf(API_VOLUME_SESSIONS, vol_id), @@ -87,7 +88,7 @@ list_volume_assets <- function(vol_id = 1, session_date = session$source_date, session_release = session$release_level ) - }) %>% + }, .progress = TRUE) %>% purrr::list_rbind() }) %>% purrr::list_rbind() diff --git a/R/list_volume_collaborators.R b/R/list_volume_collaborators.R index 369e9c3b..6ec9297a 100644 --- a/R/list_volume_collaborators.R +++ b/R/list_volume_collaborators.R @@ -115,5 +115,5 @@ list_volume_collaborators <- function(vol_id = 1, else entry$expiration_date ) - }) + }, .progress = TRUE) } diff --git a/R/list_volume_funding.R b/R/list_volume_funding.R index dd26495f..e28b00ac 100644 --- a/R/list_volume_funding.R +++ b/R/list_volume_funding.R @@ -42,13 +42,14 @@ list_volume_funding <- function(vol_id = 1, assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } + # Not needed for new API. Delete + # if (is.null(rq)) { + # if (vb) { + # message("NULL request object. Will generate default.") + # message("Not logged in. Only public information will be returned.") + # } + # rq <- databraryr::make_default_request() + # } if (vb) message("Summarizing funding for n=", length(vol_id), " volumes.") diff --git a/R/list_volume_records.R b/R/list_volume_records.R index 969c86b5..b99fd210 100644 --- a/R/list_volume_records.R +++ b/R/list_volume_records.R @@ -77,11 +77,24 @@ list_volume_records <- function(vol_id = 1, if (is.null(records) || length(records) == 0) { if (vb) { - message("No records found for volume ", vol_id) + message("No records found with category_id = ", + category_id, + " for volume ", + vol_id) } return(NULL) } + if (vb) + message( + "Found n = ", + length(records), + " records with category_id = ", + category_id, + " in volume ", + vol_id + ) + # Process records into tibble purrr::map_dfr(records, function(record) { # Process age if present diff --git a/R/list_volume_session_assets.R b/R/list_volume_session_assets.R index 09ff76d3..c43bc052 100644 --- a/R/list_volume_session_assets.R +++ b/R/list_volume_session_assets.R @@ -1,27 +1,27 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL #' List Assets in a Session from a Databrary volume. #' #'#' @description #' `r lifecycle::badge("experimental")` -#' +#' #' `list_volume_session_assets()` is a new name for the = 1) - + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - + assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - } - rq <- databraryr::make_default_request() - } - + + # Not needed in DB2 API. Delete. + # if (is.null(rq)) { + # if (vb) { + # message("NULL request object. Will generate default.") + # } + # rq <- databraryr::make_default_request() + # } + session <- perform_api_get( path = sprintf(API_SESSION_DETAIL, vol_id, session_id), rq = rq, vb = vb ) - + if (is.null(session)) { if (vb) message("No matching session_id: ", session_id) return(NULL) } - + files <- collect_paginated_get( path = sprintf(API_SESSION_FILES, vol_id, session_id), rq = rq, vb = vb ) - + if (is.null(files) || length(files) == 0) { if (vb) - message("No assets in session_id ", session_id) + message("No assets in vol_id ", vol_id, " session_id ", session_id) return(NULL) } - + if (vb) + message("Found n = ", + length(files), + " assets in vol_id ", + vol_id, + " session_id ", + session_id) + asset_rows <- purrr::map(files, function(file) { format <- file$format uploader <- file$uploader - + tibble::tibble( asset_id = file$id, asset_name = file$name, @@ -104,6 +113,6 @@ list_volume_session_assets <- ) }) %>% purrr::list_rbind() - + asset_rows } diff --git a/R/list_volume_sessions.R b/R/list_volume_sessions.R index d0a78ba9..1bc05527 100644 --- a/R/list_volume_sessions.R +++ b/R/list_volume_sessions.R @@ -55,6 +55,10 @@ list_volume_sessions <- message("No session data for volume ", vol_id) return(NULL) } + if (vb) message("Found n = ", + length(sessions), + " sessions in vol_id ", + vol_id) df <- purrr::map_dfr(sessions, function(session) { tibble::tibble( diff --git a/R/list_volume_tags.R b/R/list_volume_tags.R index b048bcac..ff5fe658 100644 --- a/R/list_volume_tags.R +++ b/R/list_volume_tags.R @@ -39,8 +39,14 @@ list_volume_tags <- function(vol_id = 1, ) if (is.null(tags) || length(tags) == 0) { + if (vb) + message("No tags for vol_id ", vol_id) return(NULL) } + if (vb) message("Found n = ", + length(tags), + " tags in vol_id ", + vol_id) tags } diff --git a/R/list_volumes.R b/R/list_volumes.R index 49cbf7d0..9f8be9a2 100644 --- a/R/list_volumes.R +++ b/R/list_volumes.R @@ -59,6 +59,9 @@ list_volumes <- function(search = NULL, } return(NULL) } + if (vb) message("Found n = ", + length(volumes), + " volumes that matched the supplied filters.") purrr::map_dfr(volumes, function(volume) { owner_connection <- volume$owner_connection @@ -81,7 +84,7 @@ list_volumes <- function(search = NULL, volume_owner_institution_id = if (is.null(owner_institution)) NA_integer_ else owner_institution$id, volume_owner_institution_name = if (is.null(owner_institution$name)) NA_character_ else owner_institution$name ) - }) + }, .progress = TRUE) } From 5428d052726fc6be687eaee08f800292cf36ff15 Mon Sep 17 00:00:00 2001 From: rogilmore Date: Tue, 3 Feb 2026 13:53:12 -0500 Subject: [PATCH 23/77] Minor edit to function documentation; Add verbose message. --- R/get_db_stats.R | 2 +- R/list_user_volumes.R | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/R/get_db_stats.R b/R/get_db_stats.R index 6447ffb3..979c21ef 100644 --- a/R/get_db_stats.R +++ b/R/get_db_stats.R @@ -3,7 +3,7 @@ #' NULL -#' Get Stats About Databrary. +#' Get Stats About Databrary #' #' Returns basic summary information about #' the institutions, people, and video data hosted on Databrary. diff --git a/R/list_user_volumes.R b/R/list_user_volumes.R index 0b8bdc6f..ccf2df9a 100644 --- a/R/list_user_volumes.R +++ b/R/list_user_volumes.R @@ -29,6 +29,7 @@ list_user_volumes <- function(user_id = 6, if (vb) message("No volume data for user ", user_id) return(NULL) } + if (vb) message("Found n = ", length(volumes), " volumes for user_id ", user_id, ".") user <- get_user_by_id(user_id, vb = vb, rq = rq) user_df <- tibble::as_tibble(user) From f5465a0ee4f60c4ee323274c905b5b1ae02690b5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 5 Feb 2026 10:48:09 +0100 Subject: [PATCH 24/77] fix: fix pipe and token management to download_signed_file function --- R/download_utils.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/download_utils.R b/R/download_utils.R index caea1b26..3ac4b21c 100644 --- a/R/download_utils.R +++ b/R/download_utils.R @@ -77,7 +77,11 @@ download_signed_file <- function(download_url, } assertthat::is.writeable(parent_dir) - req <- httr2::request(download_url) | + token <- require_access_token() + + req <- httr2::request(download_url) |> + httr2::req_user_agent(USER_AGENT) |> + httr2::req_headers(Authorization = paste("Bearer", token)) |> httr2::req_timeout(seconds = timeout_secs) if (vb) { From cb7e3186f0c79550f2327357bbed7a6c196600f2 Mon Sep 17 00:00:00 2001 From: rogilmore Date: Fri, 6 Feb 2026 09:35:54 -0500 Subject: [PATCH 25/77] Further mods to function docs; minor change to verbose messaging. --- R/download_folder_asset.R | 12 +++++++----- R/download_utils.R | 10 +++++----- R/get_folder_by_id.R | 9 +++++---- R/get_folder_file.R | 10 ++++++++-- tests/testthat/test-download_folder_asset.R | 3 ++- 5 files changed, 27 insertions(+), 17 deletions(-) diff --git a/R/download_folder_asset.R b/R/download_folder_asset.R index 9081a1dd..fa4b281f 100644 --- a/R/download_folder_asset.R +++ b/R/download_folder_asset.R @@ -11,8 +11,10 @@ NULL #' specified directory. #' #' @param vol_id Integer. Volume identifier containing the folder. Default is 1. -#' @param folder_id Integer. Folder identifier within the volume. Default is 1. -#' @param asset_id Integer. Asset identifier within the folder. Default is 1. +#' @param folder_id Integer. Folder identifier within the volume. Default is 9807, +#' the Materials folder for Volume 1. +#' @param asset_id Integer. Asset identifier within the folder. Default is 1, a +#' demo video called 'counting_demo_video.mp4'. #' @param file_name Optional character string. File name to use when saving the #' asset. Defaults to the API-provided file name. #' @param target_dir Character string. Directory where the file will be saved. @@ -32,15 +34,15 @@ NULL #' \donttest{ #' \dontrun{ #' download_folder_asset() # Default public asset in folder 1 of volume 1 -#' download_folder_asset(vol_id = 1, folder_id = 8460, asset_id = 19919, +#' download_folder_asset(vol_id = 1, folder_id = 9807, asset_id = 1, #' file_name = "video.mp4") #' } #' } #' #' @export download_folder_asset <- function(vol_id = 1, - folder_id = 8460, - asset_id = 19919, + folder_id = 9807, + asset_id = 1, file_name = "video.mp4", target_dir = tempdir(), timeout_secs = REQUEST_TIMEOUT, diff --git a/R/download_utils.R b/R/download_utils.R index caea1b26..74dbc968 100644 --- a/R/download_utils.R +++ b/R/download_utils.R @@ -70,6 +70,7 @@ download_signed_file <- function(download_url, assertthat::assert_that(assertthat::is.string(dest_path)) assertthat::is.number(timeout_secs) assertthat::assert_that(timeout_secs > 0) + assertthat::assert_that(length(timeout_secs == 1)) parent_dir <- dirname(dest_path) if (!dir.exists(parent_dir)) { @@ -77,16 +78,15 @@ download_signed_file <- function(download_url, } assertthat::is.writeable(parent_dir) - req <- httr2::request(download_url) | + req <- httr2::request(download_url) |> httr2::req_timeout(seconds = timeout_secs) - if (vb) { - message("Saving download to '", dest_path, "'.") - } - tryCatch( { httr2::req_perform(req, path = dest_path) + if (vb) { + message("Saving download to '", dest_path, "'.") + } dest_path }, httr2_error = function(cnd) { diff --git a/R/get_folder_by_id.R b/R/get_folder_by_id.R index 731b0082..480d12c1 100644 --- a/R/get_folder_by_id.R +++ b/R/get_folder_by_id.R @@ -3,10 +3,11 @@ #' NULL -#' Get Folder Metadata From a Databrary Volume. +#' Get Folder Metadata From a Databrary Volume #' -#' @param folder_id Folder identifier within the specified volume. -#' @param vol_id Volume identifier containing the folder. +#' @param folder_id Folder identifier within the specified volume. Default is +#' 9807, the Materials folder for Volume 1. +#' @param vol_id Volume identifier containing the folder. Default is 1. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' @@ -22,7 +23,7 @@ NULL #' } #' } #' @export -get_folder_by_id <- function(folder_id = 1, +get_folder_by_id <- function(folder_id = 9807, vol_id = 1, vb = options::opt("vb"), rq = NULL) { diff --git a/R/get_folder_file.R b/R/get_folder_file.R index 042a011e..099d9d3a 100644 --- a/R/get_folder_file.R +++ b/R/get_folder_file.R @@ -4,7 +4,12 @@ NULL #' Get Session File Data From A Databrary Volume -#' +#' +#' @description +#' Databrary volumes have folders where study or collection-wide files +#' can be stored and shared. `get_folder_file()` returns metadata about +#' specific files stored in a volume folder. +#' #' @param vol_id An integer indicating the volume identifier. Default is 1. #' @param folder_id An integer indicating a valid folder identifier #' linked to a volume. Default value is 9807, the materials folder for volume 1. @@ -21,7 +26,8 @@ NULL #' @examples #' \donttest{ #' \dontrun{ -#' get_folder_file(vol_id = 2, folder_id = 11, file_id = 1) +#' get_folder_file() # Data about file_id 1 from folder_id 9807 in Volume 1. +#' get_folder_file(vol_id = 2, folder_id = 9819, file_id = 16) # A PDF from Volume 2. #' } #' } #' @export diff --git a/tests/testthat/test-download_folder_asset.R b/tests/testthat/test-download_folder_asset.R index 279a2b6d..16ca27ac 100644 --- a/tests/testthat/test-download_folder_asset.R +++ b/tests/testthat/test-download_folder_asset.R @@ -60,7 +60,8 @@ test_that("download_folder_asset fetches signed link", { dest_path } ) - + skip_if_null_response(result, "download_folder_asset(vol_id = 1, folder_id = 2, asset_id = 3, target_dir = tmp_dir)") + expect_true(grepl("example.bin$", result)) expect_equal(result, captured_dest) expect_equal(captured_path, sprintf("/volumes/%s/folders/%s/files/%s/download-link/", 1, 2, 3)) From 1ef7701b914fd34d4abf30f729a1c1e0ad6fc04d Mon Sep 17 00:00:00 2001 From: rogilmore Date: Fri, 6 Feb 2026 11:57:37 -0500 Subject: [PATCH 26/77] Use validate_flag() throughout. --- DESCRIPTION | 4 ++- R/api_utils.R | 7 ++++ R/assign_constants.R | 2 +- R/auth_service.R | 2 ++ R/download_folder_asset.R | 3 +- R/download_folder_zip.R | 10 +++--- R/download_session_asset.R | 3 +- R/download_session_assets_fr_df.R | 8 +++-- R/download_session_csv.R | 9 +++--- R/download_session_zip.R | 9 +++--- R/download_single_folder_asset_fr_df.R | 14 +++----- R/download_single_session_asset_fr_df.R | 9 ++---- R/download_utils.R | 32 +++++++++--------- R/download_video.R | 3 +- R/download_volume_zip.R | 3 +- R/get_category_by_id.R | 6 +--- R/get_db_stats.R | 10 +----- R/get_folder_by_id.R | 3 +- R/get_folder_file.R | 3 +- R/get_funder_by_id.R | 8 ++--- R/get_institution_avatar.R | 7 +--- R/get_institution_by_id.R | 3 ++ R/get_session_by_id.R | 3 +- R/get_session_by_name.R | 3 +- R/get_session_file.R | 3 +- R/get_tag_by_id.R | 6 +--- R/get_user_avatar.R | 7 +--- R/get_user_by_id.R | 3 ++ R/get_volume_by_id.R | 3 +- R/get_volume_collaborator_by_id.R | 9 ++---- R/get_volume_record_by_id.R | 10 ++---- R/list_asset_formats.R | 3 +- R/list_authorized_investigators.R | 2 +- R/list_categories.R | 7 ++-- R/list_folder_assets.R | 3 +- R/list_institution_affiliates.R | 3 +- R/list_institutions.R | 6 +--- R/list_session_activity.R | 2 +- R/list_session_assets.R | 2 ++ R/list_user_affiliates.R | 3 +- R/list_user_history.R | 3 +- R/list_user_sponsors.R | 3 +- R/list_user_volumes.R | 1 + R/list_users.R | 7 ---- R/list_volume_activity.R | 5 +-- R/list_volume_assets.R | 13 +------- R/list_volume_collaborators.R | 3 +- R/list_volume_folders.R | 3 +- R/list_volume_funding.R | 14 ++------ R/list_volume_info.R | 3 +- R/list_volume_links.R | 3 +- R/list_volume_records.R | 7 +--- R/list_volume_session_assets.R | 11 +------ R/list_volume_sessions.R | 3 +- R/list_volume_tags.R | 3 +- R/list_volumes.R | 3 +- R/login_db.R | 4 +-- R/logout_db.R | 2 +- R/make_default_request.R | 7 ++-- R/make_login_client.R | 8 ++--- R/search_for_funder.R | 5 ++- R/search_for_tags.R | 3 +- R/search_institutions.R | 3 +- R/search_users.R | 3 +- R/search_volumes.R | 3 +- R/utils.R | 43 +++++++++++++------------ R/whoami.R | 4 +-- 67 files changed, 154 insertions(+), 252 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index dd58e65b..8b651a97 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -5,8 +5,10 @@ Version: 0.6.6.9002 Authors@R: c( person("Rick", "O. Gilmore", , "rog1@psu.edu", role = c("aut", "cre", "cph")), person("Jeffrey", "Spies", , "cran@jeffspies.com", role = "aut"), + person("Pawel", "Armatys", "pawel.armatys@montrosesoftware.com", role="aut") person("National Science Foundation OAC-2032713", role = "fnd"), - person("National Institutes of Health R01HD094830", role = "fnd") + person("National Institutes of Health R01HD094830", role = "fnd"), + person("National Science Foundation BCS 2444730, 2444731", role="fnd") ) Maintainer: Rick O. Gilmore Description: 'Databrary.org' is a restricted access repository for diff --git a/R/api_utils.R b/R/api_utils.R index 7c5787b5..ca95322f 100644 --- a/R/api_utils.R +++ b/R/api_utils.R @@ -174,3 +174,10 @@ snake_case_list <- function(obj) { } } +#' @noRd +validate_flag <- function(value, name) { + if (!is.null(value)) { + assertthat::assert_that(length(value) == 1) + assertthat::assert_that(is.logical(value), msg = paste0(name, " must be logical.")) + } +} \ No newline at end of file diff --git a/R/assign_constants.R b/R/assign_constants.R index 25360652..7ede9a2d 100644 --- a/R/assign_constants.R +++ b/R/assign_constants.R @@ -18,7 +18,7 @@ NULL #' } #' @export assign_constants <- function(vb = options::opt("vb"), rq = NULL) { - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") if (vb) { message("Retrieving grouped formats and static enums.") } diff --git a/R/auth_service.R b/R/auth_service.R index b747ca8e..100174b6 100644 --- a/R/auth_service.R +++ b/R/auth_service.R @@ -29,6 +29,7 @@ oauth_password_grant <- function(username, assertthat::assert_that(assertthat::is.string(password)) assertthat::assert_that(assertthat::is.string(client_id)) assertthat::assert_that(assertthat::is.string(client_secret)) + validate_flag(vb, "vb") req <- make_default_request(with_token = FALSE) |> httr2::req_url(OAUTH_TOKEN_URL) @@ -74,6 +75,7 @@ oauth_refresh_grant <- function(refresh_token, assertthat::assert_that(assertthat::is.string(refresh_token)) assertthat::assert_that(assertthat::is.string(client_id)) assertthat::assert_that(assertthat::is.string(client_secret)) + validate_flag(vb, "vb") req <- make_default_request() |> httr2::req_url(OAUTH_TOKEN_URL) diff --git a/R/download_folder_asset.R b/R/download_folder_asset.R index fa4b281f..30385935 100644 --- a/R/download_folder_asset.R +++ b/R/download_folder_asset.R @@ -73,8 +73,7 @@ download_folder_asset <- function(vol_id = 1, assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) diff --git a/R/download_folder_zip.R b/R/download_folder_zip.R index 4a762446..9ced2c48 100644 --- a/R/download_folder_zip.R +++ b/R/download_folder_zip.R @@ -11,8 +11,10 @@ NULL #' descriptor. When the archive is ready, Databrary emails a signed download #' link to the authenticated user. #' -#' @param vol_id Volume identifier for the folder. -#' @param folder_id Folder identifier scoped within the specified volume. +#' @param vol_id Volume identifier for the folder. Must be a positive integer. +#' Default is 1. +#' @param folder_id Folder identifier scoped within the specified volume. Must +#' be a positive integer. Default is 9807. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Default is `NULL`, in which case a #' default authenticated request is generated. @@ -25,13 +27,13 @@ NULL #' @examples #' \donttest{ #' \dontrun{ -#' download_folder_zip(vol_id = 1, folder_id = 1) +#' download_folder_zip() # Volume 1, folder 9807 #' } #' } #' #' @export download_folder_zip <- function(vol_id = 1, - folder_id = 1, + folder_id = 9807, vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(length(vol_id) == 1) diff --git a/R/download_session_asset.R b/R/download_session_asset.R index f85687c5..ba8c2578 100644 --- a/R/download_session_asset.R +++ b/R/download_session_asset.R @@ -71,8 +71,7 @@ download_session_asset <- function(vol_id = 1, assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) diff --git a/R/download_session_assets_fr_df.R b/R/download_session_assets_fr_df.R index f26cda2c..e40dece6 100644 --- a/R/download_session_assets_fr_df.R +++ b/R/download_session_assets_fr_df.R @@ -11,7 +11,8 @@ NULL #' `list_session_assets()` or `list_volume_session_assets()` output. #' #' @param session_df Data frame describing assets. Must include `vol_id`, -#' `session_id`, `asset_id`, and `asset_name` columns. +#' `session_id`, `asset_id`, and `asset_name` columns. Default is the result +#' `download_session_assets_fr_df(session_id = assets, vol_id = 1)`. #' @param target_dir Character string. Base directory for downloads. Defaults to #' `tempdir()`. #' @param add_session_subdir Logical. When `TRUE`, creates a subdirectory per @@ -33,13 +34,14 @@ NULL #' @examples #' \donttest{ #' \dontrun{ -#' assets <- list_session_assets(vol_id = 1, session_id = 9807) +#' assets <- list_session_assets(vol_id = 1, session_id = 9224) #' download_session_assets_fr_df(assets, vb = TRUE) #' } #' } #' @export download_session_assets_fr_df <- - function(session_df = list_session_assets(), + function(session_df = list_session_assets(session_id = 9224, + vol_id = 1), target_dir = tempdir(), add_session_subdir = TRUE, overwrite = TRUE, diff --git a/R/download_session_csv.R b/R/download_session_csv.R index 90db279e..818b43fd 100644 --- a/R/download_session_csv.R +++ b/R/download_session_csv.R @@ -11,9 +11,10 @@ NULL #' entire volume when `session_id` is `NULL`. The API delivers the final signed #' download link via email once the export is ready. #' -#' @param vol_id Integer. Target volume identifier. Default is 1. +#' @param vol_id Integer. Target volume identifier. Default is 2. #' @param session_id Optional integer. When provided, requests a session-level -#' CSV export. When `NULL`, a volume-level CSV export is requested. +#' CSV export. When `NULL`, a volume-level CSV export is requested. Default is +#' 9. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Default is `NULL`, meaning a default #' authenticated request is generated. @@ -27,10 +28,10 @@ NULL #' \donttest{ #' \dontrun{ #' # Request a volume-wide CSV export -#' download_session_csv(vol_id = 1) +#' download_session_csv() # CSV for default volume 2 #' #' # Request a session-specific CSV export -#' download_session_csv(vol_id = 1, session_id = 9807) +#' download_session_csv(vol_id = 2, session_id = 9) #' } #' } #' diff --git a/R/download_session_zip.R b/R/download_session_zip.R index 066b774f..3315c10c 100644 --- a/R/download_session_zip.R +++ b/R/download_session_zip.R @@ -11,8 +11,10 @@ NULL #' summary. Once the archive is ready, Databrary emails a signed download link #' to the authenticated user. #' -#' @param vol_id Volume identifier that owns the session. -#' @param session_id Session identifier within the volume. +#' @param vol_id Volume identifier that owns the session. Must be a positive +#' integer. Default is 31. +#' @param session_id Session identifier within the volume. Must be a positive +#' integer. Default is 9803. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Default is `NULL`, in which case a #' default authenticated request is generated. @@ -42,8 +44,7 @@ download_session_zip <- function(vol_id = 31, assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) diff --git a/R/download_single_folder_asset_fr_df.R b/R/download_single_folder_asset_fr_df.R index 98fc2e60..29ea5637 100644 --- a/R/download_single_folder_asset_fr_df.R +++ b/R/download_single_folder_asset_fr_df.R @@ -59,21 +59,15 @@ download_single_folder_asset_fr_df <- function(i = NULL, ) assertthat::is.writeable(target_dir) - assertthat::assert_that(length(add_folder_subdir) == 1) - assertthat::assert_that(is.logical(add_folder_subdir)) - - assertthat::assert_that(length(overwrite) == 1) - assertthat::assert_that(is.logical(overwrite)) - - assertthat::assert_that(length(make_portable_fn) == 1) - assertthat::assert_that(is.logical(make_portable_fn)) + validate_flag(add_folder_subdir, "add_folder_subdir") + validate_flag(overwrite, "overwrite") + validate_flag(make_portable_fn, "make_portable_fn") assertthat::is.number(timeout_secs) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) diff --git a/R/download_single_session_asset_fr_df.R b/R/download_single_session_asset_fr_df.R index d96fc7eb..18d84a30 100644 --- a/R/download_single_session_asset_fr_df.R +++ b/R/download_single_session_asset_fr_df.R @@ -59,11 +59,9 @@ download_single_session_asset_fr_df <- function(i = NULL, ) assertthat::is.writeable(target_dir) - assertthat::assert_that(length(add_session_subdir) == 1) - assertthat::assert_that(is.logical(add_session_subdir)) + validate_flag(add_session_subdir, "add_session_subdir") + validate_flag(overwrite, "overwrite") - assertthat::assert_that(length(overwrite) == 1) - assertthat::assert_that(is.logical(overwrite)) assertthat::assert_that(length(make_portable_fn) == 1) assertthat::assert_that(is.logical(make_portable_fn)) @@ -72,8 +70,7 @@ download_single_session_asset_fr_df <- function(i = NULL, assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) diff --git a/R/download_utils.R b/R/download_utils.R index 74dbc968..76a0449c 100644 --- a/R/download_utils.R +++ b/R/download_utils.R @@ -8,18 +8,18 @@ request_processing_task <- function(path, rq = NULL, vb = FALSE) { vb = vb, normalize = TRUE ) - + if (is.null(task)) { if (vb) { message("Cannot access requested resource on Databrary. Exiting.") } return(NULL) } - + if (vb && !is.null(task$message)) { message(task$message) } - + class(task) <- unique(c("databrary_processing_task", class(task))) task } @@ -32,21 +32,21 @@ request_signed_download_link <- function(path, rq = NULL, vb = FALSE) { vb = vb, normalize = TRUE ) - + if (is.null(link)) { if (vb) { message("Cannot access requested resource on Databrary. Exiting.") } return(NULL) } - + if (is.null(link$download_url)) { if (vb) { message("Download link payload missing 'download_url'.") } return(NULL) } - + link$download_url <- ensure_absolute_url(link$download_url) class(link) <- unique(c("databrary_signed_download", class(link))) link @@ -70,23 +70,27 @@ download_signed_file <- function(download_url, assertthat::assert_that(assertthat::is.string(dest_path)) assertthat::is.number(timeout_secs) assertthat::assert_that(timeout_secs > 0) - assertthat::assert_that(length(timeout_secs == 1)) - + parent_dir <- dirname(dest_path) if (!dir.exists(parent_dir)) { dir.create(parent_dir, recursive = TRUE, showWarnings = FALSE) } assertthat::is.writeable(parent_dir) - + + token <- require_access_token() + req <- httr2::request(download_url) |> + httr2::req_user_agent(USER_AGENT) |> + httr2::req_headers(Authorization = paste("Bearer", token)) |> httr2::req_timeout(seconds = timeout_secs) - + + if (vb) { + message("Saving download to '", dest_path, "'.") + } + tryCatch( { httr2::req_perform(req, path = dest_path) - if (vb) { - message("Saving download to '", dest_path, "'.") - } dest_path }, httr2_error = function(cnd) { @@ -97,5 +101,3 @@ download_signed_file <- function(download_url, } ) } - - diff --git a/R/download_video.R b/R/download_video.R index 471f376e..575fdf04 100644 --- a/R/download_video.R +++ b/R/download_video.R @@ -65,8 +65,7 @@ download_video <- function(vol_id = 1, ) assertthat::is.writeable(target_dir) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) diff --git a/R/download_volume_zip.R b/R/download_volume_zip.R index 89177938..30c350ac 100644 --- a/R/download_volume_zip.R +++ b/R/download_volume_zip.R @@ -36,8 +36,7 @@ download_volume_zip <- function(vol_id = 31, assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) diff --git a/R/get_category_by_id.R b/R/get_category_by_id.R index e9b02665..ebda2afb 100644 --- a/R/get_category_by_id.R +++ b/R/get_category_by_id.R @@ -32,17 +32,13 @@ NULL get_category_by_id <- function(category_id = 1, vb = options::opt("vb"), rq = NULL) { - # Validate category_id assertthat::assert_that(is.numeric(category_id)) assertthat::assert_that(length(category_id) == 1) assertthat::assert_that(category_id > 0) assertthat::assert_that(category_id == floor(category_id), msg = "category_id must be an integer") - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") - # Validate rq assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/get_db_stats.R b/R/get_db_stats.R index 979c21ef..f84d9f1f 100644 --- a/R/get_db_stats.R +++ b/R/get_db_stats.R @@ -56,21 +56,13 @@ get_db_stats <- function(type = "stats", vb = options::opt("vb"), rq = NULL) { message("Legacy parameter not supported in new API") } - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that( is.null(rq) | ("httr2_request" %in% class(rq)) ) - # if (is.null(rq)) { - # if (vb) { - # message("\nNULL request object. Will generate default.") - # message("Not logged in. Only public information will be returned.") - # } - # rq <- databraryr::make_default_request() - # } stats <- perform_api_get( path = API_ACTIVITY_SUMMARY, rq = rq, diff --git a/R/get_folder_by_id.R b/R/get_folder_by_id.R index 480d12c1..b68a2a9b 100644 --- a/R/get_folder_by_id.R +++ b/R/get_folder_by_id.R @@ -35,8 +35,7 @@ get_folder_by_id <- function(folder_id = 9807, assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/get_folder_file.R b/R/get_folder_file.R index 099d9d3a..ba8b272e 100644 --- a/R/get_folder_file.R +++ b/R/get_folder_file.R @@ -49,8 +49,7 @@ get_folder_file <- assertthat::assert_that(file_id > 0) assertthat::assert_that(length(file_id) == 1) - assertthat::assert_that(is.logical(vb)) - assertthat::assert_that(length(vb) == 1) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/get_funder_by_id.R b/R/get_funder_by_id.R index 1d46b3f1..138e6194 100644 --- a/R/get_funder_by_id.R +++ b/R/get_funder_by_id.R @@ -31,17 +31,13 @@ NULL get_funder_by_id <- function(funder_id = 1, vb = options::opt("vb"), rq = NULL) { - # Validate funder_id assertthat::assert_that(is.numeric(funder_id)) assertthat::assert_that(length(funder_id) == 1) assertthat::assert_that(funder_id > 0) assertthat::assert_that(funder_id == floor(funder_id), msg = "funder_id must be an integer") - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - # Validate rq + validate_flag(vb, "vb") + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/get_institution_avatar.R b/R/get_institution_avatar.R index 3df9ba2f..a94b7361 100644 --- a/R/get_institution_avatar.R +++ b/R/get_institution_avatar.R @@ -52,22 +52,17 @@ get_institution_avatar <- function(institution_id = 1, dest_path = NULL, vb = options::opt("vb"), rq = NULL) { - # Validate institution_id assertthat::assert_that(is.numeric(institution_id)) assertthat::assert_that(length(institution_id) == 1) assertthat::assert_that(institution_id > 0) assertthat::assert_that(institution_id == floor(institution_id), msg = "institution_id must be an integer") - # Validate dest_path if (!is.null(dest_path)) { assertthat::assert_that(assertthat::is.string(dest_path)) } - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") - # Validate rq assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/get_institution_by_id.R b/R/get_institution_by_id.R index 49c69653..cfe60e8d 100644 --- a/R/get_institution_by_id.R +++ b/R/get_institution_by_id.R @@ -15,6 +15,9 @@ get_institution_by_id <- function(institution_id = 12, vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(is.numeric(institution_id), length(institution_id) == 1, institution_id > 0) + + validate_flag(vb, "vb") + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) institution <- perform_api_get( diff --git a/R/get_session_by_id.R b/R/get_session_by_id.R index b6f636d7..e7d7d1cb 100644 --- a/R/get_session_by_id.R +++ b/R/get_session_by_id.R @@ -38,8 +38,7 @@ get_session_by_id <- assertthat::assert_that(vol_id > 0) assertthat::assert_that(length(vol_id) == 1) - assertthat::assert_that(is.logical(vb)) - assertthat::assert_that(length(vb) == 1) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/get_session_by_name.R b/R/get_session_by_name.R index 80f97a2e..6a348a3e 100644 --- a/R/get_session_by_name.R +++ b/R/get_session_by_name.R @@ -39,8 +39,7 @@ get_session_by_name <- assertthat::assert_that(vol_id > 0) assertthat::assert_that(length(vol_id) == 1) - assertthat::assert_that(is.logical(vb)) - assertthat::assert_that(length(vb) == 1) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/get_session_file.R b/R/get_session_file.R index 35d7cd5e..cb4fc389 100644 --- a/R/get_session_file.R +++ b/R/get_session_file.R @@ -43,8 +43,7 @@ get_session_file <- assertthat::assert_that(file_id > 0) assertthat::assert_that(length(file_id) == 1) - assertthat::assert_that(is.logical(vb)) - assertthat::assert_that(length(vb) == 1) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/get_tag_by_id.R b/R/get_tag_by_id.R index 92fd8afa..4044c698 100644 --- a/R/get_tag_by_id.R +++ b/R/get_tag_by_id.R @@ -31,17 +31,13 @@ NULL get_tag_by_id <- function(tag_id = 1, vb = options::opt("vb"), rq = NULL) { - # Validate tag_id assertthat::assert_that(is.numeric(tag_id)) assertthat::assert_that(length(tag_id) == 1) assertthat::assert_that(tag_id > 0) assertthat::assert_that(tag_id == floor(tag_id), msg = "tag_id must be an integer") - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") - # Validate rq assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/get_user_avatar.R b/R/get_user_avatar.R index eaa84f98..e7f555d9 100644 --- a/R/get_user_avatar.R +++ b/R/get_user_avatar.R @@ -44,22 +44,17 @@ get_user_avatar <- function(user_id, dest_path = NULL, vb = options::opt("vb"), rq = NULL) { - # Validate user_id assertthat::assert_that(length(user_id) == 1) assertthat::assert_that(is.numeric(user_id) || is.integer(user_id)) assertthat::assert_that(user_id > 0) - # Validate dest_path if (!is.null(dest_path)) { assertthat::assert_that(assertthat::is.string(dest_path)) } - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") - # Validate rq assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/get_user_by_id.R b/R/get_user_by_id.R index f5455c9e..d200c133 100644 --- a/R/get_user_by_id.R +++ b/R/get_user_by_id.R @@ -15,6 +15,9 @@ get_user_by_id <- function(user_id = 6, vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(is.numeric(user_id), length(user_id) == 1, user_id > 0) + + validate_flag(vb, "vb") + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/get_volume_by_id.R b/R/get_volume_by_id.R index 94b11352..78196edf 100644 --- a/R/get_volume_by_id.R +++ b/R/get_volume_by_id.R @@ -28,8 +28,7 @@ get_volume_by_id <- function(vol_id = 1, assertthat::assert_that(vol_id > 0) assertthat::assert_that(length(vol_id) == 1) - assertthat::assert_that(is.logical(vb)) - assertthat::assert_that(length(vb) == 1) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) diff --git a/R/get_volume_collaborator_by_id.R b/R/get_volume_collaborator_by_id.R index 64a95bff..452b26db 100644 --- a/R/get_volume_collaborator_by_id.R +++ b/R/get_volume_collaborator_by_id.R @@ -38,23 +38,18 @@ get_volume_collaborator_by_id <- function(vol_id = 1, collaborator_id = 1, vb = options::opt("vb"), rq = NULL) { - # Validate vol_id assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(vol_id >= 1) assertthat::assert_that(vol_id == floor(vol_id), msg = "vol_id must be an integer") - # Validate collaborator_id assertthat::assert_that(is.numeric(collaborator_id)) assertthat::assert_that(length(collaborator_id) == 1) assertthat::assert_that(collaborator_id > 0) assertthat::assert_that(collaborator_id == floor(collaborator_id), msg = "collaborator_id must be an integer") - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - # Validate rq + validate_flag(vb, "vb") + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/get_volume_record_by_id.R b/R/get_volume_record_by_id.R index aadf2447..18cf7c24 100644 --- a/R/get_volume_record_by_id.R +++ b/R/get_volume_record_by_id.R @@ -36,9 +36,7 @@ get_volume_record_by_id <- function( vol_id = 1, record_id = 1, vb = options::opt("vb"), - rq = NULL -) { - # Validate vol_id + rq = NULL) { assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(vol_id >= 1) @@ -47,7 +45,6 @@ get_volume_record_by_id <- function( msg = "vol_id must be an integer" ) - # Validate record_id assertthat::assert_that(is.numeric(record_id)) assertthat::assert_that(length(record_id) == 1) assertthat::assert_that(record_id > 0) @@ -56,11 +53,8 @@ get_volume_record_by_id <- function( msg = "record_id must be an integer" ) - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") - # Validate rq assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) # Perform API call diff --git a/R/list_asset_formats.R b/R/list_asset_formats.R index 6c2ec3db..ce2fda06 100644 --- a/R/list_asset_formats.R +++ b/R/list_asset_formats.R @@ -21,8 +21,7 @@ NULL #' @export list_asset_formats <- function(vb = options::opt("vb")) { # Check parameters - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") db_constants <- databraryr::assign_constants() diff --git a/R/list_authorized_investigators.R b/R/list_authorized_investigators.R index 85d96982..3992ded3 100644 --- a/R/list_authorized_investigators.R +++ b/R/list_authorized_investigators.R @@ -21,7 +21,7 @@ list_authorized_investigators <- function(institution_id = 12, assertthat::assert_that(is.numeric(institution_id), length(institution_id) == 1, institution_id > 0) - assertthat::assert_that(is.logical(vb), length(vb) == 1) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/list_categories.R b/R/list_categories.R index 603a95a1..b0c67f51 100644 --- a/R/list_categories.R +++ b/R/list_categories.R @@ -29,11 +29,8 @@ NULL #' } #' @export list_categories <- function(vb = options::opt("vb"), rq = NULL) { - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - # Validate rq + validate_flag(vb, "vb") + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/list_folder_assets.R b/R/list_folder_assets.R index 95d0ebe5..e37c643f 100644 --- a/R/list_folder_assets.R +++ b/R/list_folder_assets.R @@ -43,8 +43,7 @@ list_folder_assets <- function(folder_id = 9807, assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/list_institution_affiliates.R b/R/list_institution_affiliates.R index a05508b6..ff8afe19 100644 --- a/R/list_institution_affiliates.R +++ b/R/list_institution_affiliates.R @@ -20,8 +20,7 @@ list_institution_affiliates <- function(institution_id = 12, length(institution_id) == 1, institution_id > 0) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/list_institutions.R b/R/list_institutions.R index e6854a46..7eab34c5 100644 --- a/R/list_institutions.R +++ b/R/list_institutions.R @@ -37,16 +37,12 @@ NULL list_institutions <- function(search_string = NULL, vb = options::opt("vb"), rq = NULL) { - # Validate search_string if (!is.null(search_string)) { assertthat::assert_that(assertthat::is.string(search_string)) } - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") - # Validate rq assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/list_session_activity.R b/R/list_session_activity.R index 2e761f9f..f1a9cf12 100644 --- a/R/list_session_activity.R +++ b/R/list_session_activity.R @@ -42,7 +42,7 @@ list_session_activity <- assertthat::assert_that(session_id > 0) assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/list_session_assets.R b/R/list_session_assets.R index af1b4c52..1a5d0c71 100644 --- a/R/list_session_assets.R +++ b/R/list_session_assets.R @@ -47,6 +47,8 @@ list_session_assets <- function(session_id = 9807, assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) + validate_flag(vb, "vb") + assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) diff --git a/R/list_user_affiliates.R b/R/list_user_affiliates.R index 4550aded..f8c84af9 100644 --- a/R/list_user_affiliates.R +++ b/R/list_user_affiliates.R @@ -19,8 +19,7 @@ list_user_affiliates <- function(user_id = 6, assertthat::assert_that(is.numeric(user_id), length(user_id) == 1, user_id > 0) assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/list_user_history.R b/R/list_user_history.R index c1f8721e..a132ff55 100644 --- a/R/list_user_history.R +++ b/R/list_user_history.R @@ -32,8 +32,7 @@ list_user_history <- function(user_id = 22582, assertthat::assert_that(length(user_id) == 1) assertthat::assert_that(user_id > 0) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/list_user_sponsors.R b/R/list_user_sponsors.R index fae5445e..012232a9 100644 --- a/R/list_user_sponsors.R +++ b/R/list_user_sponsors.R @@ -17,8 +17,7 @@ list_user_sponsors <- function(user_id = 6, assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/list_user_volumes.R b/R/list_user_volumes.R index ccf2df9a..33124e87 100644 --- a/R/list_user_volumes.R +++ b/R/list_user_volumes.R @@ -17,6 +17,7 @@ list_user_volumes <- function(user_id = 6, vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(is.numeric(user_id), length(user_id) == 1, user_id > 0) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) volumes <- collect_paginated_get( diff --git a/R/list_users.R b/R/list_users.R index 1a35ab9a..86fbf48a 100644 --- a/R/list_users.R +++ b/R/list_users.R @@ -45,13 +45,6 @@ list_users <- function(search = NULL, assertthat::assert_that(assertthat::is.string(search)) } - validate_flag <- function(value, name) { - if (!is.null(value)) { - assertthat::assert_that(length(value) == 1) - assertthat::assert_that(is.logical(value), msg = paste0(name, " must be logical.")) - } - } - validate_flag(include_suspended, "include_suspended") validate_flag(exclude_self, "exclude_self") validate_flag(is_authorized_investigator, "is_authorized_investigator") diff --git a/R/list_volume_activity.R b/R/list_volume_activity.R index 1dda6da7..04a896ac 100644 --- a/R/list_volume_activity.R +++ b/R/list_volume_activity.R @@ -35,8 +35,9 @@ list_volume_activity <- assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") + + validate_flag(vb, "vb") if (vb) message('list_volume_activity()...') diff --git a/R/list_volume_assets.R b/R/list_volume_assets.R index fcb7ec04..68a92e0b 100644 --- a/R/list_volume_assets.R +++ b/R/list_volume_assets.R @@ -28,18 +28,7 @@ list_volume_assets <- function(vol_id = 1, assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - # Not needed for DB2 API. Delete - # Handle NULL rq - # if (is.null(rq)) { - # if (vb) { - # message("NULL request object. Will generate default.") - # message("Not logged in. Only public information will be returned.") - # } - # rq <- databraryr::make_default_request() - # } + validate_flag(vb, "vb") sessions <- collect_paginated_get( path = sprintf(API_VOLUME_SESSIONS, vol_id), diff --git a/R/list_volume_collaborators.R b/R/list_volume_collaborators.R index 6ec9297a..451c6e38 100644 --- a/R/list_volume_collaborators.R +++ b/R/list_volume_collaborators.R @@ -31,8 +31,7 @@ list_volume_collaborators <- function(vol_id = 1, assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/list_volume_folders.R b/R/list_volume_folders.R index 52a66ca3..00d3f184 100644 --- a/R/list_volume_folders.R +++ b/R/list_volume_folders.R @@ -28,8 +28,7 @@ list_volume_folders <- function(vol_id = 1, assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/list_volume_funding.R b/R/list_volume_funding.R index e28b00ac..4155ff41 100644 --- a/R/list_volume_funding.R +++ b/R/list_volume_funding.R @@ -36,21 +36,11 @@ list_volume_funding <- function(vol_id = 1, assertthat::assert_that(length(add_id) == 1) assertthat::assert_that(is.logical(add_id)) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - - # Not needed for new API. Delete - # if (is.null(rq)) { - # if (vb) { - # message("NULL request object. Will generate default.") - # message("Not logged in. Only public information will be returned.") - # } - # rq <- databraryr::make_default_request() - # } - + if (vb) message("Summarizing funding for n=", length(vol_id), " volumes.") diff --git a/R/list_volume_info.R b/R/list_volume_info.R index 3f24b0a2..8db32a45 100644 --- a/R/list_volume_info.R +++ b/R/list_volume_info.R @@ -32,8 +32,7 @@ list_volume_info <- assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) diff --git a/R/list_volume_links.R b/R/list_volume_links.R index 07e5b715..d243b44b 100644 --- a/R/list_volume_links.R +++ b/R/list_volume_links.R @@ -28,8 +28,7 @@ list_volume_links <- function(vol_id = 1, assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") links <- perform_api_get( path = sprintf(API_VOLUME_LINKS, vol_id), diff --git a/R/list_volume_records.R b/R/list_volume_records.R index b99fd210..27f7ce31 100644 --- a/R/list_volume_records.R +++ b/R/list_volume_records.R @@ -39,13 +39,11 @@ list_volume_records <- function(vol_id = 1, category_id = NULL, vb = options::opt("vb"), rq = NULL) { - # Validate vol_id assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) assertthat::assert_that(vol_id == floor(vol_id), msg = "vol_id must be an integer") - # Validate category_id if (!is.null(category_id)) { assertthat::assert_that(length(category_id) == 1) assertthat::assert_that(is.numeric(category_id)) @@ -53,11 +51,8 @@ list_volume_records <- function(vol_id = 1, assertthat::assert_that(category_id == floor(category_id), msg = "category_id must be an integer") } - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") - # Validate rq assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/list_volume_session_assets.R b/R/list_volume_session_assets.R index c43bc052..7ade992b 100644 --- a/R/list_volume_session_assets.R +++ b/R/list_volume_session_assets.R @@ -42,20 +42,11 @@ list_volume_session_assets <- assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - # Not needed in DB2 API. Delete. - # if (is.null(rq)) { - # if (vb) { - # message("NULL request object. Will generate default.") - # } - # rq <- databraryr::make_default_request() - # } - session <- perform_api_get( path = sprintf(API_SESSION_DETAIL, vol_id, session_id), rq = rq, diff --git a/R/list_volume_sessions.R b/R/list_volume_sessions.R index 1bc05527..3c132991 100644 --- a/R/list_volume_sessions.R +++ b/R/list_volume_sessions.R @@ -37,8 +37,7 @@ list_volume_sessions <- assertthat::assert_that(is.logical(include_vol_data)) assertthat::assert_that(length(include_vol_data) == 1) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) diff --git a/R/list_volume_tags.R b/R/list_volume_tags.R index ff5fe658..a1a325fd 100644 --- a/R/list_volume_tags.R +++ b/R/list_volume_tags.R @@ -26,8 +26,7 @@ list_volume_tags <- function(vol_id = 1, assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) diff --git a/R/list_volumes.R b/R/list_volumes.R index 9f8be9a2..11d23b60 100644 --- a/R/list_volumes.R +++ b/R/list_volumes.R @@ -38,8 +38,7 @@ list_volumes <- function(search = NULL, assertthat::assert_that(assertthat::is.string(ordering)) } - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/login_db.R b/R/login_db.R index 876cbf81..71b33ce4 100644 --- a/R/login_db.R +++ b/R/login_db.R @@ -36,8 +36,8 @@ login_db <- function(email = NULL, SERVICE = KEYRING_SERVICE, vb = options::opt("vb")) { assertthat::assert_that(length(store) == 1, is.logical(store)) - assertthat::assert_that(length(overwrite) == 1, is.logical(overwrite)) - assertthat::assert_that(length(vb) == 1, is.logical(vb)) + validate_flag(overwrite, "overwrite") + validate_flag(vb, "vb") assertthat::assert_that(length(SERVICE) == 1, is.character(SERVICE)) # If the user wants to store or use their stored credentials, diff --git a/R/logout_db.R b/R/logout_db.R index 325f8234..cd0d42e5 100644 --- a/R/logout_db.R +++ b/R/logout_db.R @@ -17,7 +17,7 @@ NULL #' } #' @export logout_db <- function(vb = options::opt("vb")) { - assertthat::assert_that(is.logical(vb), length(vb) == 1) + validate_flag(vb, "vb") bundle <- get_token_bundle() if (is.null(bundle)) { diff --git a/R/make_default_request.R b/R/make_default_request.R index 8ba8d226..428d061a 100644 --- a/R/make_default_request.R +++ b/R/make_default_request.R @@ -18,9 +18,10 @@ make_default_request <- function(with_token = TRUE, refresh = TRUE, vb = options::opt("vb")) { - assertthat::assert_that(is.logical(with_token), length(with_token) == 1) - assertthat::assert_that(is.logical(refresh), length(refresh) == 1) - assertthat::assert_that(is.logical(vb), length(vb) == 1) + + validate_flag(with_token, "with_token") + validate_flag(refresh, "refresh") + validate_flag(vb, "vb") req <- httr2::request(DATABRARY_BASE_URL) |> httr2::req_user_agent(USER_AGENT) |> diff --git a/R/make_login_client.R b/R/make_login_client.R index 1fd97438..6dfc20d4 100644 --- a/R/make_login_client.R +++ b/R/make_login_client.R @@ -41,11 +41,9 @@ make_login_client <- function(email = NULL, assertthat::assert_that(length(store) == 1) assertthat::assert_that(is.logical(store)) - assertthat::assert_that(length(overwrite) == 1) - assertthat::assert_that(is.logical(overwrite)) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(store, "store") + validate_flag(overwrite, "overwrite") + validate_flag(vb, "vb") assertthat::assert_that(length(SERVICE) == 1) assertthat::assert_that(is.character(SERVICE)) diff --git a/R/search_for_funder.R b/R/search_for_funder.R index 06f2cd54..622a76da 100644 --- a/R/search_for_funder.R +++ b/R/search_for_funder.R @@ -31,9 +31,8 @@ search_for_funder <- search_string <- gsub("[+]", " ", search_string) pattern <- stringr::str_trim(search_string) - assertthat::assert_that(is.logical(approved_only), length(approved_only) == 1) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(approved_only, "approved_only") + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) diff --git a/R/search_for_tags.R b/R/search_for_tags.R index b0e72b69..f08705e3 100644 --- a/R/search_for_tags.R +++ b/R/search_for_tags.R @@ -27,8 +27,7 @@ search_for_tags <- assertthat::assert_that(length(search_string) == 1) assertthat::assert_that(is.character(search_string)) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) diff --git a/R/search_institutions.R b/R/search_institutions.R index f5436449..8bb9abee 100644 --- a/R/search_institutions.R +++ b/R/search_institutions.R @@ -29,8 +29,7 @@ search_institutions <- function(search_string, vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(assertthat::is.string(search_string)) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) diff --git a/R/search_users.R b/R/search_users.R index 3a5e40d3..79b228eb 100644 --- a/R/search_users.R +++ b/R/search_users.R @@ -28,8 +28,7 @@ search_users <- function(search_string, vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(assertthat::is.string(search_string)) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) results <- collect_paginated_get( diff --git a/R/search_volumes.R b/R/search_volumes.R index 15a66d2f..1c1d67fb 100644 --- a/R/search_volumes.R +++ b/R/search_volumes.R @@ -28,8 +28,7 @@ search_volumes <- function(search_string, vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(assertthat::is.string(search_string)) - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) results <- collect_paginated_get( diff --git a/R/utils.R b/R/utils.R index e1e1059f..c2723162 100644 --- a/R/utils.R +++ b/R/utils.R @@ -8,7 +8,7 @@ #' NULL - + #---------------------------------------------------------------------------- #' Extract Databrary Permission Levels. #' @@ -23,10 +23,11 @@ NULL #' #' @export get_permission_levels <- function(vb = options::opt("vb")) { + validate_flag(vb, "vb") enums <- get_permission_levels_enums() enums$volume_access_levels } - + #---------------------------------------------------------------------------- #' Convert Timestamp String To ms. #' @@ -43,11 +44,10 @@ HHMMSSmmm_to_ms <- function(HHMMSSmmm = "01:01:01:333") { stop("HHMMSSmmm must be a string.") } - if (stringr::str_detect(HHMMSSmmm, - "([0-9]{2}):([0-9]{2}):([0-9]{2}):([0-9]{3})")) { + if (stringr::str_detect(HHMMSSmmm, "([0-9]{2}):([0-9]{2}):([0-9]{2}):([0-9]{3})")) { time_segs <- stringr::str_match(HHMMSSmmm, "([0-9]{2}):([0-9]{2}):([0-9]{2}):([0-9]{3})") - as.numeric(time_segs[5]) + as.numeric(time_segs[4]) * + as.numeric(time_segs[5]) + as.numeric(time_segs[4]) * 1000 + as.numeric(time_segs[3]) * 1000 * 60 + as.numeric(time_segs[2]) * 1000 * 60 * 60 } else { @@ -69,8 +69,10 @@ HHMMSSmmm_to_ms <- function(HHMMSSmmm = "01:01:01:333") { #' #' @export get_release_levels <- function(vb = options::opt("vb")) { -enums <- get_release_levels_enums() -vapply(enums$levels, function(item) item$code, character(1)) + validate_flag(vb, "vb") + enums <- get_release_levels_enums() + vapply(enums$levels, function(item) + item$code, character(1)) } #---------------------------------------------------------------------------- @@ -88,13 +90,14 @@ vapply(enums$levels, function(item) item$code, character(1)) #' #' @export get_supported_file_types <- function(vb = options::opt("vb")) { -constants <- assign_constants(vb = vb) -constants$format_df |> - dplyr::rename( - asset_type = name, - asset_type_id = id, - asset_category = category - ) + validate_flag(vb, "vb") + constants <- assign_constants(vb = vb) + constants$format_df |> + dplyr::rename( + asset_type = name, + asset_type_id = id, + asset_category = category + ) } #---------------------------------------------------------------------------- @@ -103,7 +106,7 @@ constants$format_df |> #' @param fn Databrary party ID #' @param replace_regex A character string. A regular expression to capture #' the "non-portable" characters in fn. -#' @param replacement_char A character string. The character(s) that will +#' @param replacement_char A character string. The character(s) that will #' replace the non-portable characters. #' #' @returns A "cleaned" portable file name @@ -111,16 +114,15 @@ constants$format_df |> #' @inheritParams options_params #' make_fn_portable <- function(fn, - vb = options::opt("vb"), - replace_regex = "[ &\\!\\)\\(\\}\\{\\[\\]\\+\\=@#\\$%\\^\\*]", - replacement_char = "_") { + vb = options::opt("vb"), + replace_regex = "[ &\\!\\)\\(\\}\\{\\[\\]\\+\\=@#\\$%\\^\\*]", + replacement_char = "_") { assertthat::is.string(fn) assertthat::assert_that(!is.numeric(fn)) assertthat::assert_that(!is.logical(fn)) assertthat::assert_that(length(fn) == 1) - assertthat::assert_that(is.logical(vb)) - assertthat::assert_that(length(vb) == 1) + validate_flag(vb, "vb") assertthat::is.string(replace_regex) assertthat::assert_that(length(replace_regex) == 1) @@ -135,4 +137,3 @@ make_fn_portable <- function(fn, new_fn <- stringr::str_replace_all(fn, replace_regex, replacement_char) new_fn } - \ No newline at end of file diff --git a/R/whoami.R b/R/whoami.R index b8227887..7647f3e4 100644 --- a/R/whoami.R +++ b/R/whoami.R @@ -21,8 +21,8 @@ #' @export whoami <- function(refresh = TRUE, vb = options::opt("vb")) { - assertthat::assert_that(is.logical(refresh), length(refresh) == 1) - assertthat::assert_that(is.logical(vb), length(vb) == 1) + validate_flag(refresh, "refresh") + validate_flag(vb, "vb") req <- tryCatch( make_default_request(refresh = refresh, vb = vb), From 5a61dc44370d78a34b2f79d31a0a81488c3ad79f Mon Sep 17 00:00:00 2001 From: rogilmore Date: Fri, 6 Feb 2026 12:02:17 -0500 Subject: [PATCH 27/77] Bump version; add Pawel as author; add NSF HNDS-I grant to DESCRIPTION. --- DESCRIPTION | 2 +- NEWS.md | 6 +++++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8b651a97..3645964e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: databraryr Title: Interact with the 'Databrary.org' API -Version: 0.6.6.9002 +Version: 1.0.0.9000 Authors@R: c( person("Rick", "O. Gilmore", , "rog1@psu.edu", role = c("aut", "cre", "cph")), person("Jeffrey", "Spies", , "cran@jeffspies.com", role = "aut"), diff --git a/NEWS.md b/NEWS.md index bfc017d1..0d3bc7d5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,8 @@ -# databraryr (development version) +# databraryr 1.0.0 + +## Major changes + +- Adapted all package functions to Databrary 2.0 API. # databraryr 0.6.6 From fc6ac6c5e3b680737cb549a5ec3ae05d91fdb5c7 Mon Sep 17 00:00:00 2001 From: rogilmore Date: Fri, 6 Feb 2026 13:30:21 -0500 Subject: [PATCH 28/77] Fix typo in DESCRIPTION. --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3645964e..d68b1a78 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -5,7 +5,7 @@ Version: 1.0.0.9000 Authors@R: c( person("Rick", "O. Gilmore", , "rog1@psu.edu", role = c("aut", "cre", "cph")), person("Jeffrey", "Spies", , "cran@jeffspies.com", role = "aut"), - person("Pawel", "Armatys", "pawel.armatys@montrosesoftware.com", role="aut") + person("Pawel", "Armatys", "pawel.armatys@montrosesoftware.com", role="aut"), person("National Science Foundation OAC-2032713", role = "fnd"), person("National Institutes of Health R01HD094830", role = "fnd"), person("National Science Foundation BCS 2444730, 2444731", role="fnd") From 7f5724c20b6974ec17e8204e76013b5cb88e3038 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Tue, 10 Feb 2026 12:06:35 +0100 Subject: [PATCH 29/77] feat: add functions for managing records in Databrary volume --- NAMESPACE | 7 + R/CONSTANTS.R | 6 +- R/api_utils.R | 116 ++++++++ R/assign_record_to_file.R | 115 ++++++++ R/create_volume_record.R | 267 ++++++++++++++++++ R/delete_record_measure.R | 103 +++++++ R/delete_volume_record.R | 82 ++++++ R/list_volume_records.R | 31 +- R/set_record_measure.R | 128 +++++++++ R/unassign_record_from_file.R | 112 ++++++++ R/update_volume_record.R | 146 ++++++++++ man/assign_record_to_file.Rd | 50 ++++ man/create_volume_record.Rd | 81 ++++++ man/delete_record_measure.Rd | 53 ++++ man/delete_volume_record.Rd | 37 +++ man/list_volume_records.Rd | 5 +- man/set_record_measure.Rd | 67 +++++ man/unassign_record_from_file.Rd | 49 ++++ man/update_volume_record.Rd | 63 +++++ tests/testthat/helper-auth.R | 1 - tests/testthat/test-assign_record_to_file.R | 165 +++++++++++ tests/testthat/test-create_volume_record.R | 187 ++++++++++++ tests/testthat/test-delete_record_measure.R | 154 ++++++++++ tests/testthat/test-delete_volume_record.R | 128 +++++++++ tests/testthat/test-get_volume_record_by_id.R | 136 ++++----- tests/testthat/test-list_volume_records.R | 76 ++--- tests/testthat/test-set_record_measure.R | 170 +++++++++++ .../testthat/test-unassign_record_from_file.R | 199 +++++++++++++ tests/testthat/test-update_volume_record.R | 109 +++++++ 29 files changed, 2730 insertions(+), 113 deletions(-) create mode 100644 R/assign_record_to_file.R create mode 100644 R/create_volume_record.R create mode 100644 R/delete_record_measure.R create mode 100644 R/delete_volume_record.R create mode 100644 R/set_record_measure.R create mode 100644 R/unassign_record_from_file.R create mode 100644 R/update_volume_record.R create mode 100644 man/assign_record_to_file.Rd create mode 100644 man/create_volume_record.Rd create mode 100644 man/delete_record_measure.Rd create mode 100644 man/delete_volume_record.Rd create mode 100644 man/set_record_measure.Rd create mode 100644 man/unassign_record_from_file.Rd create mode 100644 man/update_volume_record.Rd create mode 100644 tests/testthat/test-assign_record_to_file.R create mode 100644 tests/testthat/test-create_volume_record.R create mode 100644 tests/testthat/test-delete_record_measure.R create mode 100644 tests/testthat/test-delete_volume_record.R create mode 100644 tests/testthat/test-set_record_measure.R create mode 100644 tests/testthat/test-unassign_record_from_file.R create mode 100644 tests/testthat/test-update_volume_record.R diff --git a/NAMESPACE b/NAMESPACE index a406a9d6..058d1767 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,7 +3,11 @@ export("%>%") export(HHMMSSmmm_to_ms) export(assign_constants) +export(assign_record_to_file) export(check_ssl_certs) +export(create_volume_record) +export(delete_record_measure) +export(delete_volume_record) export(download_folder_asset) export(download_folder_assets_fr_df) export(download_folder_zip) @@ -68,6 +72,9 @@ export(search_for_tags) export(search_institutions) export(search_users) export(search_volumes) +export(set_record_measure) +export(unassign_record_from_file) +export(update_volume_record) export(whoami) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index ec0a15e7..5e36ec0b 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -28,9 +28,12 @@ API_VOLUME_SESSIONS <- "/volumes/%s/sessions/" API_VOLUME_FOLDERS <- "/volumes/%s/folders/" API_VOLUME_RECORDS <- "/volumes/%s/records/" API_VOLUME_RECORD_DETAIL <- "/volumes/%s/records/%s/" +API_RECORD_MEASURES <- "/volumes/%s/records/%s/measures/%s/" API_SESSION_DETAIL <- "/volumes/%s/sessions/%s/" API_SESSION_FILES <- "/volumes/%s/sessions/%s/files/" API_SESSION_FILE_DETAIL <- "/volumes/%s/sessions/%s/files/%s/" +API_SESSION_FILE_ASSIGN <- "/volumes/%s/sessions/%s/files/%s/assign-record/" +API_SESSION_FILE_UNASSIGN <- "/volumes/%s/sessions/%s/files/%s/unassign-record/" API_FILES_DOWNLOAD_LINK <- "/volumes/%s/sessions/%s/files/%s/download-link/" API_SESSION_DOWNLOAD_LINK <- "/volumes/%s/sessions/%s/download-link/" API_SESSION_CSV_DOWNLOAD_LINK <- "/volumes/%s/sessions/%s/csv-download-link/" @@ -60,5 +63,6 @@ REQUEST_TIMEOUT_VERY_LONG <- 600 OAUTH_TOKEN_URL <- sprintf("%s/o/token/", DATABRARY_BASE_URL) OAUTH_TEST_URL <- sprintf("%s/oauth2/test/", DATABRARY_BASE_URL) -USER_AGENT <- Sys.getenv("USER_AGENT", "SRW$*Kxy2nYdyo4LozoGV#i6LvH/") +USER_AGENT <- paste0("databraryr/", as.character(utils::packageVersion("databraryr"))) + KEYRING_SERVICE <- 'org.databrary.databraryr' diff --git a/R/api_utils.R b/R/api_utils.R index 7c5787b5..7f1dc8e7 100644 --- a/R/api_utils.R +++ b/R/api_utils.R @@ -174,3 +174,119 @@ snake_case_list <- function(obj) { } } +#' @noRd +perform_api_post <- function(path, + body = list(), + rq = NULL, + vb = FALSE, + normalize = TRUE) { + request <- rq + if (is.null(request)) { + request <- databraryr::make_default_request() + } + + url <- paste0(DATABRARY_BASE_URL, ensure_leading_slash(path)) + request <- httr2::req_url(request, url) + request <- httr2::req_method(request, "POST") + + if (!is.null(body) && length(body) > 0) { + request <- httr2::req_body_json(request, body) + } + + response <- tryCatch( + httr2::req_perform(request), + httr2_error = function(cnd) { + if (vb) { + message("POST request failed for ", url, ": ", conditionMessage(cnd)) + } + NULL + } + ) + + if (is.null(response)) { + return(NULL) + } + + status <- httr2::resp_status(response) + if (status == 204L) { + return(TRUE) + } + + payload <- httr2::resp_body_json(response) + if (isTRUE(normalize)) { + payload <- snake_case_list(payload) + } + payload +} + +#' @noRd +perform_api_patch <- function(path, + body = list(), + rq = NULL, + vb = FALSE, + normalize = TRUE) { + request <- rq + if (is.null(request)) { + request <- databraryr::make_default_request() + } + + url <- paste0(DATABRARY_BASE_URL, ensure_leading_slash(path)) + request <- httr2::req_url(request, url) + request <- httr2::req_method(request, "PATCH") + + if (!is.null(body) && length(body) > 0) { + request <- httr2::req_body_json(request, body) + } + + response <- tryCatch( + httr2::req_perform(request), + httr2_error = function(cnd) { + if (vb) { + message("PATCH request failed for ", url, ": ", conditionMessage(cnd)) + } + NULL + } + ) + + if (is.null(response)) { + return(NULL) + } + + payload <- httr2::resp_body_json(response) + if (isTRUE(normalize)) { + payload <- snake_case_list(payload) + } + payload +} + +#' @noRd +perform_api_delete <- function(path, + rq = NULL, + vb = FALSE) { + request <- rq + if (is.null(request)) { + request <- databraryr::make_default_request() + } + + url <- paste0(DATABRARY_BASE_URL, ensure_leading_slash(path)) + request <- httr2::req_url(request, url) + request <- httr2::req_method(request, "DELETE") + + response <- tryCatch( + httr2::req_perform(request), + httr2_error = function(cnd) { + if (vb) { + message("DELETE request failed for ", url, ": ", conditionMessage(cnd)) + } + NULL + } + ) + + if (is.null(response)) { + return(FALSE) + } + + # DELETE typically returns 204 No Content or 200 OK + TRUE +} + diff --git a/R/assign_record_to_file.R b/R/assign_record_to_file.R new file mode 100644 index 00000000..a4f4ac7a --- /dev/null +++ b/R/assign_record_to_file.R @@ -0,0 +1,115 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Assign Record to Session File +#' +#' @description Assign a record to a session file, creating a record-file +#' association. This operation is idempotent - calling it multiple times with +#' the same parameters will not create duplicate associations. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param file_id Numeric file identifier. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer and +#' must belong to the specified volume. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return The response data on success, or \code{NULL} if the operation fails. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Assign a participant record to a video file +#' assign_record_to_file( +#' vol_id = 1, +#' session_id = 10, +#' file_id = 20, +#' record_id = 123 +#' ) +#' } +#' } +#' @export +assign_record_to_file <- function( + vol_id = 1, + session_id, + file_id, + record_id, + vb = options::opt("vb"), + rq = NULL +) { + # Validate vol_id + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id >= 1) + assertthat::assert_that( + vol_id == floor(vol_id), + msg = "vol_id must be an integer" + ) + + # Validate session_id + assertthat::assert_that(is.numeric(session_id)) + assertthat::assert_that(length(session_id) == 1) + assertthat::assert_that(session_id > 0) + assertthat::assert_that( + session_id == floor(session_id), + msg = "session_id must be an integer" + ) + + # Validate file_id + assertthat::assert_that(is.numeric(file_id)) + assertthat::assert_that(length(file_id) == 1) + assertthat::assert_that(file_id > 0) + assertthat::assert_that( + file_id == floor(file_id), + msg = "file_id must be an integer" + ) + + # Validate record_id + assertthat::assert_that(is.numeric(record_id)) + assertthat::assert_that(length(record_id) == 1) + assertthat::assert_that(record_id > 0) + assertthat::assert_that( + record_id == floor(record_id), + msg = "record_id must be an integer" + ) + + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Build request body + body <- list(record_id = record_id) + + # Perform API call + result <- perform_api_post( + path = sprintf(API_SESSION_FILE_ASSIGN, vol_id, session_id, file_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(result)) { + if (vb) { + message( + "Failed to assign record ", + record_id, + " to file ", + file_id, + " in session ", + session_id, + " of volume ", + vol_id + ) + } + return(NULL) + } + + result +} diff --git a/R/create_volume_record.R b/R/create_volume_record.R new file mode 100644 index 00000000..7bdf017a --- /dev/null +++ b/R/create_volume_record.R @@ -0,0 +1,267 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Resolve the name/ID metric for a category in a volume +#' +#' @description Fetches the volume's enabled categories and metrics, then +#' finds the priority metric for the given category (name, id, or description). +#' Mirrors the frontend's \code{getPriorityMetric} logic. +#' +#' @param vol_id Target volume number. +#' @param category_id Category identifier. +#' @param vb Logical; if \code{TRUE}, print verbose messages. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @return The metric ID (integer) for the name field, or \code{NULL} if not found. +#' @noRd +get_volume_record_name_metric_id <- function(vol_id, + category_id, + vb = options::opt("vb"), + rq = NULL) { + volume <- perform_api_get( + path = sprintf(API_VOLUME_DETAIL, vol_id), + rq = rq, + vb = vb + ) + if (is.null(volume)) { + return(NULL) + } + + enabled_categories <- volume$enabled_categories + enabled_metrics <- volume$enabled_metrics + + if (is.null(enabled_categories) || is.null(enabled_metrics)) { + return(NULL) + } + + # Find the category + category <- NULL + for (cat in enabled_categories) { + if (identical(as.integer(cat$id), as.integer(category_id))) { + category <- cat + break + } + } + if (is.null(category)) { + return(NULL) + } + + category_metrics <- category$metrics + if (is.null(category_metrics) || length(category_metrics) == 0) { + return(NULL) + } + + # Get enabled metric IDs for this volume + enabled_metric_ids <- vapply( + enabled_metrics, + function(m) as.integer(m$id), + integer(1) + ) + + # Filter category metrics to those enabled for the volume + category_metric_ids <- vapply( + category_metrics, + function(m) as.integer(m$id), + integer(1) + ) + available_metrics <- category_metrics[ + category_metric_ids %in% enabled_metric_ids + ] + if (length(available_metrics) == 0) { + return(NULL) + } + + # Priority: required first, then name, id, description (same as frontend) + priority_names <- c("name", "id", "description") + + for (metric in available_metrics) { + if (isTRUE(metric$required)) { + return(as.integer(metric$id)) + } + } + for (pname in priority_names) { + for (metric in available_metrics) { + if (tolower(metric$name) == pname) { + return(as.integer(metric$id)) + } + } + } + + # Fallback: first available metric + as.integer(available_metrics[[1]]$id) +} + +#' Create Record in Databrary Volume +#' +#' @description Create a new record in a Databrary volume. Records contain +#' metadata organized by category (e.g., participant, condition, task) with +#' measures (field values) stored per metric. The \code{name} is required and +#' resolved to the category's name/ID metric automatically. Use \code{measures} +#' to add additional metric values. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param category_id Numeric category identifier for the record type +#' (e.g., participant, condition, task). +#' @param name Display name for the record (e.g., "P001", "Control group"). +#' Required; resolves to the category's name metric from volume configuration. +#' @param measures Optional named list mapping additional metric IDs (as strings) +#' to values. Values can be strings (for text metrics), numbers (for numeric +#' metrics), or lists with \code{year}, \code{month}, \code{day}, +#' \code{is_estimated} fields (for date metrics). +#' @param participant Optional list for participant records containing +#' \code{birthday} (with \code{year}, \code{month}, \code{day} fields) or +#' \code{age} (with \code{years}, \code{months}, \code{days} fields). Cannot +#' provide both \code{birthday} and \code{age}. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the created record's metadata including id, volume, +#' category_id, measures, birthday (if participant), and age (if participant), +#' or \code{NULL} if creation fails. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Create a task record with name only +#' create_volume_record( +#' vol_id = 1, +#' category_id = 6, +#' name = "Control group" +#' ) +#' +#' # Create a record with name and additional measures +#' create_volume_record( +#' vol_id = 1, +#' category_id = 6, +#' name = "Task A", +#' measures = list("30" = "Extra value") +#' ) +#' +#' # Create a participant record with name and birthday +#' create_volume_record( +#' vol_id = 1, +#' category_id = 1, +#' name = "P001", +#' participant = list( +#' birthday = list(year = 2020, month = 3, day = 15) +#' ) +#' ) +#' } +#' } +#' @export +create_volume_record <- function( + vol_id = 1, + category_id, + name, + measures = list(), + participant = NULL, + vb = options::opt("vb"), + rq = NULL +) { + # Validate vol_id + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id >= 1) + assertthat::assert_that( + vol_id == floor(vol_id), + msg = "vol_id must be an integer" + ) + + # Validate category_id + assertthat::assert_that(length(category_id) == 1) + assertthat::assert_that(is.numeric(category_id)) + assertthat::assert_that(category_id > 0) + assertthat::assert_that( + category_id == floor(category_id), + msg = "category_id must be an integer" + ) + + # Validate name + assertthat::assert_that(is.character(name)) + assertthat::assert_that(length(name) == 1) + assertthat::assert_that(nzchar(trimws(name)), msg = "name must not be empty") + + # Validate measures + assertthat::assert_that(is.list(measures)) + + # Validate participant + if (!is.null(participant)) { + assertthat::assert_that(is.list(participant)) + } + + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Resolve name metric and build measures with name + name_metric_id <- get_volume_record_name_metric_id( + vol_id = vol_id, + category_id = category_id, + vb = vb, + rq = rq + ) + + if (is.null(name_metric_id)) { + if (vb) { + message( + "Could not find name/ID metric for category ", category_id, + " in volume ", vol_id + ) + } + return(NULL) + } + + measures_with_name <- measures + measures_with_name[[as.character(name_metric_id)]] <- name + + # Build request body + body <- list(category_id = category_id, measures = measures_with_name) + + if (!is.null(participant)) { + body$participant <- participant + } + + # Perform API call + record <- perform_api_post( + path = sprintf(API_VOLUME_RECORDS, vol_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(record)) { + if (vb) { + message("Failed to create record in volume ", vol_id) + } + return(NULL) + } + + # Process age if present + age <- NULL + if (!is.null(record$age)) { + age <- list( + years = record$age$years, + months = record$age$months, + days = record$age$days, + total_days = record$age$total_days, + formatted_value = record$age$formatted_value, + is_estimated = record$age$is_estimated, + is_blurred = record$age$is_blurred + ) + } + + # Return structured list + list( + record_id = record$id, + record_volume = record$volume, + record_category_id = record$category_id, + measures = record$measures, + birthday = record$birthday, + age = age + ) +} diff --git a/R/delete_record_measure.R b/R/delete_record_measure.R new file mode 100644 index 00000000..de6b258a --- /dev/null +++ b/R/delete_record_measure.R @@ -0,0 +1,103 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Delete Measure from a Record +#' +#' @description Delete a single measure from a record. Note that the backend +#' will reject attempts to delete measures for required metrics. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer. +#' @param metric_id Numeric metric identifier. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} if the measure was successfully deleted, \code{FALSE} +#' otherwise. Deletion will fail for required metrics. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Delete a measure +#' delete_record_measure( +#' vol_id = 1, +#' record_id = 123, +#' metric_id = 5 +#' ) +#' +#' # Delete with verbose output +#' delete_record_measure( +#' vol_id = 1, +#' record_id = 123, +#' metric_id = 5, +#' vb = TRUE +#' ) +#' } +#' } +#' @export +delete_record_measure <- function( + vol_id = 1, + record_id, + metric_id, + vb = options::opt("vb"), + rq = NULL +) { + # Validate vol_id + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id >= 1) + assertthat::assert_that( + vol_id == floor(vol_id), + msg = "vol_id must be an integer" + ) + + # Validate record_id + assertthat::assert_that(is.numeric(record_id)) + assertthat::assert_that(length(record_id) == 1) + assertthat::assert_that(record_id > 0) + assertthat::assert_that( + record_id == floor(record_id), + msg = "record_id must be an integer" + ) + + # Validate metric_id + assertthat::assert_that(is.numeric(metric_id)) + assertthat::assert_that(length(metric_id) == 1) + assertthat::assert_that(metric_id > 0) + assertthat::assert_that( + metric_id == floor(metric_id), + msg = "metric_id must be an integer" + ) + + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Perform API call + success <- perform_api_delete( + path = sprintf(API_RECORD_MEASURES, vol_id, record_id, metric_id), + rq = rq, + vb = vb + ) + + if (!success) { + if (vb) { + message( + "Failed to delete measure for metric ", + metric_id, + " on record ", + record_id, + " in volume ", + vol_id + ) + } + } + + success +} diff --git a/R/delete_volume_record.R b/R/delete_volume_record.R new file mode 100644 index 00000000..bc3455d7 --- /dev/null +++ b/R/delete_volume_record.R @@ -0,0 +1,82 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Delete Record from Databrary Volume +#' +#' @description Delete (soft-delete) a record from a Databrary volume. The +#' record and its measures are marked as deleted but not permanently removed +#' from the database. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} if the record was successfully deleted, \code{FALSE} +#' otherwise. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Delete a record +#' delete_volume_record(vol_id = 1, record_id = 123) +#' +#' # Delete with verbose output +#' delete_volume_record(vol_id = 1, record_id = 123, vb = TRUE) +#' } +#' } +#' @export +delete_volume_record <- function( + vol_id = 1, + record_id, + vb = options::opt("vb"), + rq = NULL +) { + # Validate vol_id + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(vol_id >= 1) + assertthat::assert_that( + vol_id == floor(vol_id), + msg = "vol_id must be an integer" + ) + + # Validate record_id + assertthat::assert_that(is.numeric(record_id)) + assertthat::assert_that(length(record_id) == 1) + assertthat::assert_that(record_id > 0) + assertthat::assert_that( + record_id == floor(record_id), + msg = "record_id must be an integer" + ) + + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Perform API call + success <- perform_api_delete( + path = sprintf(API_VOLUME_RECORD_DETAIL, vol_id, record_id), + rq = rq, + vb = vb + ) + + if (!success) { + if (vb) { + message( + "Failed to delete record ", + record_id, + " from volume ", + vol_id + ) + } + } + + success +} diff --git a/R/list_volume_records.R b/R/list_volume_records.R index 69b61ad5..fc115ea2 100644 --- a/R/list_volume_records.R +++ b/R/list_volume_records.R @@ -3,6 +3,24 @@ #' NULL +#' @noRd +empty_volume_records_tibble <- function() { + tibble::tibble( + record_id = integer(0), + record_volume = integer(0), + record_category_id = integer(0), + record_measures = list(), + record_birthday = character(0), + age_years = integer(0), + age_months = integer(0), + age_days = integer(0), + age_total_days = integer(0), + age_formatted = character(0), + age_is_estimated = logical(0), + age_is_blurred = logical(0) + ) +} + #' List Records in Databrary Volume #' #' @description Retrieve all records (participant data with measures) from a @@ -15,8 +33,9 @@ NULL #' @param rq An `httr2` request object. Defaults to `NULL`. #' #' @return A tibble containing metadata for each record including id, volume, -#' category_id, measures, birthday, and age information, or `NULL` when no -#' records are available. +#' category_id, measures, birthday, and age information. Returns an empty +#' tibble (with the same columns) when the volume has no records, or `NULL` +#' when the API call fails (e.g. non-existent volume). #' #' @inheritParams options_params #' @@ -81,11 +100,15 @@ list_volume_records <- function( vb = vb ) - if (is.null(records) || length(records) == 0) { + if (is.null(records)) { + return(NULL) + } + + if (length(records) == 0) { if (vb) { message("No records found for volume ", vol_id) } - return(NULL) + return(empty_volume_records_tibble()) } # Process records into tibble diff --git a/R/set_record_measure.R b/R/set_record_measure.R new file mode 100644 index 00000000..f65fce1a --- /dev/null +++ b/R/set_record_measure.R @@ -0,0 +1,128 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Set Measure for a Record +#' +#' @description Create or update a single measure for a record. This performs +#' an upsert operation - if the measure exists for this metric, it is updated; +#' otherwise, a new measure is created. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer. +#' @param metric_id Numeric metric identifier. Must be a positive integer. +#' @param value The measure value. Can be a string (for text metrics), a number +#' (for numeric metrics), or a list with \code{year}, \code{month}, \code{day}, +#' \code{is_estimated} fields (for date metrics). +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return The measure data on success, or \code{NULL} if the operation fails. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Set a text measure +#' set_record_measure( +#' vol_id = 1, +#' record_id = 123, +#' metric_id = 2, +#' value = "Female" +#' ) +#' +#' # Set a numeric measure +#' set_record_measure( +#' vol_id = 1, +#' record_id = 123, +#' metric_id = 5, +#' value = 24.5 +#' ) +#' +#' # Set a date measure +#' set_record_measure( +#' vol_id = 1, +#' record_id = 123, +#' metric_id = 4, +#' value = list(year = 2020, month = 3, day = 15, is_estimated = FALSE) +#' ) +#' } +#' } +#' @export +set_record_measure <- function( + vol_id = 1, + record_id, + metric_id, + value, + vb = options::opt("vb"), + rq = NULL +) { + # Validate vol_id + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id >= 1) + assertthat::assert_that( + vol_id == floor(vol_id), + msg = "vol_id must be an integer" + ) + + # Validate record_id + assertthat::assert_that(is.numeric(record_id)) + assertthat::assert_that(length(record_id) == 1) + assertthat::assert_that(record_id > 0) + assertthat::assert_that( + record_id == floor(record_id), + msg = "record_id must be an integer" + ) + + # Validate metric_id + assertthat::assert_that(is.numeric(metric_id)) + assertthat::assert_that(length(metric_id) == 1) + assertthat::assert_that(metric_id > 0) + assertthat::assert_that( + metric_id == floor(metric_id), + msg = "metric_id must be an integer" + ) + + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Build request body + # For date measures, value is already a list with year/month/day + # For text/numeric measures, wrap in list(value = ...) + body <- if (is.list(value) && !is.null(names(value))) { + # Assume it's a date measure with named fields + value + } else { + list(value = value) + } + + # Perform API call + measure <- perform_api_post( + path = sprintf(API_RECORD_MEASURES, vol_id, record_id, metric_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(measure)) { + if (vb) { + message( + "Failed to set measure for metric ", + metric_id, + " on record ", + record_id, + " in volume ", + vol_id + ) + } + return(NULL) + } + + measure +} diff --git a/R/unassign_record_from_file.R b/R/unassign_record_from_file.R new file mode 100644 index 00000000..105106eb --- /dev/null +++ b/R/unassign_record_from_file.R @@ -0,0 +1,112 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Unassign Record from Session File +#' +#' @description Remove the association between a record and a session file. +#' If the record is not assigned to the file, this operation will fail. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param file_id Numeric file identifier. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} if the record was successfully unassigned, \code{FALSE} +#' otherwise. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Unassign a record from a file +#' unassign_record_from_file( +#' vol_id = 1, +#' session_id = 10, +#' file_id = 20, +#' record_id = 123 +#' ) +#' } +#' } +#' @export +unassign_record_from_file <- function( + vol_id = 1, + session_id, + file_id, + record_id, + vb = options::opt("vb"), + rq = NULL +) { + # Validate vol_id + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id >= 1) + assertthat::assert_that( + vol_id == floor(vol_id), + msg = "vol_id must be an integer" + ) + + # Validate session_id + assertthat::assert_that(is.numeric(session_id)) + assertthat::assert_that(length(session_id) == 1) + assertthat::assert_that(session_id > 0) + assertthat::assert_that( + session_id == floor(session_id), + msg = "session_id must be an integer" + ) + + # Validate file_id + assertthat::assert_that(is.numeric(file_id)) + assertthat::assert_that(length(file_id) == 1) + assertthat::assert_that(file_id > 0) + assertthat::assert_that( + file_id == floor(file_id), + msg = "file_id must be an integer" + ) + + # Validate record_id + assertthat::assert_that(is.numeric(record_id)) + assertthat::assert_that(length(record_id) == 1) + assertthat::assert_that(record_id > 0) + assertthat::assert_that( + record_id == floor(record_id), + msg = "record_id must be an integer" + ) + + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Build request body + body <- list(record_id = record_id) + + # Perform API call (unassign returns 204 No Content) + success <- perform_api_post( + path = sprintf(API_SESSION_FILE_UNASSIGN, vol_id, session_id, file_id), + body = body, + rq = rq, + vb = vb + ) + if (is.null(success)) success <- FALSE + + if (!success && vb) { + message( + "Failed to unassign record ", + record_id, + " from file ", + file_id, + " in session ", + session_id, + " of volume ", + vol_id + ) + } + + success +} diff --git a/R/update_volume_record.R b/R/update_volume_record.R new file mode 100644 index 00000000..b1ee3032 --- /dev/null +++ b/R/update_volume_record.R @@ -0,0 +1,146 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Update Record in Databrary Volume +#' +#' @description Update an existing record in a Databrary volume. This performs +#' a partial update (PATCH), modifying only the fields provided. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer. +#' @param measures Optional named list mapping metric IDs (as strings) to values. +#' Values can be strings (for text metrics), numbers (for numeric metrics), +#' or lists with \code{year}, \code{month}, \code{day}, \code{is_estimated} +#' fields (for date metrics). If provided, replaces existing measures. +#' @param participant Optional list for participant records containing +#' \code{birthday} (with \code{year}, \code{month}, \code{day} fields) or +#' \code{age} (with \code{years}, \code{months}, \code{days} fields). +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the updated record's metadata including id, volume, +#' category_id, measures, birthday (if participant), and age (if participant), +#' or \code{NULL} if update fails. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Update measures for a record +#' update_volume_record( +#' vol_id = 1, +#' record_id = 123, +#' measures = list("2" = "Male", "5" = 25.5) +#' ) +#' +#' # Update participant birthday +#' update_volume_record( +#' vol_id = 1, +#' record_id = 123, +#' participant = list( +#' birthday = list(year = 2021, month = 5, day = 10) +#' ) +#' ) +#' } +#' } +#' @export +update_volume_record <- function( + vol_id = 1, + record_id, + measures = NULL, + participant = NULL, + vb = options::opt("vb"), + rq = NULL +) { + # Validate vol_id + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id >= 1) + assertthat::assert_that( + vol_id == floor(vol_id), + msg = "vol_id must be an integer" + ) + + # Validate record_id + assertthat::assert_that(is.numeric(record_id)) + assertthat::assert_that(length(record_id) == 1) + assertthat::assert_that(record_id > 0) + assertthat::assert_that( + record_id == floor(record_id), + msg = "record_id must be an integer" + ) + + # Validate measures + if (!is.null(measures)) { + assertthat::assert_that(is.list(measures)) + } + + # Validate participant + if (!is.null(participant)) { + assertthat::assert_that(is.list(participant)) + } + + # Validate vb + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + # Validate rq + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Build request body (only include non-NULL fields) + body <- list() + + if (!is.null(measures)) { + body$measures <- measures + } + + if (!is.null(participant)) { + body$participant <- participant + } + + # Perform API call + record <- perform_api_patch( + path = sprintf(API_VOLUME_RECORD_DETAIL, vol_id, record_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(record)) { + if (vb) { + message( + "Failed to update record ", + record_id, + " in volume ", + vol_id + ) + } + return(NULL) + } + + # Process age if present + age <- NULL + if (!is.null(record$age)) { + age <- list( + years = record$age$years, + months = record$age$months, + days = record$age$days, + total_days = record$age$total_days, + formatted_value = record$age$formatted_value, + is_estimated = record$age$is_estimated, + is_blurred = record$age$is_blurred + ) + } + + # Return structured list + list( + record_id = record$id, + record_volume = record$volume, + record_category_id = record$category_id, + measures = record$measures, + birthday = record$birthday, + age = age + ) +} diff --git a/man/assign_record_to_file.Rd b/man/assign_record_to_file.Rd new file mode 100644 index 00000000..9612ec77 --- /dev/null +++ b/man/assign_record_to_file.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/assign_record_to_file.R +\name{assign_record_to_file} +\alias{assign_record_to_file} +\title{Assign Record to Session File} +\usage{ +assign_record_to_file( + vol_id = 1, + session_id, + file_id, + record_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{file_id}{Numeric file identifier. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer and +must belong to the specified volume.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +The response data on success, or \code{NULL} if the operation fails. +} +\description{ +Assign a record to a session file, creating a record-file +association. This operation is idempotent - calling it multiple times with +the same parameters will not create duplicate associations. +} +\examples{ +\donttest{ +\dontrun{ +# Assign a participant record to a video file +assign_record_to_file( + vol_id = 1, + session_id = 10, + file_id = 20, + record_id = 123 +) +} +} +} diff --git a/man/create_volume_record.Rd b/man/create_volume_record.Rd new file mode 100644 index 00000000..c03ca725 --- /dev/null +++ b/man/create_volume_record.Rd @@ -0,0 +1,81 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/create_volume_record.R +\name{create_volume_record} +\alias{create_volume_record} +\title{Create Record in Databrary Volume} +\usage{ +create_volume_record( + vol_id = 1, + category_id, + name, + measures = list(), + participant = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{category_id}{Numeric category identifier for the record type +(e.g., participant, condition, task).} + +\item{name}{Display name for the record (e.g., "P001", "Control group"). +Required; resolves to the category's name metric from volume configuration.} + +\item{measures}{Optional named list mapping additional metric IDs (as strings) +to values. Values can be strings (for text metrics), numbers (for numeric +metrics), or lists with \code{year}, \code{month}, \code{day}, +\code{is_estimated} fields (for date metrics).} + +\item{participant}{Optional list for participant records containing +\code{birthday} (with \code{year}, \code{month}, \code{day} fields) or +\code{age} (with \code{years}, \code{months}, \code{days} fields). Cannot +provide both \code{birthday} and \code{age}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the created record's metadata including id, volume, +category_id, measures, birthday (if participant), and age (if participant), +or \code{NULL} if creation fails. +} +\description{ +Create a new record in a Databrary volume. Records contain +metadata organized by category (e.g., participant, condition, task) with +measures (field values) stored per metric. The \code{name} is required and +resolved to the category's name/ID metric automatically. Use \code{measures} +to add additional metric values. +} +\examples{ +\donttest{ +\dontrun{ +# Create a task record with name only +create_volume_record( + vol_id = 1, + category_id = 6, + name = "Control group" +) + +# Create a record with name and additional measures +create_volume_record( + vol_id = 1, + category_id = 6, + name = "Task A", + measures = list("30" = "Extra value") +) + +# Create a participant record with name and birthday +create_volume_record( + vol_id = 1, + category_id = 1, + name = "P001", + participant = list( + birthday = list(year = 2020, month = 3, day = 15) + ) +) +} +} +} diff --git a/man/delete_record_measure.Rd b/man/delete_record_measure.Rd new file mode 100644 index 00000000..18fc478a --- /dev/null +++ b/man/delete_record_measure.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/delete_record_measure.R +\name{delete_record_measure} +\alias{delete_record_measure} +\title{Delete Measure from a Record} +\usage{ +delete_record_measure( + vol_id = 1, + record_id, + metric_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer.} + +\item{metric_id}{Numeric metric identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} if the measure was successfully deleted, \code{FALSE} +otherwise. Deletion will fail for required metrics. +} +\description{ +Delete a single measure from a record. Note that the backend +will reject attempts to delete measures for required metrics. +} +\examples{ +\donttest{ +\dontrun{ +# Delete a measure +delete_record_measure( + vol_id = 1, + record_id = 123, + metric_id = 5 +) + +# Delete with verbose output +delete_record_measure( + vol_id = 1, + record_id = 123, + metric_id = 5, + vb = TRUE +) +} +} +} diff --git a/man/delete_volume_record.Rd b/man/delete_volume_record.Rd new file mode 100644 index 00000000..9be5776a --- /dev/null +++ b/man/delete_volume_record.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/delete_volume_record.R +\name{delete_volume_record} +\alias{delete_volume_record} +\title{Delete Record from Databrary Volume} +\usage{ +delete_volume_record(vol_id = 1, record_id, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} if the record was successfully deleted, \code{FALSE} +otherwise. +} +\description{ +Delete (soft-delete) a record from a Databrary volume. The +record and its measures are marked as deleted but not permanently removed +from the database. +} +\examples{ +\donttest{ +\dontrun{ +# Delete a record +delete_volume_record(vol_id = 1, record_id = 123) + +# Delete with verbose output +delete_volume_record(vol_id = 1, record_id = 123, vb = TRUE) +} +} +} diff --git a/man/list_volume_records.Rd b/man/list_volume_records.Rd index c195131f..d8f3dac9 100644 --- a/man/list_volume_records.Rd +++ b/man/list_volume_records.Rd @@ -23,8 +23,9 @@ by category type.} } \value{ A tibble containing metadata for each record including id, volume, -category_id, measures, birthday, and age information, or \code{NULL} when no -records are available. +category_id, measures, birthday, and age information. Returns an empty +tibble (with the same columns) when the volume has no records, or \code{NULL} +when the API call fails (e.g. non-existent volume). } \description{ Retrieve all records (participant data with measures) from a diff --git a/man/set_record_measure.Rd b/man/set_record_measure.Rd new file mode 100644 index 00000000..5d735a6c --- /dev/null +++ b/man/set_record_measure.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/set_record_measure.R +\name{set_record_measure} +\alias{set_record_measure} +\title{Set Measure for a Record} +\usage{ +set_record_measure( + vol_id = 1, + record_id, + metric_id, + value, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer.} + +\item{metric_id}{Numeric metric identifier. Must be a positive integer.} + +\item{value}{The measure value. Can be a string (for text metrics), a number +(for numeric metrics), or a list with \code{year}, \code{month}, \code{day}, +\code{is_estimated} fields (for date metrics).} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +The measure data on success, or \code{NULL} if the operation fails. +} +\description{ +Create or update a single measure for a record. This performs +an upsert operation - if the measure exists for this metric, it is updated; +otherwise, a new measure is created. +} +\examples{ +\donttest{ +\dontrun{ +# Set a text measure +set_record_measure( + vol_id = 1, + record_id = 123, + metric_id = 2, + value = "Female" +) + +# Set a numeric measure +set_record_measure( + vol_id = 1, + record_id = 123, + metric_id = 5, + value = 24.5 +) + +# Set a date measure +set_record_measure( + vol_id = 1, + record_id = 123, + metric_id = 4, + value = list(year = 2020, month = 3, day = 15, is_estimated = FALSE) +) +} +} +} diff --git a/man/unassign_record_from_file.Rd b/man/unassign_record_from_file.Rd new file mode 100644 index 00000000..20922c98 --- /dev/null +++ b/man/unassign_record_from_file.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/unassign_record_from_file.R +\name{unassign_record_from_file} +\alias{unassign_record_from_file} +\title{Unassign Record from Session File} +\usage{ +unassign_record_from_file( + vol_id = 1, + session_id, + file_id, + record_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{file_id}{Numeric file identifier. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} if the record was successfully unassigned, \code{FALSE} +otherwise. +} +\description{ +Remove the association between a record and a session file. +If the record is not assigned to the file, this operation will fail. +} +\examples{ +\donttest{ +\dontrun{ +# Unassign a record from a file +unassign_record_from_file( + vol_id = 1, + session_id = 10, + file_id = 20, + record_id = 123 +) +} +} +} diff --git a/man/update_volume_record.Rd b/man/update_volume_record.Rd new file mode 100644 index 00000000..d73ad540 --- /dev/null +++ b/man/update_volume_record.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/update_volume_record.R +\name{update_volume_record} +\alias{update_volume_record} +\title{Update Record in Databrary Volume} +\usage{ +update_volume_record( + vol_id = 1, + record_id, + measures = NULL, + participant = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer.} + +\item{measures}{Optional named list mapping metric IDs (as strings) to values. +Values can be strings (for text metrics), numbers (for numeric metrics), +or lists with \code{year}, \code{month}, \code{day}, \code{is_estimated} +fields (for date metrics). If provided, replaces existing measures.} + +\item{participant}{Optional list for participant records containing +\code{birthday} (with \code{year}, \code{month}, \code{day} fields) or +\code{age} (with \code{years}, \code{months}, \code{days} fields).} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the updated record's metadata including id, volume, +category_id, measures, birthday (if participant), and age (if participant), +or \code{NULL} if update fails. +} +\description{ +Update an existing record in a Databrary volume. This performs +a partial update (PATCH), modifying only the fields provided. +} +\examples{ +\donttest{ +\dontrun{ +# Update measures for a record +update_volume_record( + vol_id = 1, + record_id = 123, + measures = list("2" = "Male", "5" = 25.5) +) + +# Update participant birthday +update_volume_record( + vol_id = 1, + record_id = 123, + participant = list( + birthday = list(year = 2021, month = 5, day = 10) + ) +) +} +} +} diff --git a/tests/testthat/helper-auth.R b/tests/testthat/helper-auth.R index 743fe4b7..443a09f9 100644 --- a/tests/testthat/helper-auth.R +++ b/tests/testthat/helper-auth.R @@ -7,7 +7,6 @@ login_test_account <- function() { } set_if_missing("DATABRARY_BASE_URL", "https://api.stg-databrary.its.nyu.edu") - set_if_missing("USER_AGENT", "SRW$*Kxy2nYdyo4LozoGV#i6LvH/") set_if_missing("DATABRARY_LOGIN", "pawel.armatys+1@montrosesoftware.com") set_if_missing("DATABRARY_PASSWORD", "tindov-9ciVxa-hehguw") set_if_missing("DATABRARY_CLIENT_ID", "9B0gJF1b5OSkkrjPrkKHeYHgWLOJ0N1Uxv2tW3KS") diff --git a/tests/testthat/test-assign_record_to_file.R b/tests/testthat/test-assign_record_to_file.R new file mode 100644 index 00000000..3454d374 --- /dev/null +++ b/tests/testthat/test-assign_record_to_file.R @@ -0,0 +1,165 @@ +# assign_record_to_file() ------------------------------------------------------ +login_test_account() + +test_that("assign_record_to_file assigns a record to a file", { + # First create a record (unique name to avoid "already in use" across test runs) + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = sprintf("Assign test %d", sample(100000L:999999L, 1L)), + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for assign test") + + record_id <- create_result$record_id + + # Get a session and file from volume 1 + sessions <- list_volume_sessions(vol_id = 1777, vb = FALSE) + skip_if_null_response(sessions, "list_volume_sessions for assign test") + + if (nrow(sessions) > 0) { + session_id <- sessions$session_id[1] + + # Get files from the session + files <- list_session_assets(vol_id = 1777, session_id = session_id, vb = FALSE) + + if (!is.null(files) && nrow(files) > 0) { + file_id <- files$asset_id[1] + + # Assign the record to the file + assign_result <- assign_record_to_file( + vol_id = 1777, + session_id = session_id, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) + + # Clean up - unassign first, then delete record + unassign_record_from_file( + vol_id = 1777, + session_id = session_id, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + + skip_if_null_response(assign_result, "assign_record_to_file") + + expect_true(!is.null(assign_result)) + } + } + + # Clean up record if test was skipped + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) +}) + +test_that("assign_record_to_file is idempotent", { + # Create a record (unique name to avoid "already in use" across test runs) + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = sprintf("Assign idempotent %d", sample(100000L:999999L, 1L)), + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for idempotent test") + + record_id <- create_result$record_id + + # Get a session and file + sessions <- list_volume_sessions(vol_id = 1777, vb = FALSE) + skip_if_null_response(sessions, "list_volume_sessions for idempotent test") + + if (nrow(sessions) > 0) { + session_id <- sessions$session_id[1] + files <- list_session_assets(vol_id = 1777, session_id = session_id, vb = FALSE) + + if (!is.null(files) && nrow(files) > 0) { + file_id <- files$asset_id[1] + + # Assign twice + assign_result1 <- assign_record_to_file( + vol_id = 1777, + session_id = session_id, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) + + assign_result2 <- assign_record_to_file( + vol_id = 1777, + session_id = session_id, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) + + # Clean up + unassign_record_from_file( + vol_id = 1777, + session_id = session_id, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + + expect_true(!is.null(assign_result1)) + expect_true(!is.null(assign_result2)) + } + } + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) +}) + +test_that("assign_record_to_file rejects invalid vol_id", { + expect_error(assign_record_to_file(vol_id = -1, session_id = 1, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 0, session_id = 1, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = "1", session_id = 1, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = TRUE, session_id = 1, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = c(1, 2), session_id = 1, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1777.5, session_id = 1, file_id = 1, record_id = 1)) +}) + +test_that("assign_record_to_file rejects invalid session_id", { + expect_error(assign_record_to_file(vol_id = 1777, session_id = -1, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 0, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1777, session_id = "1", file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1777, session_id = TRUE, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1777, session_id = c(1, 2), file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1.5, file_id = 1, record_id = 1)) +}) + +test_that("assign_record_to_file rejects invalid file_id", { + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = -1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 0, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = "1", record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = TRUE, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = c(1, 2), record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1.5, record_id = 1)) +}) + +test_that("assign_record_to_file rejects invalid record_id", { + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = -1)) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 0)) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = "1")) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = TRUE)) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = c(1, 2))) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1.5)) +}) + +test_that("assign_record_to_file rejects invalid vb parameter", { + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = -1)) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = 3)) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = "a")) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = NULL)) +}) + +test_that("assign_record_to_file rejects invalid rq parameter", { + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, rq = "a")) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, rq = -1)) + expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, rq = TRUE)) +}) diff --git a/tests/testthat/test-create_volume_record.R b/tests/testthat/test-create_volume_record.R new file mode 100644 index 00000000..133ea8e5 --- /dev/null +++ b/tests/testthat/test-create_volume_record.R @@ -0,0 +1,187 @@ +# create_volume_record() ------------------------------------------------------- +login_test_account() + +test_that("create_volume_record creates a record with valid parameters", { + # Create a record with name (resolves required name metric from volume config) + result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Test condition", + vb = FALSE + ) + skip_if_null_response(result, "create_volume_record(vol_id = 1777, category_id = 6, name = 'Test condition')") + + # Clean up + if (!is.null(result$record_id)) { + delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE) + } + + expect_type(result, "list") + expect_named(result, c("record_id", "record_volume", "record_category_id", "measures", "birthday", "age")) + expect_equal(as.integer(result$record_volume), 1777L) + expect_equal(result$record_category_id, 6) + expect_true(is.numeric(result$record_id) || is.integer(result$record_id)) + expect_true(result$record_id > 0) +}) + +test_that("create_volume_record creates a record with measures", { + # Create a record by name (includes required name metric) + result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Test condition", + vb = FALSE + ) + skip_if_null_response(result, "create_volume_record with name") + + # Clean up + if (!is.null(result$record_id)) { + delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE) + } + + expect_type(result, "list") + expect_true(!is.null(result$measures)) + expect_true(is.list(result$measures)) +}) + +test_that("create_volume_record creates a record with name and additional measures", { + # Task category (6) in vol 1777 has optional metric 30 + result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Task with extra measures", + measures = list("30" = "Extra value"), + vb = FALSE + ) + skip_if_null_response(result, "create_volume_record with name and measures") + + # Clean up + if (!is.null(result$record_id)) { + delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE) + } + + expect_type(result, "list") + expect_true(!is.null(result$measures)) + expect_true(length(result$measures) >= 2L) +}) + +test_that("create_volume_record rejects invalid name", { + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "")) + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = " ")) + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = 123)) + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = c("A", "B"))) +}) + +test_that("create_volume_record returns NULL for non-existent volume", { + result <- create_volume_record( + vol_id = 999999, + category_id = 6, + name = "Test", + vb = FALSE + ) + expect_null(result) +}) + +test_that("create_volume_record works with verbose mode", { + result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Test condition vb", + vb = TRUE + ) + skip_if_null_response(result, "create_volume_record with vb = TRUE") + + # Clean up + if (!is.null(result$record_id)) { + delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE) + } + + expect_type(result, "list") + expect_true(!is.null(result$record_id)) +}) + +test_that("create_volume_record rejects invalid vol_id", { + # Negative ID + expect_error(create_volume_record(vol_id = -1, category_id = 6, name = "Test")) + + # Zero ID + expect_error(create_volume_record(vol_id = 0, category_id = 6, name = "Test")) + + # Non-numeric ID + expect_error(create_volume_record(vol_id = "1", category_id = 6, name = "Test")) + expect_error(create_volume_record(vol_id = TRUE, category_id = 6, name = "Test")) + expect_error(create_volume_record(vol_id = list(a = 1), category_id = 6, name = "Test")) + + # Multiple values + expect_error(create_volume_record(vol_id = c(1, 2), category_id = 6, name = "Test")) + + # Decimal/non-integer + expect_error(create_volume_record(vol_id = 1777.5, category_id = 6, name = "Test")) +}) + +test_that("create_volume_record rejects invalid category_id", { + # Negative ID + expect_error(create_volume_record(vol_id = 1777, category_id = -1, name = "Test")) + + # Zero ID + expect_error(create_volume_record(vol_id = 1777, category_id = 0, name = "Test")) + + # Non-numeric ID + expect_error(create_volume_record(vol_id = 1777, category_id = "1", name = "Test")) + expect_error(create_volume_record(vol_id = 1777, category_id = TRUE, name = "Test")) + + # Multiple values + expect_error(create_volume_record(vol_id = 1777, category_id = c(1, 2), name = "Test")) + + # Decimal/non-integer + expect_error(create_volume_record(vol_id = 1777, category_id = 1.5, name = "Test")) +}) + +test_that("create_volume_record rejects invalid measures", { + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", measures = "text")) + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", measures = 123)) + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", measures = TRUE)) +}) + +test_that("create_volume_record rejects invalid participant", { + expect_error(create_volume_record(vol_id = 1777, category_id = 1, name = "Test", participant = "text")) + expect_error(create_volume_record(vol_id = 1777, category_id = 1, name = "Test", participant = 123)) + expect_error(create_volume_record(vol_id = 1777, category_id = 1, name = "Test", participant = TRUE)) +}) + +test_that("create_volume_record rejects invalid vb parameter", { + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", vb = -1)) + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", vb = 3)) + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", vb = "a")) + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", vb = list(a = 1))) + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", vb = c(TRUE, FALSE))) + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", vb = NULL)) +}) + +test_that("create_volume_record rejects invalid rq parameter", { + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", rq = "a")) + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", rq = -1)) + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", rq = c(2, 3))) + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", rq = list(a = 1))) + expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", rq = TRUE)) +}) + +test_that("create_volume_record works with custom request object", { + custom_rq <- databraryr::make_default_request() + result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Test condition rq", + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "create_volume_record with custom_rq") + + # Clean up + if (!is.null(result$record_id)) { + delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE) + } + + expect_type(result, "list") + expect_true(!is.null(result$record_id)) +}) diff --git a/tests/testthat/test-delete_record_measure.R b/tests/testthat/test-delete_record_measure.R new file mode 100644 index 00000000..6e26d4db --- /dev/null +++ b/tests/testthat/test-delete_record_measure.R @@ -0,0 +1,154 @@ +# delete_record_measure() ------------------------------------------------------ +login_test_account() + +test_that("delete_record_measure deletes a measure", { + # Create a record and add an optional measure (metric 29 is name/required) + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Delete measure test", + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for delete_measure test") + + record_id <- create_result$record_id + + # First set an optional measure (30), then delete it + set_record_measure(vol_id = 1777, record_id = record_id, metric_id = 30, value = "temp", vb = FALSE) + + # Delete the non-required measure + delete_result <- delete_record_measure( + vol_id = 1777, + record_id = record_id, + metric_id = 30, + vb = FALSE + ) + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + + expect_true(delete_result) +}) + +test_that("delete_record_measure returns FALSE for non-existent measure", { + # Create a record (name is the required measure) + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Delete measure fail test", + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for delete_measure fail test") + + record_id <- create_result$record_id + + # Try to delete a non-existent measure + delete_result <- delete_record_measure( + vol_id = 1777, + record_id = record_id, + metric_id = 29, + vb = FALSE + ) + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + + expect_false(delete_result) +}) + +test_that("delete_record_measure works with verbose mode", { + # Create a record and add optional measure + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Delete verbose test", + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for delete_measure verbose test") + + record_id <- create_result$record_id + set_record_measure(vol_id = 1777, record_id = record_id, metric_id = 30, value = "temp", vb = FALSE) + + # Delete with verbose + delete_result <- delete_record_measure( + vol_id = 1777, + record_id = record_id, + metric_id = 30, + vb = TRUE + ) + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + + expect_true(delete_result) +}) + +test_that("delete_record_measure rejects invalid vol_id", { + expect_error(delete_record_measure(vol_id = -1, record_id = 1, metric_id = 29)) + expect_error(delete_record_measure(vol_id = 0, record_id = 1, metric_id = 29)) + expect_error(delete_record_measure(vol_id = "1", record_id = 1, metric_id = 29)) + expect_error(delete_record_measure(vol_id = TRUE, record_id = 1, metric_id = 29)) + expect_error(delete_record_measure(vol_id = c(1, 2), record_id = 1, metric_id = 29)) + expect_error(delete_record_measure(vol_id = 1777.5, record_id = 1, metric_id = 29)) +}) + +test_that("delete_record_measure rejects invalid record_id", { + expect_error(delete_record_measure(vol_id = 1777, record_id = -1, metric_id = 29)) + expect_error(delete_record_measure(vol_id = 1777, record_id = 0, metric_id = 29)) + expect_error(delete_record_measure(vol_id = 1777, record_id = "1", metric_id = 29)) + expect_error(delete_record_measure(vol_id = 1777, record_id = TRUE, metric_id = 29)) + expect_error(delete_record_measure(vol_id = 1777, record_id = c(1, 2), metric_id = 29)) + expect_error(delete_record_measure(vol_id = 1777, record_id = 1.5, metric_id = 29)) +}) + +test_that("delete_record_measure rejects invalid metric_id", { + expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = -1)) + expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 0)) + expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = "1")) + expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = TRUE)) + expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = c(1, 2))) + expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 1.5)) +}) + +test_that("delete_record_measure rejects invalid vb parameter", { + expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, vb = -1)) + expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, vb = 3)) + expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, vb = "a")) + expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, vb = c(TRUE, FALSE))) + expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, vb = NULL)) +}) + +test_that("delete_record_measure rejects invalid rq parameter", { + expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, rq = "a")) + expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, rq = -1)) + expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, rq = TRUE)) +}) + +test_that("delete_record_measure works with custom request object", { + # Create a record and add optional measure + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Delete custom rq test", + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for delete_measure custom rq test") + + record_id <- create_result$record_id + set_record_measure(vol_id = 1777, record_id = record_id, metric_id = 30, value = "temp", vb = FALSE) + + # Delete with custom request + custom_rq <- databraryr::make_default_request() + delete_result <- delete_record_measure( + vol_id = 1777, + record_id = record_id, + metric_id = 30, + rq = custom_rq, + vb = FALSE + ) + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + + expect_true(delete_result) +}) diff --git a/tests/testthat/test-delete_volume_record.R b/tests/testthat/test-delete_volume_record.R new file mode 100644 index 00000000..1539a9a5 --- /dev/null +++ b/tests/testthat/test-delete_volume_record.R @@ -0,0 +1,128 @@ +# delete_volume_record() ------------------------------------------------------- +login_test_account() + +test_that("delete_volume_record deletes an existing record", { + # First create a record + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Delete test", + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for delete test") + + record_id <- create_result$record_id + + # Delete the record + delete_result <- delete_volume_record( + vol_id = 1777, + record_id = record_id, + vb = FALSE + ) + + expect_true(delete_result) + + # Verify it's gone + get_result <- get_volume_record_by_id( + vol_id = 1777, + record_id = record_id, + vb = FALSE + ) + expect_null(get_result) +}) + +test_that("delete_volume_record returns FALSE for non-existent record", { + result <- delete_volume_record( + vol_id = 1777, + record_id = 999999, + vb = FALSE + ) + expect_false(result) +}) + +test_that("delete_volume_record works with verbose mode", { + # First create a record + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Delete test", + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for delete verbose test") + + record_id <- create_result$record_id + + # Delete with verbose + delete_result <- delete_volume_record( + vol_id = 1777, + record_id = record_id, + vb = TRUE + ) + + expect_true(delete_result) +}) + +test_that("delete_volume_record rejects invalid vol_id", { + expect_error(delete_volume_record(vol_id = -1, record_id = 1)) + expect_error(delete_volume_record(vol_id = 0, record_id = 1)) + expect_error(delete_volume_record(vol_id = "1", record_id = 1)) + expect_error(delete_volume_record(vol_id = TRUE, record_id = 1)) + expect_error(delete_volume_record(vol_id = list(a = 1), record_id = 1)) + expect_error(delete_volume_record(vol_id = c(1, 2), record_id = 1)) + expect_error(delete_volume_record(vol_id = 1777.5, record_id = 1)) + expect_error(delete_volume_record(vol_id = NULL, record_id = 1)) + expect_error(delete_volume_record(vol_id = NA, record_id = 1)) +}) + +test_that("delete_volume_record rejects invalid record_id", { + expect_error(delete_volume_record(vol_id = 1777, record_id = -1)) + expect_error(delete_volume_record(vol_id = 1777, record_id = 0)) + expect_error(delete_volume_record(vol_id = 1777, record_id = "1")) + expect_error(delete_volume_record(vol_id = 1777, record_id = TRUE)) + expect_error(delete_volume_record(vol_id = 1777, record_id = list(a = 1))) + expect_error(delete_volume_record(vol_id = 1777, record_id = c(1, 2))) + expect_error(delete_volume_record(vol_id = 1777, record_id = 1.5)) + expect_error(delete_volume_record(vol_id = 1777, record_id = NULL)) + expect_error(delete_volume_record(vol_id = 1777, record_id = NA)) +}) + +test_that("delete_volume_record rejects invalid vb parameter", { + expect_error(delete_volume_record(vol_id = 1777, record_id = 1, vb = -1)) + expect_error(delete_volume_record(vol_id = 1777, record_id = 1, vb = 3)) + expect_error(delete_volume_record(vol_id = 1777, record_id = 1, vb = "a")) + expect_error(delete_volume_record(vol_id = 1777, record_id = 1, vb = list(a = 1, b = 2))) + expect_error(delete_volume_record(vol_id = 1777, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_volume_record(vol_id = 1777, record_id = 1, vb = NULL)) +}) + +test_that("delete_volume_record rejects invalid rq parameter", { + expect_error(delete_volume_record(vol_id = 1777, record_id = 1, rq = "a")) + expect_error(delete_volume_record(vol_id = 1777, record_id = 1, rq = -1)) + expect_error(delete_volume_record(vol_id = 1777, record_id = 1, rq = c(2, 3))) + expect_error(delete_volume_record(vol_id = 1777, record_id = 1, rq = list(a = 1, b = 2))) + expect_error(delete_volume_record(vol_id = 1777, record_id = 1, rq = TRUE)) +}) + +test_that("delete_volume_record works with custom request object", { + # First create a record + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Delete custom rq test", + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for delete custom rq test") + + record_id <- create_result$record_id + + # Delete with custom request + custom_rq <- databraryr::make_default_request() + delete_result <- delete_volume_record( + vol_id = 1777, + record_id = record_id, + rq = custom_rq, + vb = FALSE + ) + + expect_true(delete_result) +}) diff --git a/tests/testthat/test-get_volume_record_by_id.R b/tests/testthat/test-get_volume_record_by_id.R index d402a597..bd1669a0 100644 --- a/tests/testthat/test-get_volume_record_by_id.R +++ b/tests/testthat/test-get_volume_record_by_id.R @@ -3,26 +3,26 @@ login_test_account() test_that("get_volume_record_by_id retrieves valid record", { # First get a list of records to find a valid record_id - records <- list_volume_records(vol_id = 1, vb = FALSE) - skip_if_null_response(records, "list_volume_records(vol_id = 1)") + records <- list_volume_records(vol_id = 1777, vb = FALSE) + skip_if_null_response(records, "list_volume_records(vol_id = 1777)") if (nrow(records) > 0) { test_record_id <- records$record_id[1] - result <- get_volume_record_by_id(vol_id = 1, record_id = test_record_id) - skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d)", test_record_id)) + result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id) + skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", test_record_id)) expect_type(result, "list") expect_named(result, c("record_id", "record_volume", "record_category_id", "measures", "birthday", "age")) expect_equal(result$record_id, test_record_id) - expect_equal(result$record_volume, 1) + expect_equal(result$record_volume, 1777) expect_true(is.numeric(result$record_category_id) || is.integer(result$record_category_id)) } }) test_that("get_volume_record_by_id returns NULL for non-existent record", { # Use a very large ID that likely doesn't exist - result <- get_volume_record_by_id(vol_id = 1, record_id = 999999, vb = FALSE) + result <- get_volume_record_by_id(vol_id = 1777, record_id = 999999, vb = FALSE) expect_null(result) }) @@ -32,13 +32,13 @@ test_that("get_volume_record_by_id returns NULL for non-existent volume", { }) test_that("get_volume_record_by_id works with verbose mode", { - records <- list_volume_records(vol_id = 1, vb = FALSE) - skip_if_null_response(records, "list_volume_records(vol_id = 1)") + records <- list_volume_records(vol_id = 1777, vb = FALSE) + skip_if_null_response(records, "list_volume_records(vol_id = 1777)") if (nrow(records) > 0) { test_record_id <- records$record_id[1] - result <- get_volume_record_by_id(vol_id = 1, record_id = test_record_id, vb = TRUE) - skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d, vb = TRUE)", test_record_id)) + result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id, vb = TRUE) + skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d, vb = TRUE)", test_record_id)) expect_type(result, "list") expect_true(!is.null(result$record_id)) @@ -61,7 +61,7 @@ test_that("get_volume_record_by_id rejects invalid vol_id", { expect_error(get_volume_record_by_id(vol_id = c(1, 2), record_id = 1)) # Decimal/non-integer - expect_error(get_volume_record_by_id(vol_id = 1.5, record_id = 1)) + expect_error(get_volume_record_by_id(vol_id = 1777.5, record_id = 1)) expect_error(get_volume_record_by_id(vol_id = 2.7, record_id = 1)) # NULL @@ -73,55 +73,55 @@ test_that("get_volume_record_by_id rejects invalid vol_id", { test_that("get_volume_record_by_id rejects invalid record_id", { # Negative ID - expect_error(get_volume_record_by_id(vol_id = 1, record_id = -1)) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = -1)) # Zero ID - expect_error(get_volume_record_by_id(vol_id = 1, record_id = 0)) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 0)) # Non-numeric ID - expect_error(get_volume_record_by_id(vol_id = 1, record_id = "1")) - expect_error(get_volume_record_by_id(vol_id = 1, record_id = TRUE)) - expect_error(get_volume_record_by_id(vol_id = 1, record_id = list(a = 1))) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = "1")) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = TRUE)) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = list(a = 1))) # Multiple values - expect_error(get_volume_record_by_id(vol_id = 1, record_id = c(1, 2))) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = c(1, 2))) # Decimal/non-integer - expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1.5)) - expect_error(get_volume_record_by_id(vol_id = 1, record_id = 2.7)) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1.5)) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 2.7)) # NULL - expect_error(get_volume_record_by_id(vol_id = 1, record_id = NULL)) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = NULL)) # NA - expect_error(get_volume_record_by_id(vol_id = 1, record_id = NA)) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = NA)) }) test_that("get_volume_record_by_id rejects invalid vb parameter", { - expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = -1)) - expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = 3)) - expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = "a")) - expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = list(a = 1, b = 2))) - expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = c(TRUE, FALSE))) - expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = NULL)) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, vb = -1)) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, vb = 3)) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, vb = "a")) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, vb = list(a = 1, b = 2))) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, vb = NULL)) }) test_that("get_volume_record_by_id rejects invalid rq parameter", { - expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, rq = "a")) - expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, rq = -1)) - expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, rq = c(2, 3))) - expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, rq = list(a = 1, b = 2))) - expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, rq = TRUE)) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, rq = "a")) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, rq = -1)) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, rq = c(2, 3))) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, rq = list(a = 1, b = 2))) + expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, rq = TRUE)) }) test_that("get_volume_record_by_id result structure is consistent", { - records <- list_volume_records(vol_id = 1, vb = FALSE) - skip_if_null_response(records, "list_volume_records(vol_id = 1)") + records <- list_volume_records(vol_id = 1777, vb = FALSE) + skip_if_null_response(records, "list_volume_records(vol_id = 1777)") if (nrow(records) > 0) { test_record_id <- records$record_id[1] - result <- get_volume_record_by_id(vol_id = 1, record_id = test_record_id) - skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d)", test_record_id)) + result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id) + skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", test_record_id)) # Check that all expected fields exist expect_true(all(c("record_id", "record_volume", "record_category_id", "measures", "birthday", "age") %in% names(result))) @@ -136,18 +136,18 @@ test_that("get_volume_record_by_id result structure is consistent", { expect_equal(result$record_id, test_record_id) # Check that record_volume matches requested volume - expect_equal(result$record_volume, 1) + expect_equal(result$record_volume, 1777) } }) test_that("get_volume_record_by_id handles age structure correctly", { - records <- list_volume_records(vol_id = 1, vb = FALSE) - skip_if_null_response(records, "list_volume_records(vol_id = 1)") + records <- list_volume_records(vol_id = 1777, vb = FALSE) + skip_if_null_response(records, "list_volume_records(vol_id = 1777)") if (nrow(records) > 0) { test_record_id <- records$record_id[1] - result <- get_volume_record_by_id(vol_id = 1, record_id = test_record_id) - skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d)", test_record_id)) + result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id) + skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", test_record_id)) # If age exists, check its structure if (!is.null(result$age)) { @@ -159,13 +159,13 @@ test_that("get_volume_record_by_id handles age structure correctly", { }) test_that("get_volume_record_by_id handles measures correctly", { - records <- list_volume_records(vol_id = 1, vb = FALSE) - skip_if_null_response(records, "list_volume_records(vol_id = 1)") + records <- list_volume_records(vol_id = 1777, vb = FALSE) + skip_if_null_response(records, "list_volume_records(vol_id = 1777)") if (nrow(records) > 0) { test_record_id <- records$record_id[1] - result <- get_volume_record_by_id(vol_id = 1, record_id = test_record_id) - skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d)", test_record_id)) + result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id) + skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", test_record_id)) # Measures should be a list (can be empty) expect_true(is.list(result$measures) || is.null(result$measures)) @@ -173,14 +173,14 @@ test_that("get_volume_record_by_id handles measures correctly", { }) test_that("get_volume_record_by_id works with custom request object", { - records <- list_volume_records(vol_id = 1, vb = FALSE) - skip_if_null_response(records, "list_volume_records(vol_id = 1)") + records <- list_volume_records(vol_id = 1777, vb = FALSE) + skip_if_null_response(records, "list_volume_records(vol_id = 1777)") if (nrow(records) > 0) { test_record_id <- records$record_id[1] custom_rq <- databraryr::make_default_request() - result <- get_volume_record_by_id(vol_id = 1, record_id = test_record_id, rq = custom_rq) - skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d, rq = custom_rq)", test_record_id)) + result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id, rq = custom_rq) + skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d, rq = custom_rq)", test_record_id)) expect_type(result, "list") expect_equal(result$record_id, test_record_id) @@ -188,34 +188,36 @@ test_that("get_volume_record_by_id works with custom request object", { }) test_that("get_volume_record_by_id can retrieve multiple different records", { - records <- list_volume_records(vol_id = 1, vb = FALSE) - skip_if_null_response(records, "list_volume_records(vol_id = 1)") + records <- list_volume_records(vol_id = 1777, vb = FALSE) + skip_if_null_response(records, "list_volume_records(vol_id = 1777)") - if (nrow(records) >= 2) { - record_id_1 <- records$record_id[1] - record_id_2 <- records$record_id[2] + unique_ids <- unique(records$record_id) + if (length(unique_ids) < 2) { + testthat::skip("Volume has fewer than 2 records; need 2+ to verify multiple retrieval") + } - result1 <- get_volume_record_by_id(vol_id = 1, record_id = record_id_1, vb = FALSE) - result2 <- get_volume_record_by_id(vol_id = 1, record_id = record_id_2, vb = FALSE) + record_id_1 <- unique_ids[1] + record_id_2 <- unique_ids[2] - skip_if_null_response(result1, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d)", record_id_1)) - skip_if_null_response(result2, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d)", record_id_2)) + result1 <- get_volume_record_by_id(vol_id = 1777, record_id = record_id_1, vb = FALSE) + result2 <- get_volume_record_by_id(vol_id = 1777, record_id = record_id_2, vb = FALSE) - # If both exist, they should be different - expect_false(identical(result1$record_id, result2$record_id)) - expect_equal(result1$record_id, record_id_1) - expect_equal(result2$record_id, record_id_2) - } + skip_if_null_response(result1, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", record_id_1)) + skip_if_null_response(result2, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", record_id_2)) + + expect_false(identical(result1$record_id, result2$record_id)) + expect_equal(as.integer(result1$record_id), as.integer(record_id_1)) + expect_equal(as.integer(result2$record_id), as.integer(record_id_2)) }) test_that("get_volume_record_by_id returns complete structure with all fields", { - records <- list_volume_records(vol_id = 1, vb = FALSE) - skip_if_null_response(records, "list_volume_records(vol_id = 1)") + records <- list_volume_records(vol_id = 1777, vb = FALSE) + skip_if_null_response(records, "list_volume_records(vol_id = 1777)") if (nrow(records) > 0) { test_record_id <- records$record_id[1] - result <- get_volume_record_by_id(vol_id = 1, record_id = test_record_id) - skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1, record_id = %d)", test_record_id)) + result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id) + skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", test_record_id)) # Record should have all expected fields expect_length(result, 6) diff --git a/tests/testthat/test-list_volume_records.R b/tests/testthat/test-list_volume_records.R index 79f07aaa..50c1e85a 100644 --- a/tests/testthat/test-list_volume_records.R +++ b/tests/testthat/test-list_volume_records.R @@ -2,8 +2,8 @@ login_test_account() test_that("list_volume_records returns tibble given valid vol_id", { - result <- list_volume_records(vol_id = 1) - skip_if_null_response(result, "list_volume_records(vol_id = 1)") + result <- list_volume_records(vol_id = 1777) + skip_if_null_response(result, "list_volume_records(vol_id = 1777)") expect_s3_class(result, "tbl_df") expect_gt(nrow(result), 0) @@ -11,8 +11,8 @@ test_that("list_volume_records returns tibble given valid vol_id", { }) test_that("list_volume_records returns valid record structure", { - result <- list_volume_records(vol_id = 1, vb = FALSE) - skip_if_null_response(result, "list_volume_records(vol_id = 1)") + result <- list_volume_records(vol_id = 1777, vb = FALSE) + skip_if_null_response(result, "list_volume_records(vol_id = 1777)") # Check column types expect_true(is.numeric(result$record_id) || is.integer(result$record_id)) @@ -24,7 +24,7 @@ test_that("list_volume_records returns valid record structure", { expect_true(all(result$record_id > 0)) # Check that record_volume matches requested volume - expect_true(all(result$record_volume == 1)) + expect_true(all(result$record_volume == 1777)) }) test_that("list_volume_records returns NULL for non-existent volume", { @@ -34,16 +34,16 @@ test_that("list_volume_records returns NULL for non-existent volume", { test_that("list_volume_records works with category_id filter", { # First get all records to find a valid category_id - all_records <- list_volume_records(vol_id = 1, vb = FALSE) - skip_if_null_response(all_records, "list_volume_records(vol_id = 1)") + all_records <- list_volume_records(vol_id = 1777, vb = FALSE) + skip_if_null_response(all_records, "list_volume_records(vol_id = 1777)") if (nrow(all_records) > 0) { # Get unique category_id from results test_category <- all_records$record_category_id[1] # Filter by that category - filtered_records <- list_volume_records(vol_id = 1, category_id = test_category, vb = FALSE) - skip_if_null_response(filtered_records, sprintf("list_volume_records(vol_id = 1, category_id = %d)", test_category)) + filtered_records <- list_volume_records(vol_id = 1777, category_id = test_category, vb = FALSE) + skip_if_null_response(filtered_records, sprintf("list_volume_records(vol_id = 1777, category_id = %d)", test_category)) # All records should have the specified category_id expect_true(all(filtered_records$record_category_id == test_category)) @@ -51,8 +51,8 @@ test_that("list_volume_records works with category_id filter", { }) test_that("list_volume_records works with verbose mode", { - result <- list_volume_records(vol_id = 1, vb = TRUE) - skip_if_null_response(result, "list_volume_records(vol_id = 1, vb = TRUE)") + result <- list_volume_records(vol_id = 1777, vb = TRUE) + skip_if_null_response(result, "list_volume_records(vol_id = 1777, vb = TRUE)") expect_s3_class(result, "tbl_df") expect_gt(nrow(result), 0) @@ -74,47 +74,47 @@ test_that("list_volume_records rejects invalid vol_id", { expect_error(list_volume_records(vol_id = c(1, 2))) # Decimal/non-integer - expect_error(list_volume_records(vol_id = 1.5)) + expect_error(list_volume_records(vol_id = 1777.5)) }) test_that("list_volume_records rejects invalid category_id", { # Negative ID - expect_error(list_volume_records(vol_id = 1, category_id = -1)) + expect_error(list_volume_records(vol_id = 1777, category_id = -1)) # Zero ID - expect_error(list_volume_records(vol_id = 1, category_id = 0)) + expect_error(list_volume_records(vol_id = 1777, category_id = 0)) # Non-numeric ID - expect_error(list_volume_records(vol_id = 1, category_id = "1")) - expect_error(list_volume_records(vol_id = 1, category_id = TRUE)) + expect_error(list_volume_records(vol_id = 1777, category_id = "1")) + expect_error(list_volume_records(vol_id = 1777, category_id = TRUE)) # Multiple values - expect_error(list_volume_records(vol_id = 1, category_id = c(1, 2))) + expect_error(list_volume_records(vol_id = 1777, category_id = c(1, 2))) # Decimal/non-integer - expect_error(list_volume_records(vol_id = 1, category_id = 1.5)) + expect_error(list_volume_records(vol_id = 1777, category_id = 1.5)) }) test_that("list_volume_records rejects invalid vb parameter", { - expect_error(list_volume_records(vol_id = 1, vb = -1)) - expect_error(list_volume_records(vol_id = 1, vb = 3)) - expect_error(list_volume_records(vol_id = 1, vb = "a")) - expect_error(list_volume_records(vol_id = 1, vb = list(a = 1, b = 2))) - expect_error(list_volume_records(vol_id = 1, vb = c(TRUE, FALSE))) - expect_error(list_volume_records(vol_id = 1, vb = NULL)) + expect_error(list_volume_records(vol_id = 1777, vb = -1)) + expect_error(list_volume_records(vol_id = 1777, vb = 3)) + expect_error(list_volume_records(vol_id = 1777, vb = "a")) + expect_error(list_volume_records(vol_id = 1777, vb = list(a = 1, b = 2))) + expect_error(list_volume_records(vol_id = 1777, vb = c(TRUE, FALSE))) + expect_error(list_volume_records(vol_id = 1777, vb = NULL)) }) test_that("list_volume_records rejects invalid rq parameter", { - expect_error(list_volume_records(vol_id = 1, rq = "a")) - expect_error(list_volume_records(vol_id = 1, rq = -1)) - expect_error(list_volume_records(vol_id = 1, rq = c(2, 3))) - expect_error(list_volume_records(vol_id = 1, rq = list(a = 1, b = 2))) - expect_error(list_volume_records(vol_id = 1, rq = TRUE)) + expect_error(list_volume_records(vol_id = 1777, rq = "a")) + expect_error(list_volume_records(vol_id = 1777, rq = -1)) + expect_error(list_volume_records(vol_id = 1777, rq = c(2, 3))) + expect_error(list_volume_records(vol_id = 1777, rq = list(a = 1, b = 2))) + expect_error(list_volume_records(vol_id = 1777, rq = TRUE)) }) test_that("list_volume_records includes age fields", { - result <- list_volume_records(vol_id = 1) - skip_if_null_response(result, "list_volume_records(vol_id = 1)") + result <- list_volume_records(vol_id = 1777) + skip_if_null_response(result, "list_volume_records(vol_id = 1777)") # Check that age fields exist age_fields <- c("age_years", "age_months", "age_days", "age_total_days", @@ -123,8 +123,8 @@ test_that("list_volume_records includes age fields", { }) test_that("list_volume_records includes measures as list column", { - result <- list_volume_records(vol_id = 1) - skip_if_null_response(result, "list_volume_records(vol_id = 1)") + result <- list_volume_records(vol_id = 1777) + skip_if_null_response(result, "list_volume_records(vol_id = 1777)") # Check that measures column is a list expect_true("record_measures" %in% names(result)) @@ -133,16 +133,16 @@ test_that("list_volume_records includes measures as list column", { test_that("list_volume_records works with custom request object", { custom_rq <- databraryr::make_default_request() - result <- list_volume_records(vol_id = 1, rq = custom_rq) - skip_if_null_response(result, "list_volume_records(vol_id = 1, rq = custom_rq)") + result <- list_volume_records(vol_id = 1777, rq = custom_rq) + skip_if_null_response(result, "list_volume_records(vol_id = 1777, rq = custom_rq)") expect_s3_class(result, "tbl_df") expect_gt(nrow(result), 0) }) test_that("list_volume_records returns for different volumes", { - result1 <- list_volume_records(vol_id = 1, vb = FALSE) - skip_if_null_response(result1, "list_volume_records(vol_id = 1)") + result1 <- list_volume_records(vol_id = 1777, vb = FALSE) + skip_if_null_response(result1, "list_volume_records(vol_id = 1777)") result2 <- list_volume_records(vol_id = 2, vb = FALSE) skip_if_null_response(result2, "list_volume_records(vol_id = 2)") @@ -152,6 +152,6 @@ test_that("list_volume_records returns for different volumes", { expect_s3_class(result2, "tbl_df") # Records should have different volume IDs - expect_true(all(result1$record_volume == 1)) + expect_true(all(result1$record_volume == 1777)) expect_true(all(result2$record_volume == 2)) }) diff --git a/tests/testthat/test-set_record_measure.R b/tests/testthat/test-set_record_measure.R new file mode 100644 index 00000000..7f4b75c7 --- /dev/null +++ b/tests/testthat/test-set_record_measure.R @@ -0,0 +1,170 @@ +# set_record_measure() --------------------------------------------------------- +login_test_account() + +test_that("set_record_measure sets a text measure", { + # First create a record + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Set measure test", + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for set_measure test") + + record_id <- create_result$record_id + + # Set a text measure (metric 10 is typically a text field for condition category) + measure_result <- set_record_measure( + vol_id = 1777, + record_id = record_id, + metric_id = 29, + value = "Test value", + vb = FALSE + ) + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + + skip_if_null_response(measure_result, "set_record_measure") + + expect_true(!is.null(measure_result)) +}) + +test_that("set_record_measure updates an existing measure", { + # Create a record with a measure + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Initial", + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for set_measure update test") + + record_id <- create_result$record_id + + # Update the measure + measure_result <- set_record_measure( + vol_id = 1777, + record_id = record_id, + metric_id = 29, + value = "Updated", + vb = FALSE + ) + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + + skip_if_null_response(measure_result, "set_record_measure update") + + expect_true(!is.null(measure_result)) +}) + +test_that("set_record_measure returns NULL for non-existent record", { + result <- set_record_measure( + vol_id = 1777, + record_id = 999999, + metric_id = 29, + value = "Test", + vb = FALSE + ) + expect_null(result) +}) + +test_that("set_record_measure works with verbose mode", { + # First create a record + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Set measure test", + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for set_measure verbose test") + + record_id <- create_result$record_id + + # Set measure with verbose + measure_result <- set_record_measure( + vol_id = 1777, + record_id = record_id, + metric_id = 29, + value = "Test", + vb = TRUE + ) + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + + skip_if_null_response(measure_result, "set_record_measure with vb = TRUE") + + expect_true(!is.null(measure_result)) +}) + +test_that("set_record_measure rejects invalid vol_id", { + expect_error(set_record_measure(vol_id = -1, record_id = 1, metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = 0, record_id = 1, metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = "1", record_id = 1, metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = TRUE, record_id = 1, metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = c(1, 2), record_id = 1, metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = 1777.5, record_id = 1, metric_id = 29, value = "test")) +}) + +test_that("set_record_measure rejects invalid record_id", { + expect_error(set_record_measure(vol_id = 1777, record_id = -1, metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = 1777, record_id = 0, metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = 1777, record_id = "1", metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = 1777, record_id = TRUE, metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = 1777, record_id = c(1, 2), metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = 1777, record_id = 1.5, metric_id = 29, value = "test")) +}) + +test_that("set_record_measure rejects invalid metric_id", { + expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = -1, value = "test")) + expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 0, value = "test")) + expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = "1", value = "test")) + expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = TRUE, value = "test")) + expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = c(1, 2), value = "test")) + expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 1.5, value = "test")) +}) + +test_that("set_record_measure rejects invalid vb parameter", { + expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, value = "test", vb = -1)) + expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, value = "test", vb = 3)) + expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, value = "test", vb = "a")) + expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, value = "test", vb = c(TRUE, FALSE))) + expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, value = "test", vb = NULL)) +}) + +test_that("set_record_measure rejects invalid rq parameter", { + expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, value = "test", rq = "a")) + expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, value = "test", rq = -1)) + expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, value = "test", rq = TRUE)) +}) + +test_that("set_record_measure works with numeric values", { + # Create a record + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Numeric measure test", + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for numeric measure test") + + record_id <- create_result$record_id + + # Set a numeric measure + measure_result <- set_record_measure( + vol_id = 1777, + record_id = record_id, + metric_id = 29, + value = 42.5, + vb = FALSE + ) + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + + skip_if_null_response(measure_result, "set_record_measure numeric") + + expect_true(!is.null(measure_result)) +}) diff --git a/tests/testthat/test-unassign_record_from_file.R b/tests/testthat/test-unassign_record_from_file.R new file mode 100644 index 00000000..c98aa663 --- /dev/null +++ b/tests/testthat/test-unassign_record_from_file.R @@ -0,0 +1,199 @@ +# unassign_record_from_file() -------------------------------------------------- +login_test_account() + +test_that("unassign_record_from_file unassigns a record from a file", { + # Create a record (unique name to avoid "already in use" across test runs) + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = sprintf("Unassign test %d", sample(100000L:999999L, 1L)), + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for unassign test") + + record_id <- create_result$record_id + + # Get a session and file + sessions <- list_volume_sessions(vol_id = 1777, vb = FALSE) + skip_if_null_response(sessions, "list_volume_sessions for unassign test") + + if (nrow(sessions) > 0) { + session_id <- sessions$session_id[1] + files <- list_session_assets(vol_id = 1777, session_id = session_id, vb = FALSE) + + if (!is.null(files) && nrow(files) > 0) { + file_id <- files$asset_id[1] + + # Assign first + assign_record_to_file( + vol_id = 1777, + session_id = session_id, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) + + # Then unassign + unassign_result <- unassign_record_from_file( + vol_id = 1777, + session_id = session_id, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + + expect_true(unassign_result) + } + } + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) +}) + +test_that("unassign_record_from_file returns FALSE for non-assigned record", { + # Create a record (unique name to avoid "already in use" across test runs) + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = sprintf("Unassign fail %d", sample(100000L:999999L, 1L)), + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for unassign fail test") + + record_id <- create_result$record_id + + # Get a session and file + sessions <- list_volume_sessions(vol_id = 1777, vb = FALSE) + skip_if_null_response(sessions, "list_volume_sessions for unassign fail test") + + if (nrow(sessions) > 0) { + session_id <- sessions$session_id[1] + files <- list_session_assets(vol_id = 1777, session_id = session_id, vb = FALSE) + + if (!is.null(files) && nrow(files) > 0) { + file_id <- files$asset_id[1] + + # Try to unassign without assigning first + unassign_result <- unassign_record_from_file( + vol_id = 1777, + session_id = session_id, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + + expect_false(unassign_result) + } + } + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) +}) + +test_that("unassign_record_from_file works with verbose mode", { + # Create a record (unique name to avoid "already in use" across test runs) + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = sprintf("Unassign verbose %d", sample(100000L:999999L, 1L)), + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for unassign verbose test") + + record_id <- create_result$record_id + + # Get a session and file + sessions <- list_volume_sessions(vol_id = 1777, vb = FALSE) + skip_if_null_response(sessions, "list_volume_sessions for unassign verbose test") + + if (nrow(sessions) > 0) { + session_id <- sessions$session_id[1] + files <- list_session_assets(vol_id = 1777, session_id = session_id, vb = FALSE) + + if (!is.null(files) && nrow(files) > 0) { + file_id <- files$asset_id[1] + + # Assign first + assign_record_to_file( + vol_id = 1777, + session_id = session_id, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) + + # Unassign with verbose + unassign_result <- unassign_record_from_file( + vol_id = 1777, + session_id = session_id, + file_id = file_id, + record_id = record_id, + vb = TRUE + ) + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + + expect_true(unassign_result) + } + } + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) +}) + +test_that("unassign_record_from_file rejects invalid vol_id", { + expect_error(unassign_record_from_file(vol_id = -1, session_id = 1, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 0, session_id = 1, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = "1", session_id = 1, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = TRUE, session_id = 1, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = c(1, 2), session_id = 1, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1777.5, session_id = 1, file_id = 1, record_id = 1)) +}) + +test_that("unassign_record_from_file rejects invalid session_id", { + expect_error(unassign_record_from_file(vol_id = 1777, session_id = -1, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 0, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = "1", file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = TRUE, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = c(1, 2), file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1.5, file_id = 1, record_id = 1)) +}) + +test_that("unassign_record_from_file rejects invalid file_id", { + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = -1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 0, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = "1", record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = TRUE, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = c(1, 2), record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1.5, record_id = 1)) +}) + +test_that("unassign_record_from_file rejects invalid record_id", { + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = -1)) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 0)) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = "1")) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = TRUE)) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = c(1, 2))) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1.5)) +}) + +test_that("unassign_record_from_file rejects invalid vb parameter", { + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = -1)) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = 3)) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = "a")) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = NULL)) +}) + +test_that("unassign_record_from_file rejects invalid rq parameter", { + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, rq = "a")) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, rq = -1)) + expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, rq = TRUE)) +}) diff --git a/tests/testthat/test-update_volume_record.R b/tests/testthat/test-update_volume_record.R new file mode 100644 index 00000000..810ea162 --- /dev/null +++ b/tests/testthat/test-update_volume_record.R @@ -0,0 +1,109 @@ +# update_volume_record() ------------------------------------------------------- +login_test_account() + +test_that("update_volume_record updates an existing record", { + # First create a record by name + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Initial value", + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for update test") + + record_id <- create_result$record_id + + # Update the record + update_result <- update_volume_record( + vol_id = 1777, + record_id = record_id, + measures = list("29" = "Updated value"), + vb = FALSE + ) + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + + skip_if_null_response(update_result, "update_volume_record") + + expect_type(update_result, "list") + expect_named(update_result, c("record_id", "record_volume", "record_category_id", "measures", "birthday", "age")) + expect_equal(update_result$record_id, record_id) + expect_true(!is.null(update_result$measures)) +}) + +test_that("update_volume_record returns NULL for non-existent record", { + result <- update_volume_record( + vol_id = 1777, + record_id = 999999, + measures = list("29" = "Test"), + vb = FALSE + ) + expect_null(result) +}) + +test_that("update_volume_record works with verbose mode", { + # First create a record + create_result <- create_volume_record( + vol_id = 1777, + category_id = 6, + name = "Update verbose test", + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for update verbose test") + + record_id <- create_result$record_id + + # Update with verbose + update_result <- update_volume_record( + vol_id = 1777, + record_id = record_id, + measures = list("29" = "Test"), + vb = TRUE + ) + + # Clean up + delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + + skip_if_null_response(update_result, "update_volume_record with vb = TRUE") + + expect_type(update_result, "list") +}) + +test_that("update_volume_record rejects invalid vol_id", { + expect_error(update_volume_record(vol_id = -1, record_id = 1)) + expect_error(update_volume_record(vol_id = 0, record_id = 1)) + expect_error(update_volume_record(vol_id = "1", record_id = 1)) + expect_error(update_volume_record(vol_id = TRUE, record_id = 1)) + expect_error(update_volume_record(vol_id = c(1, 2), record_id = 1)) + expect_error(update_volume_record(vol_id = 1777.5, record_id = 1)) +}) + +test_that("update_volume_record rejects invalid record_id", { + expect_error(update_volume_record(vol_id = 1777, record_id = -1)) + expect_error(update_volume_record(vol_id = 1777, record_id = 0)) + expect_error(update_volume_record(vol_id = 1777, record_id = "1")) + expect_error(update_volume_record(vol_id = 1777, record_id = TRUE)) + expect_error(update_volume_record(vol_id = 1777, record_id = c(1, 2))) + expect_error(update_volume_record(vol_id = 1777, record_id = 1.5)) +}) + +test_that("update_volume_record rejects invalid measures", { + expect_error(update_volume_record(vol_id = 1777, record_id = 1, measures = "text")) + expect_error(update_volume_record(vol_id = 1777, record_id = 1, measures = 123)) + expect_error(update_volume_record(vol_id = 1777, record_id = 1, measures = TRUE)) +}) + +test_that("update_volume_record rejects invalid vb parameter", { + expect_error(update_volume_record(vol_id = 1777, record_id = 1, vb = -1)) + expect_error(update_volume_record(vol_id = 1777, record_id = 1, vb = 3)) + expect_error(update_volume_record(vol_id = 1777, record_id = 1, vb = "a")) + expect_error(update_volume_record(vol_id = 1777, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(update_volume_record(vol_id = 1777, record_id = 1, vb = NULL)) +}) + +test_that("update_volume_record rejects invalid rq parameter", { + expect_error(update_volume_record(vol_id = 1777, record_id = 1, rq = "a")) + expect_error(update_volume_record(vol_id = 1777, record_id = 1, rq = -1)) + expect_error(update_volume_record(vol_id = 1777, record_id = 1, rq = TRUE)) +}) From c4b76371b91fb3733916c85c21251dafb7c22e99 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 12 Feb 2026 09:57:55 +0100 Subject: [PATCH 30/77] chore: update workflows and configuration files for linting and coverage --- .github/workflows/R-CMD-check.yaml | 4 +- .github/workflows/lint.yaml | 36 +++++++++++++ .github/workflows/pkgdown.yaml | 4 +- .github/workflows/test-coverage.yaml | 76 ++++++++++++++++++++++++++++ .gitignore | 2 + .lintr | 2 + DESCRIPTION | 5 +- 7 files changed, 124 insertions(+), 5 deletions(-) create mode 100644 .github/workflows/lint.yaml create mode 100644 .github/workflows/test-coverage.yaml create mode 100644 .lintr diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 14159b77..aea61ef6 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -2,9 +2,9 @@ # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: push: - branches: [main, master] + branches: [main, master, staging] pull_request: - branches: [main, master] + branches: [main, master, staging, development] name: R-CMD-check diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml new file mode 100644 index 00000000..185be140 --- /dev/null +++ b/.github/workflows/lint.yaml @@ -0,0 +1,36 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master, staging] + pull_request: + branches: [main, master, staging, development] + +name: lint + +permissions: read-all + +jobs: + lint: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::lintr, any::pkgload, local::. + needs: lint + + - name: Lint + run: | + pkgload::load_all() + lintr::lint_package() + shell: Rscript {0} + env: + LINTR_ERROR_ON_LINT: true diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index a7276e85..7b5b0507 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -2,9 +2,9 @@ # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: push: - branches: [main, master] + branches: [main, master, staging] pull_request: - branches: [main, master] + branches: [main, master, staging, development] release: types: [published] workflow_dispatch: diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml new file mode 100644 index 00000000..32823fb4 --- /dev/null +++ b/.github/workflows/test-coverage.yaml @@ -0,0 +1,76 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master, staging] + pull_request: + branches: [main, master, staging, development] + +name: test-coverage + +permissions: read-all + +jobs: + test-coverage: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::covr, any::xml2, any::rcmdcheck + needs: check, coverage + + - name: Build and check + run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "error") + + - name: Test coverage + run: | + cov <- covr::package_coverage( + quiet = FALSE, + clean = FALSE, + install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") + ) + print(cov) + covr::to_cobertura(cov) + pct <- covr::percent_coverage(cov) + cat("Coverage:", pct, "%\n") + if (pct < 80) { + stop("Coverage is below 80% (", pct, "%)") + } else if (pct < 90) { + warning("Coverage is below 90% (", pct, "%)") + } else { + message("Coverage is above 90% (", pct, "%)") + } + shell: Rscript {0} + + - uses: codecov/codecov-action@v5 + with: + fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} + files: ./cobertura.xml + plugins: noop + disable_search: true + token: ${{ secrets.CODECOV_TOKEN }} + + - name: Show testthat output + if: always() + run: | + ## -------------------------------------------------------------------- + find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true + shell: bash + + - name: Upload test results + if: failure() + uses: actions/upload-artifact@v4 + with: + name: coverage-test-failures + path: ${{ runner.temp }}/package diff --git a/.gitignore b/.gitignore index b7c0678c..9464ec4b 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,5 @@ +.env +.env.* Meta doc .Rproj.user diff --git a/.lintr b/.lintr new file mode 100644 index 00000000..a6c66901 --- /dev/null +++ b/.lintr @@ -0,0 +1,2 @@ +linters: linters_with_defaults(line_length_linter = line_length_linter(120), cyclocomp_linter = NULL) +exclusions: list("_wip", "tests/testthat", "vignettes", "R/CONSTANTS.R" = list(object_name_linter = Inf)) diff --git a/DESCRIPTION b/DESCRIPTION index dd58e65b..2a7befab 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -34,12 +34,15 @@ Imports: xfun (>= 0.41) Suggests: av (>= 0.9.0), + covr (>= 3.6.0), ggplot2, knitr, + lintr (>= 3.0.0), openssl, readr, rmarkdown (>= 2.26), - testthat (>= 3.0.0) + testthat (>= 3.0.0), + xml2 (>= 1.3.0) VignetteBuilder: knitr Config/testthat/edition: 3 From df2486d514f5195c8ccf07bb84328058dfafed92 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 12 Feb 2026 10:03:10 +0100 Subject: [PATCH 31/77] chore: update GitHub workflows for pkgdown and test coverage to improve execution conditions --- .github/workflows/pkgdown.yaml | 16 +++++++++++----- .github/workflows/test-coverage.yaml | 11 ++--------- 2 files changed, 13 insertions(+), 14 deletions(-) diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 7b5b0507..79c26075 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -1,10 +1,11 @@ # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +# Runs after R-CMD-check succeeds on main/master, or on release, or manually on: - push: - branches: [main, master, staging] - pull_request: - branches: [main, master, staging, development] + workflow_run: + workflows: [R-CMD-check] + types: [completed] + branches: [main, master] release: types: [published] workflow_dispatch: @@ -14,15 +15,20 @@ name: pkgdown jobs: pkgdown: runs-on: ubuntu-latest + # Only run when R-CMD-check succeeded (for workflow_run), or for release/manual + if: github.event_name != 'workflow_run' || github.event.workflow_run.conclusion == 'success' # Only restrict concurrency for non-PR jobs concurrency: - group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} + group: pkgdown-${{ github.event_name != 'workflow_run' || github.run_id }} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} permissions: contents: write steps: - uses: actions/checkout@v4 + with: + # When triggered by workflow_run, checkout the commit that was checked + ref: ${{ github.event_name == 'workflow_run' && github.event.workflow_run.head_sha || github.ref }} - uses: r-lib/actions/setup-pandoc@v2 diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 32823fb4..f382f79d 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -1,8 +1,6 @@ # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: - push: - branches: [main, master, staging] pull_request: branches: [main, master, staging, development] @@ -19,19 +17,14 @@ jobs: steps: - uses: actions/checkout@v4 - - uses: r-lib/actions/setup-pandoc@v2 - - uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::covr, any::xml2, any::rcmdcheck - needs: check, coverage - - - name: Build and check - run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "error") + extra-packages: any::covr, any::xml2 + needs: coverage - name: Test coverage run: | From b3a07706b06dc629a7286e421f1ab40adf17bf7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 12 Feb 2026 10:54:01 +0100 Subject: [PATCH 32/77] chore: fixed whitespcaes and docs --- R/CONSTANTS.R | 3 +- R/aaa.R | 3 +- R/api_utils.R | 2 +- R/assign_constants.R | 8 +-- R/auth_state.R | 2 - R/check_ssl_certs.R | 16 +++--- R/download_folder_assets_fr_df.R | 18 +++--- R/download_folder_zip.R | 10 ++-- R/download_session_asset.R | 26 ++++----- R/download_session_assets_fr_df.R | 18 +++--- R/download_session_csv.R | 10 ++-- R/download_session_zip.R | 10 ++-- R/download_single_folder_asset_fr_df.R | 30 +++++----- R/download_single_session_asset_fr_df.R | 34 +++++------ R/download_utils.R | 18 +++--- R/download_video.R | 14 ++--- R/download_volume_zip.R | 2 +- R/get_category_by_id.R | 12 ++-- R/get_db_stats.R | 4 +- R/get_folder_by_id.R | 14 ++--- R/get_folder_file.R | 20 +++---- R/get_funder_by_id.R | 8 +-- R/get_institution_avatar.R | 38 ++++++------- R/get_institution_by_id.R | 5 +- R/get_session_by_id.R | 2 +- R/get_session_by_name.R | 14 ++--- R/get_session_file.R | 16 +++--- R/get_tag_by_id.R | 10 ++-- R/get_user_avatar.R | 34 +++++------ R/get_user_by_id.R | 12 ++-- R/get_volume_by_id.R | 8 +-- R/get_volume_collaborator_by_id.R | 36 ++++++------ R/get_volume_record_by_id.R | 8 +-- R/list_asset_formats.R | 18 +++--- R/list_authorized_investigators.R | 4 +- R/list_categories.R | 10 ++-- R/list_folder_assets.R | 22 ++++---- R/list_institution_affiliates.R | 10 ++-- R/list_institutions.R | 12 ++-- R/list_session_activity.R | 32 +++++------ R/list_session_assets.R | 8 +-- R/list_user_affiliates.R | 7 +-- R/list_user_history.R | 10 ++-- R/list_user_sponsors.R | 12 ++-- R/list_user_volumes.R | 3 +- R/list_users.R | 2 - R/list_volume_activity.R | 6 +- R/list_volume_assets.R | 7 ++- R/list_volume_collaborators.R | 14 ++--- R/list_volume_folders.R | 12 ++-- R/list_volume_funding.R | 12 ++-- R/list_volume_info.R | 8 +-- R/list_volume_links.R | 8 +-- R/list_volume_records.R | 20 +++---- R/list_volume_session_assets.R | 20 +++---- R/list_volume_sessions.R | 16 +++--- R/list_volume_tags.R | 6 +- R/list_volumes.R | 2 - R/login_db.R | 6 +- R/logout_db.R | 8 +-- R/make_default_request.R | 4 +- R/make_login_client.R | 62 ++++++++++----------- R/misc_enums.R | 1 - R/search_for_funder.R | 10 ++-- R/search_for_tags.R | 48 ++++++++-------- R/search_institutions.R | 6 +- R/search_users.R | 2 - R/search_volumes.R | 2 - R/utils.R | 12 ++-- R/whoami.R | 12 ++-- man/assign_constants.Rd | 2 +- man/databraryr-package.Rd | 2 + man/download_folder_asset.Rd | 16 +++--- man/download_folder_assets_fr_df.Rd | 2 +- man/download_folder_zip.Rd | 12 ++-- man/download_session_asset.Rd | 2 +- man/download_session_assets_fr_df.Rd | 9 +-- man/download_session_csv.Rd | 11 ++-- man/download_session_zip.Rd | 8 ++- man/download_single_folder_asset_fr_df.Rd | 2 +- man/download_single_session_asset_fr_df.Rd | 2 +- man/download_video.Rd | 2 +- man/download_volume_zip.Rd | 4 +- man/get_category_by_id.Rd | 2 +- man/get_db_stats.Rd | 10 ++-- man/get_folder_by_id.Rd | 18 ++++-- man/get_folder_file.Rd | 13 +++-- man/get_funder_by_id.Rd | 2 +- man/get_institution_avatar.Rd | 2 +- man/get_institution_by_id.Rd | 4 +- man/get_session_by_id.Rd | 6 +- man/get_session_by_name.Rd | 8 +-- man/get_session_file.Rd | 18 +++--- man/get_tag_by_id.Rd | 2 +- man/get_user_by_id.Rd | 4 +- man/get_volume_by_id.Rd | 4 +- man/get_volume_collaborator_by_id.Rd | 7 ++- man/get_volume_record_by_id.Rd | 6 +- man/list_asset_formats.Rd | 4 +- man/list_authorized_investigators.Rd | 8 ++- man/list_categories.Rd | 2 +- man/list_folder_assets.Rd | 12 ++-- man/list_institution_affiliates.Rd | 6 +- man/list_institutions.Rd | 2 +- man/list_session_activity.Rd | 6 +- man/list_session_assets.Rd | 2 +- man/list_user_affiliates.Rd | 6 +- man/list_user_history.Rd | 4 +- man/list_user_volumes.Rd | 10 ++-- man/list_users.Rd | 2 +- man/list_volume_activity.Rd | 12 ++-- man/list_volume_assets.Rd | 4 +- man/list_volume_collaborators.Rd | 4 +- man/list_volume_folders.Rd | 4 +- man/list_volume_funding.Rd | 2 +- man/list_volume_info.Rd | 6 +- man/list_volume_links.Rd | 4 +- man/list_volume_records.Rd | 2 +- man/list_volume_session_assets.Rd | 4 +- man/list_volume_sessions.Rd | 4 +- man/list_volume_tags.Rd | 4 +- man/list_volumes.Rd | 2 +- man/login_db.Rd | 2 +- man/logout_db.Rd | 4 +- man/make_default_request.Rd | 2 +- man/make_login_client.Rd | 2 +- man/search_for_funder.Rd | 4 +- man/search_for_tags.Rd | 2 +- man/search_institutions.Rd | 2 +- man/search_users.Rd | 2 +- man/search_volumes.Rd | 2 +- man/whoami.Rd | 2 +- tests/testthat/helper-auth.R | 1 - tests/testthat/test-download_folder_asset.R | 12 +++- tests/testthat/test-search_for_tags.R | 2 + tests/testthat/test-utils.R | 5 +- 136 files changed, 642 insertions(+), 617 deletions(-) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 36e1c0b7..66edf75a 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -61,5 +61,6 @@ REQUEST_TIMEOUT_VERY_LONG <- 600 OAUTH_TOKEN_URL <- sprintf("%s/o/token/", DATABRARY_BASE_URL) OAUTH_TEST_URL <- sprintf("%s/oauth2/test/", DATABRARY_BASE_URL) -USER_AGENT <- Sys.getenv("USER_AGENT", "SRW$*Kxy2nYdyo4LozoGV#i6LvH/") +USER_AGENT <- paste0("databraryr/", as.character(utils::packageVersion("databraryr"))) + KEYRING_SERVICE <- 'org.databrary.databraryr' diff --git a/R/aaa.R b/R/aaa.R index 39c050e9..fda75f48 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -17,10 +17,9 @@ NULL devtools.desc = list() ) toset <- !(names(op.devtools) %in% names(op)) - if(any(toset)) options(op.devtools[toset]) + if (any(toset)) options(op.devtools[toset]) invisible() } utils::globalVariables(".data") - diff --git a/R/api_utils.R b/R/api_utils.R index ca95322f..57ad7730 100644 --- a/R/api_utils.R +++ b/R/api_utils.R @@ -180,4 +180,4 @@ validate_flag <- function(value, name) { assertthat::assert_that(length(value) == 1) assertthat::assert_that(is.logical(value), msg = paste0(name, " must be logical.")) } -} \ No newline at end of file +} diff --git a/R/assign_constants.R b/R/assign_constants.R index 7ede9a2d..1d295b92 100644 --- a/R/assign_constants.R +++ b/R/assign_constants.R @@ -1,17 +1,17 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL #' Download Databrary Constants From API. -#' +#' #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to NULL. #' #' @returns A data frame with the constants. -#' +#' #' @inheritParams options_params -#' +#' #' @examples #' \donttest{ #' assign_constants() diff --git a/R/auth_state.R b/R/auth_state.R index 899b8ff4..98c08688 100644 --- a/R/auth_state.R +++ b/R/auth_state.R @@ -70,5 +70,3 @@ require_access_token <- function() { } bundle$access_token } - - diff --git a/R/check_ssl_certs.R b/R/check_ssl_certs.R index 9d49f773..038fdc51 100644 --- a/R/check_ssl_certs.R +++ b/R/check_ssl_certs.R @@ -1,12 +1,12 @@ #' Check SSL Certificates For nyu.databary.org. -#' +#' #' `check_ssl_certs` checks the SSL certificates for nyu.databrary.org #' and returns a data frame with the relevant information. -#' +#' #' @param host Target URL. Defaults to 'nyu.databrary.org'. -#' +#' #' @returns A data frame with information about the SSL certificates. -#' +#' #' @examples #' \donttest{ #' check_ssl_certs() @@ -19,10 +19,10 @@ check_ssl_certs <- function(host = "nyu.databrary.org") { x <- openssl::download_ssl_cert(host) validity_dates <- lapply(x, `[[`, "validity") issuer <- lapply(x, `[[`, "issuer") - + df <- data.frame(issuer = unlist(issuer), - start_date = unlist(lapply(validity_dates, '[[', 1)), - exp_date = unlist(lapply(validity_dates, '[[', 2))) - + start_date = unlist(lapply(validity_dates, "[[", 1)), + exp_date = unlist(lapply(validity_dates, "[[", 2))) + df } diff --git a/R/download_folder_assets_fr_df.R b/R/download_folder_assets_fr_df.R index aa92a404..1e81d85a 100644 --- a/R/download_folder_assets_fr_df.R +++ b/R/download_folder_assets_fr_df.R @@ -58,7 +58,7 @@ download_folder_assets_fr_df <- call. = FALSE ) } - + assertthat::assert_that(length(target_dir) == 1) assertthat::assert_that(is.character(target_dir)) if (dir.exists(target_dir)) { @@ -74,30 +74,30 @@ download_folder_assets_fr_df <- showWarnings = FALSE) } assertthat::is.writeable(target_dir) - + assertthat::assert_that(length(add_folder_subdir) == 1) assertthat::assert_that(is.logical(add_folder_subdir)) - + assertthat::assert_that(length(overwrite) == 1) assertthat::assert_that(is.logical(overwrite)) - + assertthat::assert_that(length(make_portable_fn) == 1) assertthat::assert_that(is.logical(make_portable_fn)) - + assertthat::is.number(timeout_secs) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + if (vb) { message("Downloading n=", nrow(folder_df), " files to ", target_dir) } - + purrr::map( seq_len(nrow(folder_df)), download_single_folder_asset_fr_df, diff --git a/R/download_folder_zip.R b/R/download_folder_zip.R index 9ced2c48..f7d9ce4d 100644 --- a/R/download_folder_zip.R +++ b/R/download_folder_zip.R @@ -11,7 +11,7 @@ NULL #' descriptor. When the archive is ready, Databrary emails a signed download #' link to the authenticated user. #' -#' @param vol_id Volume identifier for the folder. Must be a positive integer. +#' @param vol_id Volume identifier for the folder. Must be a positive integer. #' Default is 1. #' @param folder_id Folder identifier scoped within the specified volume. Must #' be a positive integer. Default is 9807. @@ -39,17 +39,17 @@ download_folder_zip <- function(vol_id = 1, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + assertthat::assert_that(length(folder_id) == 1) assertthat::assert_that(is.numeric(folder_id)) assertthat::assert_that(folder_id >= 1) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + path <- sprintf(API_FOLDER_DOWNLOAD_LINK, vol_id, folder_id) request_processing_task(path = path, rq = rq, vb = vb) } diff --git a/R/download_session_asset.R b/R/download_session_asset.R index ba8c2578..b5aa8c9b 100644 --- a/R/download_session_asset.R +++ b/R/download_session_asset.R @@ -49,40 +49,40 @@ download_session_asset <- function(vol_id = 1, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) - + assertthat::assert_that(length(asset_id) == 1) assertthat::assert_that(is.numeric(asset_id)) assertthat::assert_that(asset_id >= 1) - + if (!is.null(file_name)) { assertthat::assert_that(length(file_name) == 1) assertthat::assert_that(is.character(file_name)) } - + assertthat::assert_that(length(target_dir) == 1) assertthat::assert_that(is.character(target_dir)) assertthat::assert_that(dir.exists(target_dir)) - + assertthat::is.number(timeout_secs) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + path <- sprintf(API_FILES_DOWNLOAD_LINK, vol_id, session_id, asset_id) link <- request_signed_download_link(path = path, rq = rq, vb = vb) - + if (is.null(link)) { return(NULL) } - + resolved_name <- if (!is.null(file_name)) { file_name } else if (!is.null(link$file_name)) { @@ -95,9 +95,9 @@ download_session_asset <- function(vol_id = 1, format(Sys.time(), "%F-%H%M-%S"), ".bin") } - + dest_path <- file.path(target_dir, resolved_name) - + if (file.exists(dest_path)) { dest_path <- file.path(target_dir, paste0( @@ -111,7 +111,7 @@ download_session_asset <- function(vol_id = 1, ) )) } - + download_signed_file( download_url = link$download_url, dest_path = dest_path, diff --git a/R/download_session_assets_fr_df.R b/R/download_session_assets_fr_df.R index e40dece6..c596fb57 100644 --- a/R/download_session_assets_fr_df.R +++ b/R/download_session_assets_fr_df.R @@ -59,7 +59,7 @@ download_session_assets_fr_df <- call. = FALSE ) } - + assertthat::assert_that(length(target_dir) == 1) assertthat::assert_that(is.character(target_dir)) if (dir.exists(target_dir)) { @@ -75,30 +75,30 @@ download_session_assets_fr_df <- showWarnings = FALSE) } assertthat::is.writeable(target_dir) - + assertthat::assert_that(length(add_session_subdir) == 1) assertthat::assert_that(is.logical(add_session_subdir)) - + assertthat::assert_that(length(overwrite) == 1) assertthat::assert_that(is.logical(overwrite)) - + assertthat::assert_that(length(make_portable_fn) == 1) assertthat::assert_that(is.logical(make_portable_fn)) - + assertthat::is.number(timeout_secs) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + if (vb) { message("Downloading n=", nrow(session_df), " files to ", target_dir) } - + purrr::map( seq_len(nrow(session_df)), download_single_session_asset_fr_df, diff --git a/R/download_session_csv.R b/R/download_session_csv.R index 818b43fd..c0ff2462 100644 --- a/R/download_session_csv.R +++ b/R/download_session_csv.R @@ -43,24 +43,24 @@ download_session_csv <- function(vol_id = 1, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + if (!is.null(session_id)) { assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) } - + assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + path <- if (is.null(session_id)) { sprintf(API_VOLUME_CSV_DOWNLOAD_LINK, vol_id) } else { sprintf(API_SESSION_CSV_DOWNLOAD_LINK, vol_id, session_id) } - + request_processing_task(path = path, rq = rq, vb = vb) } diff --git a/R/download_session_zip.R b/R/download_session_zip.R index 3315c10c..f6bb5179 100644 --- a/R/download_session_zip.R +++ b/R/download_session_zip.R @@ -11,7 +11,7 @@ NULL #' summary. Once the archive is ready, Databrary emails a signed download link #' to the authenticated user. #' -#' @param vol_id Volume identifier that owns the session. Must be a positive +#' @param vol_id Volume identifier that owns the session. Must be a positive #' integer. Default is 31. #' @param session_id Session identifier within the volume. Must be a positive #' integer. Default is 9803. @@ -39,16 +39,16 @@ download_session_zip <- function(vol_id = 31, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + path <- sprintf(API_SESSION_DOWNLOAD_LINK, vol_id, session_id) request_processing_task(path = path, rq = rq, vb = vb) } diff --git a/R/download_single_folder_asset_fr_df.R b/R/download_single_folder_asset_fr_df.R index 29ea5637..1a6a4bd8 100644 --- a/R/download_single_folder_asset_fr_df.R +++ b/R/download_single_folder_asset_fr_df.R @@ -39,7 +39,7 @@ download_single_folder_asset_fr_df <- function(i = NULL, assertthat::assert_that(length(i) == 1) assertthat::is.number(i) assertthat::assert_that(i > 0) - + assertthat::assert_that(is.data.frame(folder_df)) required_cols <- c("vol_id", "folder_id", "asset_id", "asset_name") missing_cols <- setdiff(required_cols, names(folder_df)) @@ -50,7 +50,7 @@ download_single_folder_asset_fr_df <- function(i = NULL, call. = FALSE ) } - + assertthat::assert_that(length(target_dir) == 1) assertthat::is.string(target_dir) assertthat::assert_that( @@ -58,20 +58,20 @@ download_single_folder_asset_fr_df <- function(i = NULL, dir.create(target_dir, recursive = TRUE, showWarnings = FALSE) ) assertthat::is.writeable(target_dir) - + validate_flag(add_folder_subdir, "add_folder_subdir") validate_flag(overwrite, "overwrite") validate_flag(make_portable_fn, "make_portable_fn") - + assertthat::is.number(timeout_secs) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + this_asset <- folder_df[i, , drop = FALSE] if (nrow(this_asset) == 0) { if (vb) { @@ -79,7 +79,7 @@ download_single_folder_asset_fr_df <- function(i = NULL, } return(NULL) } - + dest_dir <- if (isTRUE(add_folder_subdir)) { file.path(target_dir, this_asset$folder_id) } else { @@ -88,32 +88,32 @@ download_single_folder_asset_fr_df <- function(i = NULL, dir.create(dest_dir, recursive = TRUE, showWarnings = FALSE) assertthat::assert_that(dir.exists(dest_dir)) assertthat::is.writeable(dest_dir) - + base_name <- this_asset$asset_name if (is.null(base_name) || is.na(base_name) || base_name == "") { base_name <- paste0("asset-", this_asset$asset_id) } - + extension <- "" if ("format_extension" %in% names(this_asset)) { ext_value <- this_asset$format_extension if (!is.null(ext_value) && - !is.na(ext_value) && nzchar(ext_value)) { + !is.na(ext_value) && nzchar(ext_value)) { if (tools::file_ext(base_name) != ext_value) { extension <- paste0(".", ext_value) } } } - + candidate_name <- paste0(base_name, extension) - + if (make_portable_fn) { if (vb) { message("Making file name '", candidate_name, "' portable.") } candidate_name <- make_fn_portable(candidate_name, vb = vb) } - + dest_file <- file.path(dest_dir, candidate_name) if (file.exists(dest_file) && !overwrite) { if (vb) { @@ -133,7 +133,7 @@ download_single_folder_asset_fr_df <- function(i = NULL, ) dest_file <- file.path(dest_dir, candidate_name) } - + download_folder_asset( vol_id = this_asset$vol_id, folder_id = this_asset$folder_id, diff --git a/R/download_single_session_asset_fr_df.R b/R/download_single_session_asset_fr_df.R index 18d84a30..55d26d3a 100644 --- a/R/download_single_session_asset_fr_df.R +++ b/R/download_single_session_asset_fr_df.R @@ -39,7 +39,7 @@ download_single_session_asset_fr_df <- function(i = NULL, assertthat::assert_that(length(i) == 1) assertthat::is.number(i) assertthat::assert_that(i > 0) - + assertthat::assert_that(is.data.frame(session_df)) required_cols <- c("vol_id", "session_id", "asset_id", "asset_name") missing_cols <- setdiff(required_cols, names(session_df)) @@ -50,7 +50,7 @@ download_single_session_asset_fr_df <- function(i = NULL, call. = FALSE ) } - + assertthat::assert_that(length(target_dir) == 1) assertthat::is.string(target_dir) assertthat::assert_that( @@ -58,23 +58,23 @@ download_single_session_asset_fr_df <- function(i = NULL, dir.create(target_dir, recursive = TRUE, showWarnings = FALSE) ) assertthat::is.writeable(target_dir) - + validate_flag(add_session_subdir, "add_session_subdir") validate_flag(overwrite, "overwrite") - - + + assertthat::assert_that(length(make_portable_fn) == 1) assertthat::assert_that(is.logical(make_portable_fn)) - + assertthat::is.number(timeout_secs) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + this_asset <- session_df[i, , drop = FALSE] if (nrow(this_asset) == 0) { if (vb) { @@ -82,7 +82,7 @@ download_single_session_asset_fr_df <- function(i = NULL, } return(NULL) } - + dest_dir <- if (isTRUE(add_session_subdir)) { file.path(target_dir, this_asset$session_id) } else { @@ -91,32 +91,32 @@ download_single_session_asset_fr_df <- function(i = NULL, dir.create(dest_dir, recursive = TRUE, showWarnings = FALSE) assertthat::assert_that(dir.exists(dest_dir)) assertthat::is.writeable(dest_dir) - + base_name <- this_asset$asset_name if (is.null(base_name) || is.na(base_name) || base_name == "") { base_name <- paste0("asset-", this_asset$asset_id) } - + extension <- "" if ("format_extension" %in% names(this_asset)) { ext_value <- this_asset$format_extension if (!is.null(ext_value) && - !is.na(ext_value) && nzchar(ext_value)) { + !is.na(ext_value) && nzchar(ext_value)) { if (tools::file_ext(base_name) != ext_value) { extension <- paste0(".", ext_value) } } } - + candidate_name <- paste0(base_name, extension) - + if (make_portable_fn) { if (vb) { message("Making file name '", candidate_name, "' portable.") } candidate_name <- make_fn_portable(candidate_name, vb = vb) } - + dest_file <- file.path(dest_dir, candidate_name) if (file.exists(dest_file) && !overwrite) { if (vb) { @@ -136,7 +136,7 @@ download_single_session_asset_fr_df <- function(i = NULL, ) dest_file <- file.path(dest_dir, candidate_name) } - + download_session_asset( vol_id = this_asset$vol_id, session_id = this_asset$session_id, diff --git a/R/download_utils.R b/R/download_utils.R index 7f273394..a7189588 100644 --- a/R/download_utils.R +++ b/R/download_utils.R @@ -8,18 +8,18 @@ request_processing_task <- function(path, rq = NULL, vb = FALSE) { vb = vb, normalize = TRUE ) - + if (is.null(task)) { if (vb) { message("Cannot access requested resource on Databrary. Exiting.") } return(NULL) } - + if (vb && !is.null(task$message)) { message(task$message) } - + class(task) <- unique(c("databrary_processing_task", class(task))) task } @@ -32,21 +32,21 @@ request_signed_download_link <- function(path, rq = NULL, vb = FALSE) { vb = vb, normalize = TRUE ) - + if (is.null(link)) { if (vb) { message("Cannot access requested resource on Databrary. Exiting.") } return(NULL) } - + if (is.null(link$download_url)) { if (vb) { message("Download link payload missing 'download_url'.") } return(NULL) } - + link$download_url <- ensure_absolute_url(link$download_url) class(link) <- unique(c("databrary_signed_download", class(link))) link @@ -70,7 +70,7 @@ download_signed_file <- function(download_url, assertthat::assert_that(assertthat::is.string(dest_path)) assertthat::is.number(timeout_secs) assertthat::assert_that(timeout_secs > 0) - + parent_dir <- dirname(dest_path) if (!dir.exists(parent_dir)) { dir.create(parent_dir, recursive = TRUE, showWarnings = FALSE) @@ -83,11 +83,11 @@ download_signed_file <- function(download_url, httr2::req_user_agent(USER_AGENT) |> httr2::req_headers(Authorization = paste("Bearer", token)) |> httr2::req_timeout(seconds = timeout_secs) - + if (vb) { message("Saving download to '", dest_path, "'.") } - + tryCatch( { httr2::req_perform(req, path = dest_path) diff --git a/R/download_video.R b/R/download_video.R index 575fdf04..a5e63cb2 100644 --- a/R/download_video.R +++ b/R/download_video.R @@ -40,15 +40,15 @@ download_video <- function(vol_id = 1, assertthat::assert_that(length(asset_id) == 1) assertthat::assert_that(is.numeric(asset_id)) assertthat::assert_that(asset_id >= 1) - + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) - + assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + if (!is.null(file_name)) { assertthat::assert_that(length(file_name) == 1) assertthat::assert_that(is.character(file_name)) @@ -56,7 +56,7 @@ download_video <- function(vol_id = 1, stop("file_name must end with '.mp4' when provided.", call. = FALSE) } } - + assertthat::assert_that(length(target_dir) == 1) assertthat::assert_that(is.character(target_dir)) assertthat::assert_that( @@ -64,12 +64,12 @@ download_video <- function(vol_id = 1, dir.create(target_dir, recursive = TRUE, showWarnings = FALSE) ) assertthat::is.writeable(target_dir) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - + download_session_asset( vol_id = vol_id, session_id = session_id, diff --git a/R/download_volume_zip.R b/R/download_volume_zip.R index 30c350ac..ed6af949 100644 --- a/R/download_volume_zip.R +++ b/R/download_volume_zip.R @@ -1,6 +1,6 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL #' Request a Signed ZIP Download for a Volume. diff --git a/R/get_category_by_id.R b/R/get_category_by_id.R index ebda2afb..da0827fb 100644 --- a/R/get_category_by_id.R +++ b/R/get_category_by_id.R @@ -36,26 +36,26 @@ get_category_by_id <- function(category_id = 1, assertthat::assert_that(length(category_id) == 1) assertthat::assert_that(category_id > 0) assertthat::assert_that(category_id == floor(category_id), msg = "category_id must be an integer") - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + # Perform API call category <- perform_api_get( path = sprintf(API_CATEGORY_DETAIL, category_id), rq = rq, vb = vb ) - + if (is.null(category)) { if (vb) { message("Category ", category_id, " not found or inaccessible.") } return(NULL) } - + # Process metrics if present metrics <- NULL if (!is.null(category$metrics) && length(category$metrics) > 0) { @@ -72,7 +72,7 @@ get_category_by_id <- function(category_id = 1, ) }) } - + # Return structured list list( category_id = category$id, diff --git a/R/get_db_stats.R b/R/get_db_stats.R index f84d9f1f..5538689a 100644 --- a/R/get_db_stats.R +++ b/R/get_db_stats.R @@ -53,9 +53,9 @@ get_db_stats <- function(type = "stats", vb = options::opt("vb"), rq = NULL) { "numbers" )) { if (vb) - message("Legacy parameter not supported in new API") + message("Legacy parameter not supported in new API") } - + validate_flag(vb, "vb") assertthat::assert_that( diff --git a/R/get_folder_by_id.R b/R/get_folder_by_id.R index b68a2a9b..8b18809f 100644 --- a/R/get_folder_by_id.R +++ b/R/get_folder_by_id.R @@ -5,7 +5,7 @@ NULL #' Get Folder Metadata From a Databrary Volume #' -#' @param folder_id Folder identifier within the specified volume. Default is +#' @param folder_id Folder identifier within the specified volume. Default is #' 9807, the Materials folder for Volume 1. #' @param vol_id Volume identifier containing the folder. Default is 1. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. @@ -30,22 +30,22 @@ get_folder_by_id <- function(folder_id = 9807, assertthat::assert_that(length(folder_id) == 1) assertthat::assert_that(is.numeric(folder_id)) assertthat::assert_that(folder_id >= 1) - + assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + folder <- perform_api_get( path = sprintf(API_FOLDER_DETAIL, vol_id, folder_id), rq = rq, vb = vb ) - + if (is.null(folder)) { if (vb) { message("Cannot access requested folder ", @@ -55,6 +55,6 @@ get_folder_by_id <- function(folder_id = 9807, } return(NULL) } - + folder } diff --git a/R/get_folder_file.R b/R/get_folder_file.R index ba8b272e..99ef910d 100644 --- a/R/get_folder_file.R +++ b/R/get_folder_file.R @@ -4,12 +4,12 @@ NULL #' Get Session File Data From A Databrary Volume -#' +#' #' @description -#' Databrary volumes have folders where study or collection-wide files +#' Databrary volumes have folders where study or collection-wide files #' can be stored and shared. `get_folder_file()` returns metadata about #' specific files stored in a volume folder. -#' +#' #' @param vol_id An integer indicating the volume identifier. Default is 1. #' @param folder_id An integer indicating a valid folder identifier #' linked to a volume. Default value is 9807, the materials folder for volume 1. @@ -40,26 +40,26 @@ get_folder_file <- assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) assertthat::assert_that(length(vol_id) == 1) - + assertthat::assert_that(is.numeric(folder_id)) assertthat::assert_that(folder_id > 0) assertthat::assert_that(length(folder_id) == 1) - + assertthat::assert_that(is.numeric(file_id)) assertthat::assert_that(file_id > 0) assertthat::assert_that(length(file_id) == 1) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + file <- perform_api_get( path = sprintf(API_FOLDER_FILES_DETAIL, vol_id, folder_id, file_id), rq = rq, vb = vb ) - + if (is.null(file)) { if (vb) { message( @@ -73,6 +73,6 @@ get_folder_file <- } return(NULL) } - + file } diff --git a/R/get_funder_by_id.R b/R/get_funder_by_id.R index 138e6194..03490cb1 100644 --- a/R/get_funder_by_id.R +++ b/R/get_funder_by_id.R @@ -35,26 +35,26 @@ get_funder_by_id <- function(funder_id = 1, assertthat::assert_that(length(funder_id) == 1) assertthat::assert_that(funder_id > 0) assertthat::assert_that(funder_id == floor(funder_id), msg = "funder_id must be an integer") - + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + # Perform API call funder <- perform_api_get( path = sprintf(API_FUNDER_DETAIL, funder_id), rq = rq, vb = vb ) - + if (is.null(funder)) { if (vb) { message("Funder ", funder_id, " not found or inaccessible.") } return(NULL) } - + # Return structured list list( funder_id = funder$id, diff --git a/R/get_institution_avatar.R b/R/get_institution_avatar.R index a94b7361..61310ddd 100644 --- a/R/get_institution_avatar.R +++ b/R/get_institution_avatar.R @@ -56,27 +56,27 @@ get_institution_avatar <- function(institution_id = 1, assertthat::assert_that(length(institution_id) == 1) assertthat::assert_that(institution_id > 0) assertthat::assert_that(institution_id == floor(institution_id), msg = "institution_id must be an integer") - + if (!is.null(dest_path)) { assertthat::assert_that(assertthat::is.string(dest_path)) } - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + # Build URL avatar_url <- sprintf(API_INSTITUTION_AVATAR, institution_id) full_url <- paste0(DATABRARY_BASE_URL, avatar_url) - + # Create request if (is.null(rq)) { req <- make_default_request() } else { req <- rq } - + # Build the request with the avatar URL req <- req %>% httr2::req_url(full_url) %>% @@ -85,15 +85,15 @@ get_institution_avatar <- function(institution_id = 1, is_error = function(resp) FALSE ) - + if (vb) { message("Requesting avatar for institution ", institution_id) } - + # Perform request tryCatch({ resp <- httr2::req_perform(req) - + # Check response status status <- httr2::resp_status(resp) if (status != 200) { @@ -108,10 +108,10 @@ get_institution_avatar <- function(institution_id = 1, } return(NULL) } - + # Get raw bytes avatar_bytes <- httr2::resp_body_raw(resp) - + if (is.null(dest_path)) { # Return raw bytes if (vb) { @@ -126,12 +126,12 @@ get_institution_avatar <- function(institution_id = 1, # Try to get filename from content-disposition header filename <- "downloaded_file" content_disp <- httr2::resp_header(resp, "content-disposition") - + if (!is.null(content_disp) && - grepl("filename=", content_disp)) { + grepl("filename=", content_disp)) { # Extract filename from content-disposition header filename_match <- regmatches(content_disp, - regexpr("filename=([^;]+)", content_disp)) + regexpr("filename=([^;]+)", content_disp)) if (length(filename_match) > 0) { filename <- sub("filename=", "", filename_match) filename <- gsub('^"|"$', '', filename) # Remove quotes @@ -142,10 +142,10 @@ get_institution_avatar <- function(institution_id = 1, url_path <- sprintf(API_INSTITUTION_AVATAR, institution_id) filename <- paste0("institution_", institution_id, "_avatar.jpg") } - + final_path <- file.path(dest_path, filename) } - + # Create parent directory if needed parent_dir <- dirname(final_path) if (!dir.exists(parent_dir)) { @@ -153,10 +153,10 @@ get_institution_avatar <- function(institution_id = 1, recursive = TRUE, showWarnings = FALSE) } - + # Save to file writeBin(avatar_bytes, final_path) - + if (vb) { message("Saved avatar to: ", final_path, @@ -164,7 +164,7 @@ get_institution_avatar <- function(institution_id = 1, length(avatar_bytes), " bytes)") } - + return(normalizePath(final_path)) } }, error = function(e) { diff --git a/R/get_institution_by_id.R b/R/get_institution_by_id.R index cfe60e8d..5dcd9baa 100644 --- a/R/get_institution_by_id.R +++ b/R/get_institution_by_id.R @@ -15,9 +15,9 @@ get_institution_by_id <- function(institution_id = 12, vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(is.numeric(institution_id), length(institution_id) == 1, institution_id > 0) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) institution <- perform_api_get( @@ -47,4 +47,3 @@ get_institution_by_id <- function(institution_id = 12, ) %>% as.list() } - diff --git a/R/get_session_by_id.R b/R/get_session_by_id.R index e7d7d1cb..5a5ac236 100644 --- a/R/get_session_by_id.R +++ b/R/get_session_by_id.R @@ -1,6 +1,6 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL #' Get Session (Slot) Data From A Databrary Volume diff --git a/R/get_session_by_name.R b/R/get_session_by_name.R index 6a348a3e..8d039029 100644 --- a/R/get_session_by_name.R +++ b/R/get_session_by_name.R @@ -34,29 +34,29 @@ get_session_by_name <- assertthat::assert_that(assertthat::is.string(session_name)) assertthat::assert_that(length(session_name) == 1) assertthat::assert_that(!is.na(session_name)) - + assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) assertthat::assert_that(length(vol_id) == 1) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + sessions <- collect_paginated_get( path = sprintf(API_VOLUME_SESSIONS, vol_id), params = list(search = session_name), rq = rq, vb = vb ) - + if (is.null(sessions) || length(sessions) == 0) { if (vb) message("No sessions named '", session_name, "' in volume ", vol_id) return(NULL) } - + purrr::map(sessions, function(session) { databraryr::get_session_by_id( session_id = session$id, @@ -65,4 +65,4 @@ get_session_by_name <- rq = rq ) }) - } \ No newline at end of file + } diff --git a/R/get_session_file.R b/R/get_session_file.R index cb4fc389..98798738 100644 --- a/R/get_session_file.R +++ b/R/get_session_file.R @@ -20,7 +20,7 @@ NULL #' @examples #' \donttest{ #' \dontrun{ -#' get_session_file(vol_id = 2, session_id = 11, file_id = 3) +#' get_session_file(vol_id = 2, session_id = 11, file_id = 3) #' # A video from volume 1, session 11. #' } #' } @@ -34,26 +34,26 @@ get_session_file <- assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) assertthat::assert_that(length(vol_id) == 1) - + assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id > 0) assertthat::assert_that(length(session_id) == 1) - + assertthat::assert_that(is.numeric(file_id)) assertthat::assert_that(file_id > 0) assertthat::assert_that(length(file_id) == 1) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + file <- perform_api_get( path = sprintf(API_SESSION_FILE_DETAIL, vol_id, session_id, file_id), rq = rq, vb = vb ) - + if (is.null(file)) { if (vb) { message( @@ -67,6 +67,6 @@ get_session_file <- } return(NULL) } - + file } diff --git a/R/get_tag_by_id.R b/R/get_tag_by_id.R index 4044c698..356b13e7 100644 --- a/R/get_tag_by_id.R +++ b/R/get_tag_by_id.R @@ -35,24 +35,24 @@ get_tag_by_id <- function(tag_id = 1, assertthat::assert_that(length(tag_id) == 1) assertthat::assert_that(tag_id > 0) assertthat::assert_that(tag_id == floor(tag_id), msg = "tag_id must be an integer") - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + # Perform API call tag <- perform_api_get(path = sprintf(API_TAG_DETAIL, tag_id), rq = rq, vb = vb) - + if (is.null(tag)) { if (vb) { message("Tag ", tag_id, " not found or inaccessible.") } return(NULL) } - + # Return structured list list(tag_id = tag$id, tag_name = tag$name) } diff --git a/R/get_user_avatar.R b/R/get_user_avatar.R index e7f555d9..dad8dc59 100644 --- a/R/get_user_avatar.R +++ b/R/get_user_avatar.R @@ -48,28 +48,28 @@ get_user_avatar <- function(user_id, assertthat::assert_that(is.numeric(user_id) || is.integer(user_id)) assertthat::assert_that(user_id > 0) - + if (!is.null(dest_path)) { assertthat::assert_that(assertthat::is.string(dest_path)) } - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + # Build URL path path <- sprintf(API_USER_AVATAR, user_id) - + if (vb) { message("Getting user avatar for user ID: ", user_id) } - + # Set up request if (is.null(rq)) { rq <- make_default_request() } - + # Perform request resp <- tryCatch({ rq |> @@ -85,11 +85,11 @@ get_user_avatar <- function(user_id, } return(NULL) }) - + if (is.null(resp)) { return(NULL) } - + # Check for errors if (httr2::resp_status(resp) != 200) { if (vb) { @@ -98,10 +98,10 @@ get_user_avatar <- function(user_id, } return(NULL) } - + # Get avatar bytes avatar_bytes <- httr2::resp_body_raw(resp) - + # If no destination path, return bytes if (is.null(dest_path)) { if (vb) { @@ -111,7 +111,7 @@ get_user_avatar <- function(user_id, } return(avatar_bytes) } - + # Save to file # Resolve destination path # If dest_path is a directory, determine filename from response headers or URL @@ -120,9 +120,9 @@ get_user_avatar <- function(user_id, # Try to get filename from content-disposition header filename <- "downloaded_file" content_disp <- httr2::resp_header(resp, "content-disposition") - + if (!is.null(content_disp) && - grepl("filename=", content_disp)) { + grepl("filename=", content_disp)) { # Extract filename from content-disposition header filename_match <- regmatches(content_disp, regexpr("filename=([^;]+)", content_disp)) @@ -136,16 +136,16 @@ get_user_avatar <- function(user_id, url_path <- sprintf(API_USER_AVATAR, user_id) filename <- paste0("user_", user_id, "_avatar.jpg") } - + final_path <- file.path(dest_path, filename) } - + # Ensure parent directory exists parent_dir <- dirname(final_path) if (!dir.exists(parent_dir)) { dir.create(parent_dir, recursive = TRUE) } - + # Write to file tryCatch({ writeBin(avatar_bytes, final_path) diff --git a/R/get_user_by_id.R b/R/get_user_by_id.R index d200c133..a7698bb0 100644 --- a/R/get_user_by_id.R +++ b/R/get_user_by_id.R @@ -15,28 +15,28 @@ get_user_by_id <- function(user_id = 6, vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(is.numeric(user_id), length(user_id) == 1, user_id > 0) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + user <- perform_api_get( path = sprintf(API_USER_DETAIL, user_id), rq = rq, vb = vb ) - + if (is.null(user)) { if (vb) message("User ", user_id, " not found or inaccessible.") return(NULL) } - + affiliation <- user$affiliation institution_name <- affiliation$name institution_id <- affiliation$id - + tibble::tibble( id = user$id, prename = user$first_name, diff --git a/R/get_volume_by_id.R b/R/get_volume_by_id.R index 78196edf..71a906ec 100644 --- a/R/get_volume_by_id.R +++ b/R/get_volume_by_id.R @@ -27,12 +27,12 @@ get_volume_by_id <- function(vol_id = 1, assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) assertthat::assert_that(length(vol_id) == 1) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - + if (vb) message("Retrieving data for vol_id ", vol_id, ".") @@ -72,4 +72,4 @@ get_volume_by_id <- function(vol_id = 1, file_counts = list(volume$file_counts), thumbnail = list(purrr::pluck(volume, "thumbnail", .default = NULL)) ) -} \ No newline at end of file +} diff --git a/R/get_volume_collaborator_by_id.R b/R/get_volume_collaborator_by_id.R index 452b26db..27549b49 100644 --- a/R/get_volume_collaborator_by_id.R +++ b/R/get_volume_collaborator_by_id.R @@ -11,7 +11,7 @@ NULL #' level, and visibility settings. #' #' @param vol_id Target volume number. Must be a positive integer. Default is 1. -#' @param collaborator_id Numeric collaborator identifier. +#' @param collaborator_id Numeric collaborator identifier. #' Must be a positive integer. Default is 1. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. @@ -42,24 +42,24 @@ get_volume_collaborator_by_id <- function(vol_id = 1, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(vol_id >= 1) assertthat::assert_that(vol_id == floor(vol_id), msg = "vol_id must be an integer") - + assertthat::assert_that(is.numeric(collaborator_id)) assertthat::assert_that(length(collaborator_id) == 1) assertthat::assert_that(collaborator_id > 0) assertthat::assert_that(collaborator_id == floor(collaborator_id), msg = "collaborator_id must be an integer") - + validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + # Perform API call collaborator <- perform_api_get( path = sprintf(API_VOLUME_COLLABORATOR_DETAIL, vol_id, collaborator_id), rq = rq, vb = vb ) - + if (is.null(collaborator)) { if (vb) { message( @@ -72,7 +72,7 @@ get_volume_collaborator_by_id <- function(vol_id = 1, } return(NULL) } - + # Process user information user <- NULL if (!is.null(collaborator$user)) { @@ -85,7 +85,7 @@ get_volume_collaborator_by_id <- function(vol_id = 1, has_avatar = collaborator$user$has_avatar ) } - + # Process sponsor information sponsor <- NULL if (!is.null(collaborator$sponsor)) { @@ -96,7 +96,7 @@ get_volume_collaborator_by_id <- function(vol_id = 1, email = collaborator$sponsor$email ) } - + # Process sponsorship information sponsorship <- NULL if (!is.null(collaborator$sponsorship)) { @@ -107,21 +107,21 @@ get_volume_collaborator_by_id <- function(vol_id = 1, status = collaborator$sponsorship$status ) } - + # Process sponsored_users if present sponsored_users <- NULL if (!is.null(collaborator$sponsored_users) && length(collaborator$sponsored_users) > 0) { - sponsored_users <- lapply(collaborator$sponsored_users, function(u) { - list( - user_id = u$id, - first_name = u$first_name, - last_name = u$last_name, - email = u$email - ) - }) + sponsored_users <- lapply(collaborator$sponsored_users, function(u) { + list( + user_id = u$id, + first_name = u$first_name, + last_name = u$last_name, + email = u$email + ) + }) } - + # Return structured list list( collaborator_id = collaborator$id, diff --git a/R/get_volume_record_by_id.R b/R/get_volume_record_by_id.R index 18cf7c24..5b49e535 100644 --- a/R/get_volume_record_by_id.R +++ b/R/get_volume_record_by_id.R @@ -33,10 +33,10 @@ NULL #' } #' @export get_volume_record_by_id <- function( - vol_id = 1, - record_id = 1, - vb = options::opt("vb"), - rq = NULL) { + vol_id = 1, + record_id = 1, + vb = options::opt("vb"), + rq = NULL) { assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(vol_id >= 1) diff --git a/R/list_asset_formats.R b/R/list_asset_formats.R index ce2fda06..32e8e0ea 100644 --- a/R/list_asset_formats.R +++ b/R/list_asset_formats.R @@ -1,19 +1,19 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL #' List Stored Assets (Files) By Type. -#' +#' #' @description List the data (file) formats supported by Databrary. -#' +#' #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. -#' +#' #' @returns A data frame with information about the data formats Databrary #' supports. -#' +#' #' @inheritParams options_params -#' +#' #' @examples #' \donttest{ #' list_asset_formats() @@ -22,15 +22,15 @@ NULL list_asset_formats <- function(vb = options::opt("vb")) { # Check parameters validate_flag(vb, "vb") - + db_constants <- databraryr::assign_constants() - + id <- NULL mimetype <- NULL extension <- NULL name <- NULL transcodable <- NULL - + if (!is.null(db_constants$format)) { purrr::map(db_constants$format, as.data.frame) %>% purrr::list_rbind() %>% diff --git a/R/list_authorized_investigators.R b/R/list_authorized_investigators.R index 3992ded3..c81ea92e 100644 --- a/R/list_authorized_investigators.R +++ b/R/list_authorized_investigators.R @@ -24,12 +24,12 @@ list_authorized_investigators <- function(institution_id = 12, validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + affiliates <- list_institution_affiliates(institution_id, vb = vb, rq = rq) if (is.null(affiliates)) { return(NULL) } - + investigators <- affiliates |> dplyr::filter(.data$role == "investigator") if (nrow(investigators) == 0) { return(NULL) diff --git a/R/list_categories.R b/R/list_categories.R index b0c67f51..481bd1c4 100644 --- a/R/list_categories.R +++ b/R/list_categories.R @@ -33,23 +33,23 @@ list_categories <- function(vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + # Perform API call categories <- perform_api_get(path = API_CATEGORIES, rq = rq, vb = vb) - + if (is.null(categories) || length(categories) == 0) { if (vb) { message("No categories available.") } return(NULL) } - + # Process categories into tibble purrr::map_dfr(categories, function(category) { # Process metrics if present metrics <- NULL if (!is.null(category$metrics) && - length(category$metrics) > 0) { + length(category$metrics) > 0) { metrics <- lapply(category$metrics, function(metric) { list( metric_id = metric$id, @@ -63,7 +63,7 @@ list_categories <- function(vb = options::opt("vb"), rq = NULL) { ) }) } - + tibble::tibble( category_id = category$id, category_name = category$name, diff --git a/R/list_folder_assets.R b/R/list_folder_assets.R index e37c643f..9f1ffb63 100644 --- a/R/list_folder_assets.R +++ b/R/list_folder_assets.R @@ -31,51 +31,51 @@ list_folder_assets <- function(folder_id = 9807, assertthat::assert_that(length(folder_id) == 1) assertthat::assert_that(is.numeric(folder_id)) assertthat::assert_that(folder_id >= 1) - + if (is.null(vol_id)) { stop( "vol_id must be supplied for list_folder_assets(); folder identifiers are scoped to volumes.", call. = FALSE ) } - + assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + folder <- databraryr::get_folder_by_id( folder_id = folder_id, vol_id = vol_id, vb = vb, rq = rq ) - + if (is.null(folder)) { return(NULL) } - + files <- collect_paginated_get( path = sprintf(API_FOLDER_FILES, vol_id, folder_id), rq = rq, vb = vb ) - + if (is.null(files) || length(files) == 0) { if (vb) { message("No assets for folder_id ", folder_id) } return(NULL) } - + file_rows <- purrr::map_dfr(files, function(file) { format <- file$format uploader <- file$uploader - + tibble::tibble( asset_id = file$id, asset_name = file$name, @@ -95,7 +95,7 @@ list_folder_assets <- function(folder_id = 9807, asset_thumbnail_url = file$thumbnail_url ) }) - + file_rows %>% dplyr::mutate( folder_id = folder_id, diff --git a/R/list_institution_affiliates.R b/R/list_institution_affiliates.R index ff8afe19..63d7c1c9 100644 --- a/R/list_institution_affiliates.R +++ b/R/list_institution_affiliates.R @@ -19,24 +19,24 @@ list_institution_affiliates <- function(institution_id = 12, assertthat::assert_that(is.numeric(institution_id), length(institution_id) == 1, institution_id > 0) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + affiliates <- collect_paginated_get( path = sprintf(API_INSTITUTION_AFFILIATES, institution_id), rq = rq, vb = vb ) - + if (is.null(affiliates) || length(affiliates) == 0) { if (vb) message("No affiliates for institution ", institution_id) return(NULL) } - + purrr::map_dfr(affiliates, function(entry) { user <- entry$user tibble::tibble( diff --git a/R/list_institutions.R b/R/list_institutions.R index 7eab34c5..1ab9923c 100644 --- a/R/list_institutions.R +++ b/R/list_institutions.R @@ -40,18 +40,18 @@ list_institutions <- function(search_string = NULL, if (!is.null(search_string)) { assertthat::assert_that(assertthat::is.string(search_string)) } - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + # Build params list params <- list() if (!is.null(search_string)) { params$search <- search_string } - + # Perform API call with pagination results <- collect_paginated_get( path = API_INSTITUTIONS_LIST, @@ -59,7 +59,7 @@ list_institutions <- function(search_string = NULL, rq = rq, vb = vb ) - + if (is.null(results) || length(results) == 0) { if (vb) { if (is.null(search_string)) { @@ -70,7 +70,7 @@ list_institutions <- function(search_string = NULL, } return(NULL) } - + # Process results into tibble purrr::map_dfr(results, function(entry) { tibble::tibble( diff --git a/R/list_session_activity.R b/R/list_session_activity.R index f1a9cf12..985f12f4 100644 --- a/R/list_session_activity.R +++ b/R/list_session_activity.R @@ -36,35 +36,35 @@ list_session_activity <- assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) - + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id > 0) - + assertthat::assert_that(length(vb) == 1) validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + if (is.null(rq)) { rq <- databraryr::make_default_request() } rq <- httr2::req_timeout(rq, REQUEST_TIMEOUT_VERY_LONG) - + activities <- collect_paginated_get( path = sprintf(API_VOLUME_HISTORY, vol_id), rq = rq, vb = vb ) - + if (is.null(activities) || length(activities) == 0) { if (vb) { message("No activity history available for volume ", vol_id) } return(NULL) } - + session_details <- databraryr::get_session_by_id( session_id = session_id, vol_id = vol_id, @@ -75,7 +75,7 @@ list_session_activity <- if (!is.null(session_details)) { session_name <- session_details$name } - + session_entries <- purrr::keep(activities, function(entry) { session_identifier <- entry$session_id if (is.null(session_identifier) && !is.null(entry$session)) { @@ -86,18 +86,18 @@ list_session_activity <- session_identifier <- session_value } } - + if (!is.null(session_identifier)) { return(isTRUE(session_identifier == session_id)) } - + if (!is.null(session_name) && !is.null(entry$name)) { return(isTRUE(entry$name == session_name)) } - + FALSE }) - + if (length(session_entries) == 0) { if (vb) { message("No activity history for session ", @@ -107,7 +107,7 @@ list_session_activity <- } return(NULL) } - + purrr::map_dfr(session_entries, function(entry) { history_user <- entry$history_user folder_id <- entry$folder_id @@ -119,21 +119,21 @@ list_session_activity <- folder_id <- folder } } - + safe_int <- function(value) { if (is.null(value)) NA_integer_ else value } - + safe_chr <- function(value) { if (is.null(value)) NA_character_ else value } - + tibble::tibble( event_type = entry$type, event_timestamp = entry$timestamp, diff --git a/R/list_session_assets.R b/R/list_session_assets.R index 1a5d0c71..dfeb536c 100644 --- a/R/list_session_assets.R +++ b/R/list_session_assets.R @@ -46,12 +46,12 @@ list_session_assets <- function(session_id = 9807, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - + session <- databraryr::get_session_by_id( session_id = session_id, vol_id = vol_id, @@ -107,4 +107,4 @@ list_session_assets <- function(session_id = 9807, session_release = session$release_level, session_date = session$source_date ) -} \ No newline at end of file +} diff --git a/R/list_user_affiliates.R b/R/list_user_affiliates.R index f8c84af9..1b41dc7a 100644 --- a/R/list_user_affiliates.R +++ b/R/list_user_affiliates.R @@ -8,7 +8,7 @@ NULL #' @param user_id User identifier. Must be an integer. Default is 6. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. -#' +#' #' @inheritParams options_params #' #' @return Tibble of affiliates for the user. @@ -20,10 +20,10 @@ list_user_affiliates <- function(user_id = 6, assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + affiliates <- collect_paginated_get( path = sprintf(API_USER_AFFILIATES, user_id), rq = rq, @@ -44,4 +44,3 @@ list_user_affiliates <- function(user_id = 6, ) }) } - diff --git a/R/list_user_history.R b/R/list_user_history.R index a132ff55..d1c9d3c2 100644 --- a/R/list_user_history.R +++ b/R/list_user_history.R @@ -31,25 +31,25 @@ list_user_history <- function(user_id = 22582, assertthat::assert_that(is.numeric(user_id)) assertthat::assert_that(length(user_id) == 1) assertthat::assert_that(user_id > 0) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + history <- collect_paginated_get( path = sprintf(API_USERS_HISTORY, user_id), rq = rq, vb = vb ) - + if (is.null(history) || length(history) == 0) { if (vb) { message("No activity history available for user ", user_id) } return(NULL) } - + purrr::map_dfr(history, function(entry) { tibble::tibble( user_id = user_id, diff --git a/R/list_user_sponsors.R b/R/list_user_sponsors.R index 012232a9..49d30c57 100644 --- a/R/list_user_sponsors.R +++ b/R/list_user_sponsors.R @@ -16,26 +16,26 @@ list_user_sponsors <- function(user_id = 6, assertthat::assert_that(is.numeric(user_id), length(user_id) == 1, user_id > 0) assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + sponsorships <- collect_paginated_get( path = sprintf(API_USER_SPONSORSHIPS, user_id), rq = rq, vb = vb ) - + if (is.null(sponsorships) || length(sponsorships) == 0) { if (vb) message("No sponsorships for user ", user_id) return(NULL) } - + user <- get_user_by_id(user_id, vb = vb, rq = rq) - + purrr::map_dfr(sponsorships, function(entry) { sponsor <- entry$user tibble::tibble( diff --git a/R/list_user_volumes.R b/R/list_user_volumes.R index 33124e87..02fd5f2a 100644 --- a/R/list_user_volumes.R +++ b/R/list_user_volumes.R @@ -8,7 +8,7 @@ NULL #' @param user_id User identifier. Must be a positive integer. Default is 6. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Default is NULL. -#' +#' #' @inheritParams options_params #' #' @return Tibble of volumes the user owns or collaborates on. @@ -54,4 +54,3 @@ list_user_volumes <- function(user_id = 6, user_affiliation = user_df$affiliation) %>% dplyr::arrange(vol_id) } - diff --git a/R/list_users.R b/R/list_users.R index 86fbf48a..cac373eb 100644 --- a/R/list_users.R +++ b/R/list_users.R @@ -105,5 +105,3 @@ list_users <- function(search = NULL, ) }) } - - diff --git a/R/list_volume_activity.R b/R/list_volume_activity.R index 04a896ac..a4c8cd7f 100644 --- a/R/list_volume_activity.R +++ b/R/list_volume_activity.R @@ -22,7 +22,7 @@ NULL #' # The following will only return output if the user has *write* privileges #' # on the volume. #' -#' list_volume_activity(vol_id) +#' list_volume_activity(vol_id) #' } #' } #' @export @@ -34,9 +34,9 @@ list_volume_activity <- assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) - + validate_flag(vb, "vb") - + validate_flag(vb, "vb") if (vb) message('list_volume_activity()...') diff --git a/R/list_volume_assets.R b/R/list_volume_assets.R index 68a92e0b..9d626bb8 100644 --- a/R/list_volume_assets.R +++ b/R/list_volume_assets.R @@ -27,9 +27,9 @@ list_volume_assets <- function(vol_id = 1, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + validate_flag(vb, "vb") - + sessions <- collect_paginated_get( path = sprintf(API_VOLUME_SESSIONS, vol_id), rq = rq, @@ -79,7 +79,8 @@ list_volume_assets <- function(vol_id = 1, ) }, .progress = TRUE) %>% purrr::list_rbind() - }) %>% purrr::list_rbind() + }) %>% + purrr::list_rbind() if (is.null(files) || nrow(files) == 0) { if (vb) diff --git a/R/list_volume_collaborators.R b/R/list_volume_collaborators.R index 451c6e38..2521c149 100644 --- a/R/list_volume_collaborators.R +++ b/R/list_volume_collaborators.R @@ -30,29 +30,29 @@ list_volume_collaborators <- function(vol_id = 1, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + collaborators <- perform_api_get( path = sprintf(API_VOLUME_COLLABORATORS, vol_id), rq = rq, vb = vb ) - + if (is.null(collaborators) || length(collaborators) == 0) { if (vb) { message("No collaborators found for volume ", vol_id) } return(NULL) } - + purrr::map_dfr(collaborators, function(entry) { user <- entry$user sponsor <- entry$sponsor - + sponsor_id <- if (!is.null(sponsor)) sponsor$id else @@ -69,7 +69,7 @@ list_volume_collaborators <- function(vol_id = 1, sponsor$email else NA_character_ - + tibble::tibble( collaborator_id = entry$id, volume_id = vol_id, diff --git a/R/list_volume_folders.R b/R/list_volume_folders.R index 00d3f184..fcdb0009 100644 --- a/R/list_volume_folders.R +++ b/R/list_volume_folders.R @@ -27,31 +27,31 @@ list_volume_folders <- function(vol_id = 1, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + folders <- collect_paginated_get( path = sprintf(API_VOLUME_FOLDERS, vol_id), rq = rq, vb = vb ) - + if (is.null(folders) || length(folders) == 0) { if (vb) { message("No folders available for volume ", vol_id) } return(NULL) } - + purrr::map_dfr(folders, function(folder) { volume_value <- folder$volume if (is.null(volume_value)) { volume_value <- vol_id } - + tibble::tibble( folder_id = folder$id, folder_name = folder$name, diff --git a/R/list_volume_funding.R b/R/list_volume_funding.R index 4155ff41..a5c9d64f 100644 --- a/R/list_volume_funding.R +++ b/R/list_volume_funding.R @@ -32,29 +32,29 @@ list_volume_funding <- function(vol_id = 1, # Check parameters assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(sum(vol_id >= 1) == length(vol_id)) - + assertthat::assert_that(length(add_id) == 1) assertthat::assert_that(is.logical(add_id)) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) if (vb) message("Summarizing funding for n=", length(vol_id), " volumes.") - + purrr::map(vol_id, function(id) { fundings <- perform_api_get( path = sprintf(API_VOLUME_FUNDINGS, id), rq = rq, vb = vb ) - + if (is.null(fundings) || length(fundings) == 0) { return(NULL) } - + rows <- purrr::map_dfr(fundings, function(entry) { funder <- entry$funder tibble::tibble( diff --git a/R/list_volume_info.R b/R/list_volume_info.R index 8db32a45..ce40175a 100644 --- a/R/list_volume_info.R +++ b/R/list_volume_info.R @@ -21,7 +21,7 @@ NULL #' list_volume_info() # Sessions in Volume 1 #' } #' } -#' +#' #' @export list_volume_info <- function(vol_id = 1, @@ -31,12 +31,12 @@ list_volume_info <- assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - + volume <- databraryr::get_volume_by_id(vol_id = vol_id, vb = vb, rq = rq) if (is.null(volume)) { return(NULL) diff --git a/R/list_volume_links.R b/R/list_volume_links.R index d243b44b..6d61eb29 100644 --- a/R/list_volume_links.R +++ b/R/list_volume_links.R @@ -27,19 +27,19 @@ list_volume_links <- function(vol_id = 1, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) - + validate_flag(vb, "vb") - + links <- perform_api_get( path = sprintf(API_VOLUME_LINKS, vol_id), rq = rq, vb = vb ) - + if (is.null(links) || length(links) == 0) { return(NULL) } - + purrr::map_dfr(links, function(link) { tibble::tibble( link_id = link$id, diff --git a/R/list_volume_records.R b/R/list_volume_records.R index 27f7ce31..6e252b34 100644 --- a/R/list_volume_records.R +++ b/R/list_volume_records.R @@ -43,25 +43,25 @@ list_volume_records <- function(vol_id = 1, assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) assertthat::assert_that(vol_id == floor(vol_id), msg = "vol_id must be an integer") - + if (!is.null(category_id)) { assertthat::assert_that(length(category_id) == 1) assertthat::assert_that(is.numeric(category_id)) assertthat::assert_that(category_id > 0) assertthat::assert_that(category_id == floor(category_id), msg = "category_id must be an integer") } - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + # Build params list params <- list() if (!is.null(category_id)) { params$category_id <- category_id } - + # Perform API call records <- collect_paginated_get( path = sprintf(API_VOLUME_RECORDS, vol_id), @@ -69,7 +69,7 @@ list_volume_records <- function(vol_id = 1, rq = rq, vb = vb ) - + if (is.null(records) || length(records) == 0) { if (vb) { message("No records found with category_id = ", @@ -79,7 +79,7 @@ list_volume_records <- function(vol_id = 1, } return(NULL) } - + if (vb) message( "Found n = ", @@ -89,7 +89,7 @@ list_volume_records <- function(vol_id = 1, " in volume ", vol_id ) - + # Process records into tibble purrr::map_dfr(records, function(record) { # Process age if present @@ -100,7 +100,7 @@ list_volume_records <- function(vol_id = 1, age_formatted <- NA_character_ age_is_estimated <- NA age_is_blurred <- NA - + if (!is.null(record$age)) { age_years <- if (!is.null(record$age$years)) { record$age$years @@ -138,7 +138,7 @@ list_volume_records <- function(vol_id = 1, NA } } - + tibble::tibble( record_id = record$id, record_volume = record$volume, diff --git a/R/list_volume_session_assets.R b/R/list_volume_session_assets.R index 7ade992b..e930aff0 100644 --- a/R/list_volume_session_assets.R +++ b/R/list_volume_session_assets.R @@ -37,34 +37,34 @@ list_volume_session_assets <- assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - + session <- perform_api_get( path = sprintf(API_SESSION_DETAIL, vol_id, session_id), rq = rq, vb = vb ) - + if (is.null(session)) { if (vb) message("No matching session_id: ", session_id) return(NULL) } - + files <- collect_paginated_get( path = sprintf(API_SESSION_FILES, vol_id, session_id), rq = rq, vb = vb ) - + if (is.null(files) || length(files) == 0) { if (vb) message("No assets in vol_id ", vol_id, " session_id ", session_id) @@ -77,11 +77,11 @@ list_volume_session_assets <- vol_id, " session_id ", session_id) - + asset_rows <- purrr::map(files, function(file) { format <- file$format uploader <- file$uploader - + tibble::tibble( asset_id = file$id, asset_name = file$name, @@ -104,6 +104,6 @@ list_volume_session_assets <- ) }) %>% purrr::list_rbind() - + asset_rows } diff --git a/R/list_volume_sessions.R b/R/list_volume_sessions.R index 3c132991..3da26bf3 100644 --- a/R/list_volume_sessions.R +++ b/R/list_volume_sessions.R @@ -1,6 +1,6 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL #' List Sessions in Databrary Volume. @@ -14,7 +14,7 @@ NULL #' to be returned. #' #' @returns A data frame with information about all assets in a volume. -#' +#' #' @inheritParams options_params #' #' @examples @@ -33,16 +33,16 @@ list_volume_sessions <- assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + assertthat::assert_that(is.logical(include_vol_data)) assertthat::assert_that(length(include_vol_data) == 1) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - - + + sessions <- collect_paginated_get( path = sprintf(API_VOLUME_SESSIONS, vol_id), rq = rq, @@ -70,7 +70,7 @@ list_volume_sessions <- session_has_full_access = session$has_full_access ) }) - + if (include_vol_data) { volume <- perform_api_get( path = sprintf(API_VOLUME_DETAIL, vol_id), diff --git a/R/list_volume_tags.R b/R/list_volume_tags.R index a1a325fd..b137e028 100644 --- a/R/list_volume_tags.R +++ b/R/list_volume_tags.R @@ -25,12 +25,12 @@ list_volume_tags <- function(vol_id = 1, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - + tags <- perform_api_get( path = sprintf(API_VOLUME_TAGS, vol_id), rq = rq, diff --git a/R/list_volumes.R b/R/list_volumes.R index 11d23b60..0dc8c6b2 100644 --- a/R/list_volumes.R +++ b/R/list_volumes.R @@ -85,5 +85,3 @@ list_volumes <- function(search = NULL, ) }, .progress = TRUE) } - - diff --git a/R/login_db.R b/R/login_db.R index 71b33ce4..f43e3329 100644 --- a/R/login_db.R +++ b/R/login_db.R @@ -1,7 +1,7 @@ #' Log In To Databrary.org. #' #' @param email Databrary account email address. -#' @param password Databrary password (not recommended as it will displayed +#' @param password Databrary password (not recommended as it will displayed #' as you type) #' @param client_id OAuth2 client identifier. #' @param client_secret OAuth2 client secret. @@ -23,7 +23,7 @@ #'# The following shows how to use credentials that have been stored previously. #' #' login_db(email = "you@provider.com", store = TRUE) -#' +#' #' } #' } #' @export @@ -40,7 +40,7 @@ login_db <- function(email = NULL, validate_flag(vb, "vb") assertthat::assert_that(length(SERVICE) == 1, is.character(SERVICE)) - # If the user wants to store or use their stored credentials, + # If the user wants to store or use their stored credentials, # check for keyring support if (store) { assertthat::assert_that(keyring::has_keyring_support(), diff --git a/R/logout_db.R b/R/logout_db.R index cd0d42e5..dae85120 100644 --- a/R/logout_db.R +++ b/R/logout_db.R @@ -1,16 +1,16 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL #' Log Out of Databrary.org. #' #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. -#' +#' #' @returns TRUE if logging out succeeds, FALSE otherwise. -#' +#' #' @inheritParams options_params -#' +#' #' @examples #' \donttest{ #' logout_db() diff --git a/R/make_default_request.R b/R/make_default_request.R index 428d061a..5866c638 100644 --- a/R/make_default_request.R +++ b/R/make_default_request.R @@ -18,7 +18,7 @@ make_default_request <- function(with_token = TRUE, refresh = TRUE, vb = options::opt("vb")) { - + validate_flag(with_token, "with_token") validate_flag(refresh, "refresh") validate_flag(vb, "vb") @@ -41,4 +41,4 @@ make_default_request <- function(with_token = TRUE, } httr2::req_headers(req, Authorization = paste("Bearer", token)) -} \ No newline at end of file +} diff --git a/R/make_login_client.R b/R/make_login_client.R index 6dfc20d4..4d896281 100644 --- a/R/make_login_client.R +++ b/R/make_login_client.R @@ -1,6 +1,6 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL #' Log In To Databrary.org. @@ -12,11 +12,11 @@ NULL #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param SERVICE A character label for stored credentials in the keyring. Default is "databrary" #' @param rq An `httr2` request object. Defaults to NULL. -#' +#' #' @returns Logical value indicating whether log in is successful or not. -#' +#' #' @inheritParams options_params -#' +#' #' @examplesIf interactive() #' make_login_client() # Queries user for email and password interactively. #' @examples @@ -27,30 +27,30 @@ NULL #' make_login_client(email = "you@provider.com", store = TRUE) #' } #' } -#' +#' #' @export make_login_client <- function(email = NULL, - password = NULL, - store = FALSE, - overwrite = FALSE, - vb = options::opt("vb"), - SERVICE = KEYRING_SERVICE, - rq = NULL) { - + password = NULL, + store = FALSE, + overwrite = FALSE, + vb = options::opt("vb"), + SERVICE = KEYRING_SERVICE, + rq = NULL) { + # Check parameters assertthat::assert_that(length(store) == 1) assertthat::assert_that(is.logical(store)) - + validate_flag(store, "store") validate_flag(overwrite, "overwrite") validate_flag(vb, "vb") - + assertthat::assert_that(length(SERVICE) == 1) assertthat::assert_that(is.character(SERVICE)) - + assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - + # Handle NULL request if (is.null(rq)) { if (vb) { @@ -58,13 +58,13 @@ make_login_client <- function(email = NULL, } rq <- databraryr::make_default_request() } - + # If the user wants to store or use their stored credentials, check for keyring support if (store) { assertthat::assert_that(keyring::has_keyring_support(), msg = "No keyring support; please use store=FALSE") } - + # Check or get email if (!is.null(email)) { assertthat::assert_that(assertthat::is.string(email)) @@ -72,14 +72,14 @@ make_login_client <- function(email = NULL, message("Please enter your Databrary user ID (email).") email <- readline(prompt = "Email: ") } - + do_collect_password <- TRUE - + if (!is.null(password)) { assertthat::assert_that(assertthat::is.string(password)) do_collect_password <- FALSE } - + # If the user wants to store or use their stored credentials and # doesn't provide a password if (store && is.null(password) && !overwrite) { @@ -110,35 +110,35 @@ make_login_client <- function(email = NULL, "'.") } } - + # If we need to, securely collect the password if (do_collect_password) { password <- getPass::getPass("Please enter your Databrary password ") } - + is_login_successful <- FALSE - + if (is.null(rq)) rq <- make_default_request() - + rq <- rq %>% httr2::req_url(LOGIN) %>% httr2::req_body_json(list(email = email, password = password)) - + resp <- tryCatch( httr2::req_perform(rq), httr2_error = function(cnd) NULL ) - + if (!is.null(resp)) { is_login_successful <- TRUE } else { return(NULL) } - - # If the username/password was successful and the user wanted to store + + # If the username/password was successful and the user wanted to store # their credentials # Store them in the keyring if (is_login_successful) { @@ -154,7 +154,7 @@ make_login_client <- function(email = NULL, } #return(resp) } - + if (store) { if (vb) message( @@ -166,7 +166,7 @@ make_login_client <- function(email = NULL, ) } else { if (vb) - message(paste0('Login failed; HTTP status ', + message(paste0('Login failed; HTTP status ', httr2::resp_status(resp), '\n')) } resp diff --git a/R/misc_enums.R b/R/misc_enums.R index e5920cde..b17eb49f 100644 --- a/R/misc_enums.R +++ b/R/misc_enums.R @@ -40,4 +40,3 @@ get_release_levels_enums <- function() { ) ) } - diff --git a/R/search_for_funder.R b/R/search_for_funder.R index 622a76da..4942f072 100644 --- a/R/search_for_funder.R +++ b/R/search_for_funder.R @@ -30,18 +30,18 @@ search_for_funder <- assertthat::assert_that(is.character(search_string)) search_string <- gsub("[+]", " ", search_string) pattern <- stringr::str_trim(search_string) - + validate_flag(approved_only, "approved_only") validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - + params <- list() if (!approved_only) { params$all <- "true" } - + funders <- collect_paginated_get( path = API_FUNDERS, params = params, @@ -53,7 +53,7 @@ search_for_funder <- if (vb) message("No funders available from API.") return(NULL) } - + funder_tbl <- purrr::map_dfr(funders, function(entry) { tibble::tibble( funder_id = entry$id, diff --git a/R/search_for_tags.R b/R/search_for_tags.R index f08705e3..4a0c6751 100644 --- a/R/search_for_tags.R +++ b/R/search_for_tags.R @@ -1,6 +1,6 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL #' Search For Tags on Volumes or Sessions. @@ -10,7 +10,7 @@ NULL #' @param rq An `httr2` request object. Default is NULL. #' #' @returns An array of tags that match the tag_string. -#' +#' #' @inheritParams options_params #' #' @examples @@ -26,31 +26,31 @@ search_for_tags <- # Check parameters assertthat::assert_that(length(search_string) == 1) assertthat::assert_that(is.character(search_string)) - + validate_flag(vb, "vb") - + assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - - results <- collect_paginated_get( - path = API_SEARCH_VOLUMES, - params = list(tag = search_string), - rq = rq, - vb = vb - ) - if (is.null(results) || length(results) == 0) { - if (vb) message("No volumes tagged '", search_string, "'.") - return(NULL) - } - - purrr::map_dfr(results, function(entry) { - tibble::tibble( - vol_id = entry$id, - vol_title = entry$title, - vol_sharing_level = entry$sharing_level, - vol_tags = list(entry$tags), - score = entry$score + results <- collect_paginated_get( + path = API_SEARCH_VOLUMES, + params = list(tag = search_string), + rq = rq, + vb = vb ) - }) + + if (is.null(results) || length(results) == 0) { + if (vb) message("No volumes tagged '", search_string, "'.") + return(NULL) + } + + purrr::map_dfr(results, function(entry) { + tibble::tibble( + vol_id = entry$id, + vol_title = entry$title, + vol_sharing_level = entry$sharing_level, + vol_tags = list(entry$tags), + score = entry$score + ) + }) } diff --git a/R/search_institutions.R b/R/search_institutions.R index 8bb9abee..bf2672c5 100644 --- a/R/search_institutions.R +++ b/R/search_institutions.R @@ -32,14 +32,14 @@ search_institutions <- function(search_string, validate_flag(vb, "vb") assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - + results <- collect_paginated_get( path = API_SEARCH_INSTITUTIONS, params = list(q = search_string), rq = rq, vb = vb ) - + if (is.null(results) || length(results) == 0) { if (vb) { message("No institutions matched the search query '", @@ -48,7 +48,7 @@ search_institutions <- function(search_string, } return(NULL) } - + purrr::map_dfr(results, function(entry) { tibble::tibble( institution_id = entry$id, diff --git a/R/search_users.R b/R/search_users.R index 79b228eb..fb44ea44 100644 --- a/R/search_users.R +++ b/R/search_users.R @@ -60,5 +60,3 @@ search_users <- function(search_string, ) }) } - - diff --git a/R/search_volumes.R b/R/search_volumes.R index 1c1d67fb..3ec73fcd 100644 --- a/R/search_volumes.R +++ b/R/search_volumes.R @@ -78,5 +78,3 @@ search_volumes <- function(search_string, ) }) } - - diff --git a/R/utils.R b/R/utils.R index c2723162..2826dab2 100644 --- a/R/utils.R +++ b/R/utils.R @@ -43,7 +43,7 @@ HHMMSSmmm_to_ms <- function(HHMMSSmmm = "01:01:01:333") { if (!is.character(HHMMSSmmm)) { stop("HHMMSSmmm must be a string.") } - + if (stringr::str_detect(HHMMSSmmm, "([0-9]{2}):([0-9]{2}):([0-9]{2}):([0-9]{3})")) { time_segs <- stringr::str_match(HHMMSSmmm, "([0-9]{2}):([0-9]{2}):([0-9]{2}):([0-9]{3})") @@ -72,7 +72,7 @@ get_release_levels <- function(vb = options::opt("vb")) { validate_flag(vb, "vb") enums <- get_release_levels_enums() vapply(enums$levels, function(item) - item$code, character(1)) + item$code, character(1)) } #---------------------------------------------------------------------------- @@ -121,15 +121,15 @@ make_fn_portable <- function(fn, assertthat::assert_that(!is.numeric(fn)) assertthat::assert_that(!is.logical(fn)) assertthat::assert_that(length(fn) == 1) - + validate_flag(vb, "vb") - + assertthat::is.string(replace_regex) assertthat::assert_that(length(replace_regex) == 1) - + assertthat::is.string(replacement_char) assertthat::assert_that(length(replacement_char) == 1) - + if (vb) { non_portable_chars <- stringr::str_detect(fn, replace_regex) message("There are ", sum(non_portable_chars), " in ", fn) diff --git a/R/whoami.R b/R/whoami.R index 7647f3e4..deda9f9a 100644 --- a/R/whoami.R +++ b/R/whoami.R @@ -23,7 +23,7 @@ whoami <- function(refresh = TRUE, vb = options::opt("vb")) { validate_flag(refresh, "refresh") validate_flag(vb, "vb") - + req <- tryCatch( make_default_request(refresh = refresh, vb = vb), error = function(err) { @@ -32,11 +32,11 @@ whoami <- function(refresh = TRUE, NULL } ) - + if (is.null(req)) { return(NULL) } - + resp <- tryCatch( req |> httr2::req_url(OAUTH_TEST_URL) |> @@ -57,17 +57,17 @@ whoami <- function(refresh = TRUE, NULL } ) - + if (is.null(resp)) { return(NULL) } - + status <- httr2::resp_status(resp) if (status >= 400) { if (vb) message(httr2_error_message(resp)) return(NULL) } - + httr2::resp_body_json(resp, simplifyVector = TRUE) } diff --git a/man/assign_constants.Rd b/man/assign_constants.Rd index 7ba52784..99803e21 100644 --- a/man/assign_constants.Rd +++ b/man/assign_constants.Rd @@ -7,7 +7,7 @@ assign_constants(vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to NULL.} } diff --git a/man/databraryr-package.Rd b/man/databraryr-package.Rd index e743c6b8..ce3dcf64 100644 --- a/man/databraryr-package.Rd +++ b/man/databraryr-package.Rd @@ -25,12 +25,14 @@ Useful links: Authors: \itemize{ \item Jeffrey Spies \email{cran@jeffspies.com} + \item Pawel pawel.armatys@montrosesoftware.com Armatys } Other contributors: \itemize{ \item National Science Foundation OAC-2032713 [funder] \item National Institutes of Health R01HD094830 [funder] + \item National Science Foundation BCS 2444730, 2444731 [funder] } } diff --git a/man/download_folder_asset.Rd b/man/download_folder_asset.Rd index 5c6e01ac..c662673b 100644 --- a/man/download_folder_asset.Rd +++ b/man/download_folder_asset.Rd @@ -6,9 +6,9 @@ \usage{ download_folder_asset( vol_id = 1, - folder_id = 1, + folder_id = 9807, asset_id = 1, - file_name = NULL, + file_name = "video.mp4", target_dir = tempdir(), timeout_secs = REQUEST_TIMEOUT, vb = options::opt("vb"), @@ -18,9 +18,11 @@ download_folder_asset( \arguments{ \item{vol_id}{Integer. Volume identifier containing the folder. Default is 1.} -\item{folder_id}{Integer. Folder identifier within the volume. Default is 1.} +\item{folder_id}{Integer. Folder identifier within the volume. Default is 9807, +the Materials folder for Volume 1.} -\item{asset_id}{Integer. Asset identifier within the folder. Default is 1.} +\item{asset_id}{Integer. Asset identifier within the folder. Default is 1, a +demo video called 'counting_demo_video.mp4'.} \item{file_name}{Optional character string. File name to use when saving the asset. Defaults to the API-provided file name.} @@ -31,7 +33,7 @@ Default is \code{tempdir()}.} \item{timeout_secs}{Numeric. Timeout (seconds) applied to the download request. Default is \code{REQUEST_TIMEOUT}.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Default is \code{NULL}, in which case a default authenticated request is generated.} @@ -49,8 +51,8 @@ specified directory. \donttest{ \dontrun{ download_folder_asset() # Default public asset in folder 1 of volume 1 -download_folder_asset(vol_id = 1, folder_id = 2, asset_id = 3, - file_name = "example.mp4") +download_folder_asset(vol_id = 1, folder_id = 9807, asset_id = 1, + file_name = "video.mp4") } } diff --git a/man/download_folder_assets_fr_df.Rd b/man/download_folder_assets_fr_df.Rd index 73992878..aa3a3edc 100644 --- a/man/download_folder_assets_fr_df.Rd +++ b/man/download_folder_assets_fr_df.Rd @@ -33,7 +33,7 @@ directory already exists.} \item{timeout_secs}{Numeric. Timeout applied to each download request.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An optional \code{httr2} request object reused when requesting signed links.} diff --git a/man/download_folder_zip.Rd b/man/download_folder_zip.Rd index 84e1714a..09ff1eab 100644 --- a/man/download_folder_zip.Rd +++ b/man/download_folder_zip.Rd @@ -6,17 +6,19 @@ \usage{ download_folder_zip( vol_id = 1, - folder_id = 1, + folder_id = 9807, vb = options::opt("vb"), rq = NULL ) } \arguments{ -\item{vol_id}{Volume identifier for the folder.} +\item{vol_id}{Volume identifier for the folder. Must be a positive integer. +Default is 1.} -\item{folder_id}{Folder identifier scoped within the specified volume.} +\item{folder_id}{Folder identifier scoped within the specified volume. Must +be a positive integer. Default is 9807.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Default is \code{NULL}, in which case a default authenticated request is generated.} @@ -34,7 +36,7 @@ link to the authenticated user. \examples{ \donttest{ \dontrun{ -download_folder_zip(vol_id = 1, folder_id = 1) +download_folder_zip() # Volume 1, folder 9807 } } diff --git a/man/download_session_asset.Rd b/man/download_session_asset.Rd index 5f6369ba..5e9fccf3 100644 --- a/man/download_session_asset.Rd +++ b/man/download_session_asset.Rd @@ -31,7 +31,7 @@ Default is \code{tempdir()}.} \item{timeout_secs}{Numeric. Timeout (seconds) applied to the download request. Default is \code{REQUEST_TIMEOUT}.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Default is \code{NULL}, in which case a default authenticated request is generated.} diff --git a/man/download_session_assets_fr_df.Rd b/man/download_session_assets_fr_df.Rd index 48c7b46f..661ab45c 100644 --- a/man/download_session_assets_fr_df.Rd +++ b/man/download_session_assets_fr_df.Rd @@ -5,7 +5,7 @@ \title{Download Multiple Assets From a Session Data Frame.} \usage{ download_session_assets_fr_df( - session_df = list_session_assets(), + session_df = list_session_assets(session_id = 9224, vol_id = 1), target_dir = tempdir(), add_session_subdir = TRUE, overwrite = TRUE, @@ -17,7 +17,8 @@ download_session_assets_fr_df( } \arguments{ \item{session_df}{Data frame describing assets. Must include \code{vol_id}, -\code{session_id}, \code{asset_id}, and \code{asset_name} columns.} +\code{session_id}, \code{asset_id}, and \code{asset_name} columns. Default is the result +\code{download_session_assets_fr_df(session_id = assets, vol_id = 1)}.} \item{target_dir}{Character string. Base directory for downloads. Defaults to \code{tempdir()}.} @@ -33,7 +34,7 @@ directory already exists.} \item{timeout_secs}{Numeric. Timeout applied to each download request.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An optional \code{httr2} request object reused when requesting signed links.} @@ -50,7 +51,7 @@ links for each asset and saving them to disk. Designed to work with \examples{ \donttest{ \dontrun{ -assets <- list_session_assets(vol_id = 1, session_id = 9807) +assets <- list_session_assets(vol_id = 1, session_id = 9224) download_session_assets_fr_df(assets, vb = TRUE) } } diff --git a/man/download_session_csv.Rd b/man/download_session_csv.Rd index 74eea14c..6d67cc74 100644 --- a/man/download_session_csv.Rd +++ b/man/download_session_csv.Rd @@ -12,12 +12,13 @@ download_session_csv( ) } \arguments{ -\item{vol_id}{Integer. Target volume identifier. Default is 1.} +\item{vol_id}{Integer. Target volume identifier. Default is 2.} \item{session_id}{Optional integer. When provided, requests a session-level -CSV export. When \code{NULL}, a volume-level CSV export is requested.} +CSV export. When \code{NULL}, a volume-level CSV export is requested. Default is +9.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Default is \code{NULL}, meaning a default authenticated request is generated.} @@ -36,10 +37,10 @@ download link via email once the export is ready. \donttest{ \dontrun{ # Request a volume-wide CSV export -download_session_csv(vol_id = 1) +download_session_csv() # CSV for default volume 2 # Request a session-specific CSV export -download_session_csv(vol_id = 1, session_id = 9807) +download_session_csv(vol_id = 2, session_id = 9) } } diff --git a/man/download_session_zip.Rd b/man/download_session_zip.Rd index ab5bb17f..a53f0902 100644 --- a/man/download_session_zip.Rd +++ b/man/download_session_zip.Rd @@ -12,11 +12,13 @@ download_session_zip( ) } \arguments{ -\item{vol_id}{Volume identifier that owns the session.} +\item{vol_id}{Volume identifier that owns the session. Must be a positive +integer. Default is 31.} -\item{session_id}{Session identifier within the volume.} +\item{session_id}{Session identifier within the volume. Must be a positive +integer. Default is 9803.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Default is \code{NULL}, in which case a default authenticated request is generated.} diff --git a/man/download_single_folder_asset_fr_df.Rd b/man/download_single_folder_asset_fr_df.Rd index ebf17e1d..4d3c0167 100644 --- a/man/download_single_folder_asset_fr_df.Rd +++ b/man/download_single_folder_asset_fr_df.Rd @@ -34,7 +34,7 @@ timestamped suffix.} \item{timeout_secs}{Numeric. Timeout applied to the signed download request.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{Optional \code{httr2} request object reused to request signed links.} } diff --git a/man/download_single_session_asset_fr_df.Rd b/man/download_single_session_asset_fr_df.Rd index 0bdd37ad..a43b0fd5 100644 --- a/man/download_single_session_asset_fr_df.Rd +++ b/man/download_single_session_asset_fr_df.Rd @@ -34,7 +34,7 @@ timestamped suffix.} \item{timeout_secs}{Numeric. Timeout applied to the signed download request.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{Optional \code{httr2} request object reused to request signed links.} } diff --git a/man/download_video.Rd b/man/download_video.Rd index a7796623..a48eebe1 100644 --- a/man/download_video.Rd +++ b/man/download_video.Rd @@ -27,7 +27,7 @@ value.} \item{target_dir}{Directory to save the downloaded file. Defaults to \code{tempdir()}.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{Optional \code{httr2} request object reused when requesting the signed link.} diff --git a/man/download_volume_zip.Rd b/man/download_volume_zip.Rd index c6034724..1bfc95ed 100644 --- a/man/download_volume_zip.Rd +++ b/man/download_volume_zip.Rd @@ -7,9 +7,9 @@ download_volume_zip(vol_id = 31, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vol_id}{Volume identifier.} +\item{vol_id}{An integer. Volume identifier. Default is 31.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Default is \code{NULL}, in which case a default authenticated request is generated.} diff --git a/man/get_category_by_id.Rd b/man/get_category_by_id.Rd index a5c08edc..ff27efda 100644 --- a/man/get_category_by_id.Rd +++ b/man/get_category_by_id.Rd @@ -9,7 +9,7 @@ get_category_by_id(category_id = 1, vb = options::opt("vb"), rq = NULL) \arguments{ \item{category_id}{Numeric category identifier. Must be a positive integer.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/get_db_stats.Rd b/man/get_db_stats.Rd index 7011ec67..3036c764 100644 --- a/man/get_db_stats.Rd +++ b/man/get_db_stats.Rd @@ -2,14 +2,14 @@ % Please edit documentation in R/get_db_stats.R \name{get_db_stats} \alias{get_db_stats} -\title{Get Stats About Databrary.} +\title{Get Stats About Databrary} \usage{ get_db_stats(type = "stats", vb = options::opt("vb"), rq = NULL) } \arguments{ \item{type}{Type of Databrary report to run "institutions", "people", "data"} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose messages. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object.} } @@ -18,14 +18,12 @@ A data frame with the requested data or NULL if there is no new information. } \description{ -\code{get_db_stats} returns basic summary information about -the institutions, people, and data hosted on 'Databrary.org'. +Returns basic summary information about +the institutions, people, and video data hosted on Databrary. } \examples{ \donttest{ get_db_stats() get_db_stats("stats") -get_db_stats("people") # Information about the newest authorized investigators. -get_db_stats("places") # Information about the newest institutions. } } diff --git a/man/get_folder_by_id.Rd b/man/get_folder_by_id.Rd index 938b3e5c..e42bb1e1 100644 --- a/man/get_folder_by_id.Rd +++ b/man/get_folder_by_id.Rd @@ -2,16 +2,22 @@ % Please edit documentation in R/get_folder_by_id.R \name{get_folder_by_id} \alias{get_folder_by_id} -\title{Get Folder Metadata From a Databrary Volume.} +\title{Get Folder Metadata From a Databrary Volume} \usage{ -get_folder_by_id(folder_id = 1, vol_id = 1, vb = options::opt("vb"), rq = NULL) +get_folder_by_id( + folder_id = 9807, + vol_id = 1, + vb = options::opt("vb"), + rq = NULL +) } \arguments{ -\item{folder_id}{Folder identifier within the specified volume.} +\item{folder_id}{Folder identifier within the specified volume. Default is +9807, the Materials folder for Volume 1.} -\item{vol_id}{Volume identifier containing the folder.} +\item{vol_id}{Volume identifier containing the folder. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } @@ -20,7 +26,7 @@ A list representing the folder metadata, or \code{NULL} when the folder cannot be accessed. } \description{ -Get Folder Metadata From a Databrary Volume. +Get Folder Metadata From a Databrary Volume } \examples{ \donttest{ diff --git a/man/get_folder_file.Rd b/man/get_folder_file.Rd index 41889851..522d5cda 100644 --- a/man/get_folder_file.Rd +++ b/man/get_folder_file.Rd @@ -7,7 +7,7 @@ get_folder_file( vol_id = 1, folder_id = 9807, - file_id, + file_id = 1, vb = options::opt("vb"), rq = NULL ) @@ -18,9 +18,9 @@ get_folder_file( \item{folder_id}{An integer indicating a valid folder identifier linked to a volume. Default value is 9807, the materials folder for volume 1.} -\item{file_id}{An integer indicating the file identifier.} +\item{file_id}{An integer indicating the file identifier. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An httr2 request object.} } @@ -30,12 +30,15 @@ in to Databrary via \code{login_db()}, then files that have restricted access can be downloaded, subject to the sharing release levels on those files. } \description{ -Get Session File Data From A Databrary Volume +Databrary volumes have folders where study or collection-wide files +can be stored and shared. \code{get_folder_file()} returns metadata about +specific files stored in a volume folder. } \examples{ \donttest{ \dontrun{ -get_folder_file(vol_id = 2, folder_id = 11, file_id = 1) +get_folder_file() # Data about file_id 1 from folder_id 9807 in Volume 1. +get_folder_file(vol_id = 2, folder_id = 9819, file_id = 16) # A PDF from Volume 2. } } } diff --git a/man/get_funder_by_id.Rd b/man/get_funder_by_id.Rd index 70c66bd5..a063202c 100644 --- a/man/get_funder_by_id.Rd +++ b/man/get_funder_by_id.Rd @@ -9,7 +9,7 @@ get_funder_by_id(funder_id = 1, vb = options::opt("vb"), rq = NULL) \arguments{ \item{funder_id}{Numeric funder identifier. Must be a positive integer.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/get_institution_avatar.Rd b/man/get_institution_avatar.Rd index b3f3ada1..91cbb58f 100644 --- a/man/get_institution_avatar.Rd +++ b/man/get_institution_avatar.Rd @@ -21,7 +21,7 @@ provided, the filename will be determined from the response headers or will default to \verb{institution__avatar.jpg}. If \code{NULL} (the default), the raw image bytes are returned instead of being saved to disk.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/get_institution_by_id.Rd b/man/get_institution_by_id.Rd index 8da21c89..924650c8 100644 --- a/man/get_institution_by_id.Rd +++ b/man/get_institution_by_id.Rd @@ -7,9 +7,9 @@ get_institution_by_id(institution_id = 12, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{institution_id}{Institution identifier.} +\item{institution_id}{Institution identifier. Must be a positive integer.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} } \value{ List of institution metadata or NULL when inaccessible. diff --git a/man/get_session_by_id.Rd b/man/get_session_by_id.Rd index 0648ee79..500aad0d 100644 --- a/man/get_session_by_id.Rd +++ b/man/get_session_by_id.Rd @@ -5,7 +5,7 @@ \title{Get Session (Slot) Data From A Databrary Volume} \usage{ get_session_by_id( - session_id = 9807, + session_id = 6256, vol_id = 1, vb = options::opt("vb"), rq = NULL @@ -13,11 +13,11 @@ get_session_by_id( } \arguments{ \item{session_id}{An integer indicating a valid session/slot identifier -linked to a volume. Default value is 9807, the materials folder for volume 1.} +linked to a volume. Default value is 6256 in volume 1.} \item{vol_id}{An integer indicating the volume identifier. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An httr2 request object.} } diff --git a/man/get_session_by_name.Rd b/man/get_session_by_name.Rd index 9ef0b913..9117ddd9 100644 --- a/man/get_session_by_name.Rd +++ b/man/get_session_by_name.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/get_session_by_name.R \name{get_session_by_name} \alias{get_session_by_name} -\title{Get Session (Slot) Data From A Databrary Volume By Session Name.} +\title{Get Session Data From A Databrary Volume By Session Name.} \usage{ get_session_by_name( session_name = "Advisory Board Meeting", @@ -15,9 +15,9 @@ get_session_by_name( \item{session_name}{A string. The name of the target session. Defaults to "Advisory Board Meeting", the name of several of the sessions in the public Volume 1.} -\item{vol_id}{An integer indicating the volume identifier. Default is 1.} +\item{vol_id}{Volume identifier. Must be an integer. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An httr2 request, such as that generated by \code{make_default_request()}.} } @@ -26,7 +26,7 @@ One or more JSON blobs (as lists) whose session name(s) match \code{name} in the given volume. } \description{ -Get Session (Slot) Data From A Databrary Volume By Session Name. +Get Session Data From A Databrary Volume By Session Name. } \examples{ \donttest{ diff --git a/man/get_session_file.Rd b/man/get_session_file.Rd index 041298ad..86493e21 100644 --- a/man/get_session_file.Rd +++ b/man/get_session_file.Rd @@ -6,8 +6,8 @@ \usage{ get_session_file( vol_id = 1, - session_id = 9807, - file_id, + session_id = 9578, + file_id = 27227, vb = options::opt("vb"), rq = NULL ) @@ -16,18 +16,17 @@ get_session_file( \item{vol_id}{An integer indicating the volume identifier. Default is 1.} \item{session_id}{An integer indicating a valid session/slot identifier -linked to a volume. Default value is 9807, the materials folder for volume 1.} +linked to a volume. Default value is 9578.} -\item{file_id}{An integer indicating the file identifier.} +\item{file_id}{An integer indicating the file identifier. The default is +27227.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An httr2 request object.} } \value{ -A JSON blob with the file data. If the user has previously logged -in to Databrary via \code{login_db()}, then files that have restricted access -can be downloaded, subject to the sharing release levels on those files. +Metadata about the file if the user has read privileges. } \description{ Get Session File Data From A Databrary Volume @@ -35,7 +34,8 @@ Get Session File Data From A Databrary Volume \examples{ \donttest{ \dontrun{ -get_session_file(vol_id = 2, session_id = 11, file_id = 1) +get_session_file(vol_id = 2, session_id = 11, file_id = 3) +# A video from volume 1, session 11. } } } diff --git a/man/get_tag_by_id.Rd b/man/get_tag_by_id.Rd index 4c0d0e3a..74381393 100644 --- a/man/get_tag_by_id.Rd +++ b/man/get_tag_by_id.Rd @@ -9,7 +9,7 @@ get_tag_by_id(tag_id = 1, vb = options::opt("vb"), rq = NULL) \arguments{ \item{tag_id}{Numeric tag identifier. Must be a positive integer.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/get_user_by_id.Rd b/man/get_user_by_id.Rd index d4cc223b..f730942b 100644 --- a/man/get_user_by_id.Rd +++ b/man/get_user_by_id.Rd @@ -7,9 +7,9 @@ get_user_by_id(user_id = 6, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{user_id}{User identifier.} +\item{user_id}{User identifier. Must be a positive integer. Default is 6.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} } \value{ A list with the user's public metadata. diff --git a/man/get_volume_by_id.Rd b/man/get_volume_by_id.Rd index 01d71a72..91505b60 100644 --- a/man/get_volume_by_id.Rd +++ b/man/get_volume_by_id.Rd @@ -7,9 +7,9 @@ get_volume_by_id(vol_id = 1, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vol_id}{Volume ID.} +\item{vol_id}{Volume ID. Must be a positive integer. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. If NULL (the default), a new request is generated using \code{make_default_request()}. To access restricted data, diff --git a/man/get_volume_collaborator_by_id.Rd b/man/get_volume_collaborator_by_id.Rd index a79fd428..9cfeda45 100644 --- a/man/get_volume_collaborator_by_id.Rd +++ b/man/get_volume_collaborator_by_id.Rd @@ -12,11 +12,12 @@ get_volume_collaborator_by_id( ) } \arguments{ -\item{vol_id}{Target volume number. Must be a positive integer.} +\item{vol_id}{Target volume number. Must be a positive integer. Default is 1.} -\item{collaborator_id}{Numeric collaborator identifier. Must be a positive integer.} +\item{collaborator_id}{Numeric collaborator identifier. +Must be a positive integer. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/get_volume_record_by_id.Rd b/man/get_volume_record_by_id.Rd index 9ed51ad8..15844a68 100644 --- a/man/get_volume_record_by_id.Rd +++ b/man/get_volume_record_by_id.Rd @@ -12,11 +12,11 @@ get_volume_record_by_id( ) } \arguments{ -\item{vol_id}{Target volume number. Must be a positive integer.} +\item{vol_id}{Target volume number. Must be a positive integer. Default is 1.} -\item{record_id}{Numeric record identifier. Must be a positive integer.} +\item{record_id}{Numeric record identifier. Must be a positive integer. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/list_asset_formats.Rd b/man/list_asset_formats.Rd index c41f2c24..07960491 100644 --- a/man/list_asset_formats.Rd +++ b/man/list_asset_formats.Rd @@ -7,14 +7,14 @@ list_asset_formats(vb = options::opt("vb")) } \arguments{ -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} } \value{ A data frame with information about the data formats Databrary supports. } \description{ -List Stored Assets (Files) By Type. +List the data (file) formats supported by Databrary. } \examples{ \donttest{ diff --git a/man/list_authorized_investigators.Rd b/man/list_authorized_investigators.Rd index 3c59939c..226dbc8a 100644 --- a/man/list_authorized_investigators.Rd +++ b/man/list_authorized_investigators.Rd @@ -11,13 +11,15 @@ list_authorized_investigators( ) } \arguments{ -\item{institution_id}{Institution identifier.} +\item{institution_id}{Institution identifier. Must be a positive integer. Default is 12.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } \value{ Tibble of investigators; NULL if none. } \description{ -List authorized investigators for an institution +Lists the authorized investigators at an institution. } diff --git a/man/list_categories.Rd b/man/list_categories.Rd index 1bce307c..2a1aed90 100644 --- a/man/list_categories.Rd +++ b/man/list_categories.Rd @@ -7,7 +7,7 @@ list_categories(vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/list_folder_assets.Rd b/man/list_folder_assets.Rd index 7e2745a1..c18d9e88 100644 --- a/man/list_folder_assets.Rd +++ b/man/list_folder_assets.Rd @@ -5,18 +5,20 @@ \title{List Assets Within a Databrary Folder.} \usage{ list_folder_assets( - folder_id = 1, - vol_id = NULL, + folder_id = 9807, + vol_id = 1, vb = options::opt("vb"), rq = NULL ) } \arguments{ -\item{folder_id}{Folder identifier scoped to the given volume.} +\item{folder_id}{Folder identifier scoped to the given volume. Must be a +positive integer. Default is 9807.} -\item{vol_id}{Volume containing the folder. Required for Django API calls.} +\item{vol_id}{Volume containing the folder. Required for Django API calls. +Must be a positive integer. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/list_institution_affiliates.Rd b/man/list_institution_affiliates.Rd index 26f26bf7..9d99750d 100644 --- a/man/list_institution_affiliates.Rd +++ b/man/list_institution_affiliates.Rd @@ -11,9 +11,11 @@ list_institution_affiliates( ) } \arguments{ -\item{institution_id}{Institution identifier.} +\item{institution_id}{Institution identifier. Must be a positive integer. Default is 12.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } \value{ Tibble of affiliates with roles and expiration dates. diff --git a/man/list_institutions.Rd b/man/list_institutions.Rd index e6a7e159..9a8facf7 100644 --- a/man/list_institutions.Rd +++ b/man/list_institutions.Rd @@ -10,7 +10,7 @@ list_institutions(search_string = NULL, vb = options::opt("vb"), rq = NULL) \item{search_string}{Optional character string to filter institutions. If \code{NULL} (the default), returns all institutions.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/list_session_activity.Rd b/man/list_session_activity.Rd index 4454b8e5..863c85ad 100644 --- a/man/list_session_activity.Rd +++ b/man/list_session_activity.Rd @@ -12,11 +12,11 @@ list_session_activity( ) } \arguments{ -\item{vol_id}{Volume identifier (required by the Django API).} +\item{vol_id}{Volume identifier (required by the Django API). Must be a positive integer.} -\item{session_id}{Session identifier.} +\item{session_id}{Session identifier. Must be a positive integer.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}. When \code{NULL}, a default request is generated, but this will only permit public information diff --git a/man/list_session_assets.Rd b/man/list_session_assets.Rd index 37b49302..f3c6f69d 100644 --- a/man/list_session_assets.Rd +++ b/man/list_session_assets.Rd @@ -19,7 +19,7 @@ the "materials" folder from Databrary volume 1.} versions of the Databrary API require this value to be supplied because session identifiers are scoped to volumes.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. If NULL, a default request is generated from databraryr::make_default_request().} diff --git a/man/list_user_affiliates.Rd b/man/list_user_affiliates.Rd index 607ecdc9..1b490647 100644 --- a/man/list_user_affiliates.Rd +++ b/man/list_user_affiliates.Rd @@ -7,9 +7,11 @@ list_user_affiliates(user_id = 6, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{user_id}{User identifier.} +\item{user_id}{User identifier. Must be an integer. Default is 6.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } \value{ Tibble of affiliates for the user. diff --git a/man/list_user_history.Rd b/man/list_user_history.Rd index 9433a469..80e08dd1 100644 --- a/man/list_user_history.Rd +++ b/man/list_user_history.Rd @@ -7,9 +7,9 @@ list_user_history(user_id = 22582, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{user_id}{Target user identifier.} +\item{user_id}{Target user identifier. Must be a positive integer. Default is 22582.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/list_user_volumes.Rd b/man/list_user_volumes.Rd index c6b691cd..b0097b9b 100644 --- a/man/list_user_volumes.Rd +++ b/man/list_user_volumes.Rd @@ -2,18 +2,20 @@ % Please edit documentation in R/list_user_volumes.R \name{list_user_volumes} \alias{list_user_volumes} -\title{List volumes associated with a user} +\title{List Volumes Associated With A User} \usage{ list_user_volumes(user_id = 6, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{user_id}{User identifier.} +\item{user_id}{User identifier. Must be a positive integer. Default is 6.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Default is NULL.} } \value{ Tibble of volumes the user owns or collaborates on. } \description{ -List volumes associated with a user +List Volumes Associated With A User } diff --git a/man/list_users.Rd b/man/list_users.Rd index 1ea008a2..ebb5d858 100644 --- a/man/list_users.Rd +++ b/man/list_users.Rd @@ -30,7 +30,7 @@ response to authorized investigators.} \item{has_api_access}{Optional logical value restricting the response to accounts with API access enabled.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/list_volume_activity.Rd b/man/list_volume_activity.Rd index 63e8501e..0b6e2905 100644 --- a/man/list_volume_activity.Rd +++ b/man/list_volume_activity.Rd @@ -4,12 +4,12 @@ \alias{list_volume_activity} \title{List Activity In A Databrary Volume} \usage{ -list_volume_activity(vol_id = 1892, vb = options::opt("vb"), rq = NULL) +list_volume_activity(vol_id = NULL, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vol_id}{Selected volume number.} +\item{vol_id}{Selected volume number. Must be a positive integer. Default is NULL.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to NULL.} } @@ -18,15 +18,15 @@ A list with the activity history on a volume. } \description{ If a user has access to a volume, this command lists the modification -history of the volume as a +history of the volume. } \examples{ \donttest{ \dontrun{ -# The following will only return output if the user has write privileges +# The following will only return output if the user has *write* privileges # on the volume. -list_volume_activity(vol_id = 1892) # Activity on volume 1892. +list_volume_activity(vol_id) } } } diff --git a/man/list_volume_assets.Rd b/man/list_volume_assets.Rd index 90cc2518..0b6cf58f 100644 --- a/man/list_volume_assets.Rd +++ b/man/list_volume_assets.Rd @@ -7,9 +7,9 @@ list_volume_assets(vol_id = 1, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vol_id}{Target volume number. Default is 1.} +\item{vol_id}{Target volume number. Must be a positive integer. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Default is NULL.} } diff --git a/man/list_volume_collaborators.Rd b/man/list_volume_collaborators.Rd index eeb46775..f6472ca4 100644 --- a/man/list_volume_collaborators.Rd +++ b/man/list_volume_collaborators.Rd @@ -7,9 +7,9 @@ list_volume_collaborators(vol_id = 1, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vol_id}{Target volume number.} +\item{vol_id}{Target volume number. Must be a positive integer. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/list_volume_folders.Rd b/man/list_volume_folders.Rd index a85b82b3..907b14f1 100644 --- a/man/list_volume_folders.Rd +++ b/man/list_volume_folders.Rd @@ -7,9 +7,9 @@ list_volume_folders(vol_id = 1, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vol_id}{Target volume number.} +\item{vol_id}{Target volume number. Must be a positive integer. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/list_volume_funding.Rd b/man/list_volume_funding.Rd index de159b38..be9ff987 100644 --- a/man/list_volume_funding.Rd +++ b/man/list_volume_funding.Rd @@ -17,7 +17,7 @@ list_volume_funding( \item{add_id}{A logical value. Include the volume ID in the output. Default is TRUE.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object.} } diff --git a/man/list_volume_info.Rd b/man/list_volume_info.Rd index eac7eb90..22b7ade3 100644 --- a/man/list_volume_info.Rd +++ b/man/list_volume_info.Rd @@ -7,11 +7,11 @@ list_volume_info(vol_id = 1, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vol_id}{Target volume number.} +\item{vol_id}{Target volume number. Must be a positive integer. Defaults to 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} -\item{rq}{An \code{httr2} request object. If NULL (the default) +\item{rq}{An \code{httr2} request object. If NULL (the default). a request will be generated, but this will only permit public information to be returned.} } diff --git a/man/list_volume_links.Rd b/man/list_volume_links.Rd index a3e0dff3..5186c09b 100644 --- a/man/list_volume_links.Rd +++ b/man/list_volume_links.Rd @@ -7,9 +7,9 @@ list_volume_links(vol_id = 1, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vol_id}{Target volume number.} +\item{vol_id}{Target volume number. Must be a positive integer. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object.} } diff --git a/man/list_volume_records.Rd b/man/list_volume_records.Rd index c195131f..25e6619e 100644 --- a/man/list_volume_records.Rd +++ b/man/list_volume_records.Rd @@ -17,7 +17,7 @@ list_volume_records( \item{category_id}{Optional numeric category identifier to filter records by category type.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/list_volume_session_assets.Rd b/man/list_volume_session_assets.Rd index 524a65ea..95233cac 100644 --- a/man/list_volume_session_assets.Rd +++ b/man/list_volume_session_assets.Rd @@ -12,11 +12,11 @@ list_volume_session_assets( ) } \arguments{ -\item{vol_id}{Target volume number.} +\item{vol_id}{Target volume number. Must be a positive integer.} \item{session_id}{The session number in the selected volume.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object.} } diff --git a/man/list_volume_sessions.Rd b/man/list_volume_sessions.Rd index 49bfe7eb..cca3796a 100644 --- a/man/list_volume_sessions.Rd +++ b/man/list_volume_sessions.Rd @@ -12,12 +12,12 @@ list_volume_sessions( ) } \arguments{ -\item{vol_id}{Target volume number.} +\item{vol_id}{Target volume number. Must be a positive integer. Default is 1.} \item{include_vol_data}{A Boolean value. Include volume-level metadata or not. Default is FALSE.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. If NULL (the default) a request will be generated, but this will only permit public information diff --git a/man/list_volume_tags.Rd b/man/list_volume_tags.Rd index 94611aef..5a45843c 100644 --- a/man/list_volume_tags.Rd +++ b/man/list_volume_tags.Rd @@ -7,9 +7,9 @@ list_volume_tags(vol_id = 1, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vol_id}{Target volume number.} +\item{vol_id}{Target volume number. Must be a positive integer. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Default is NULL.} } diff --git a/man/list_volumes.Rd b/man/list_volumes.Rd index 6b3dddc2..17ca97fa 100644 --- a/man/list_volumes.Rd +++ b/man/list_volumes.Rd @@ -18,7 +18,7 @@ description.} \item{ordering}{Optional character string indicating the sort field accepted by the API (e.g., \code{"title"}, \code{"-title"}).} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/login_db.Rd b/man/login_db.Rd index 98be6bd7..21bcf667 100644 --- a/man/login_db.Rd +++ b/man/login_db.Rd @@ -34,7 +34,7 @@ update stored credentials in keyring/keychain.} \item{SERVICE}{A character label for stored credentials in the keyring. Default is \code{org.databrary.databraryr}.} -\item{vb}{Show verbose messages.} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} } \value{ Logical value indicating whether log in is successful or not. diff --git a/man/logout_db.Rd b/man/logout_db.Rd index 2ea6c141..5b02271e 100644 --- a/man/logout_db.Rd +++ b/man/logout_db.Rd @@ -7,9 +7,7 @@ logout_db(vb = options::opt("vb")) } \arguments{ -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - -\item{rq}{An \code{httr2} request object. Defaults to NULL.} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} } \value{ TRUE if logging out succeeds, FALSE otherwise. diff --git a/man/make_default_request.Rd b/man/make_default_request.Rd index 17f17644..b79abc2d 100644 --- a/man/make_default_request.Rd +++ b/man/make_default_request.Rd @@ -17,7 +17,7 @@ Defaults to \code{TRUE} since all API calls now require authentication.} \item{refresh}{When \code{with_token = TRUE}, determines whether to refresh the cached token if it is near expiry. Defaults to \code{TRUE}.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} } \value{ An \code{httr2_request} object configured for the Databrary API. diff --git a/man/make_login_client.Rd b/man/make_login_client.Rd index f3a3262e..2be34d26 100644 --- a/man/make_login_client.Rd +++ b/man/make_login_client.Rd @@ -23,7 +23,7 @@ make_login_client( \item{overwrite}{A boolean value. If TRUE and store is TRUE, overwrite/ update stored credentials in keyring/keychain.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{SERVICE}{A character label for stored credentials in the keyring. Default is "databrary"} diff --git a/man/search_for_funder.Rd b/man/search_for_funder.Rd index c6589194..abf2cbd5 100644 --- a/man/search_for_funder.Rd +++ b/man/search_for_funder.Rd @@ -12,12 +12,12 @@ search_for_funder( ) } \arguments{ -\item{search_string}{String to search.} +\item{search_string}{String to search. Default is "national science foundation".} \item{approved_only}{Logical. When TRUE (default) only approved funders are returned. Set to FALSE to include unapproved funders as well.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Default is NULL.} } diff --git a/man/search_for_tags.Rd b/man/search_for_tags.Rd index 3880cba3..27a0db37 100644 --- a/man/search_for_tags.Rd +++ b/man/search_for_tags.Rd @@ -9,7 +9,7 @@ search_for_tags(search_string = "ICIS", vb = options::opt("vb"), rq = NULL) \arguments{ \item{search_string}{String to search.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Default is NULL.} } diff --git a/man/search_institutions.Rd b/man/search_institutions.Rd index c5db1d56..0c820309 100644 --- a/man/search_institutions.Rd +++ b/man/search_institutions.Rd @@ -10,7 +10,7 @@ search_institutions(search_string, vb = options::opt("vb"), rq = NULL) \item{search_string}{Character string describing the institution search query.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/search_users.Rd b/man/search_users.Rd index 0d08e919..0ff2079c 100644 --- a/man/search_users.Rd +++ b/man/search_users.Rd @@ -9,7 +9,7 @@ search_users(search_string, vb = options::opt("vb"), rq = NULL) \arguments{ \item{search_string}{Character string describing the search query.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/search_volumes.Rd b/man/search_volumes.Rd index 4bf2b40b..f95df677 100644 --- a/man/search_volumes.Rd +++ b/man/search_volumes.Rd @@ -9,7 +9,7 @@ search_volumes(search_string, vb = options::opt("vb"), rq = NULL) \arguments{ \item{search_string}{Character string describing the volume search query.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } diff --git a/man/whoami.Rd b/man/whoami.Rd index 08932656..dc27236b 100644 --- a/man/whoami.Rd +++ b/man/whoami.Rd @@ -10,7 +10,7 @@ whoami(refresh = TRUE, vb = options::opt("vb")) \item{refresh}{Whether to attempt automatic token refresh when the current access token is expired. Defaults to \code{TRUE}.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} } \value{ A list containing \code{auth_method} and \code{user} fields (both lists) or diff --git a/tests/testthat/helper-auth.R b/tests/testthat/helper-auth.R index 743fe4b7..443a09f9 100644 --- a/tests/testthat/helper-auth.R +++ b/tests/testthat/helper-auth.R @@ -7,7 +7,6 @@ login_test_account <- function() { } set_if_missing("DATABRARY_BASE_URL", "https://api.stg-databrary.its.nyu.edu") - set_if_missing("USER_AGENT", "SRW$*Kxy2nYdyo4LozoGV#i6LvH/") set_if_missing("DATABRARY_LOGIN", "pawel.armatys+1@montrosesoftware.com") set_if_missing("DATABRARY_PASSWORD", "tindov-9ciVxa-hehguw") set_if_missing("DATABRARY_CLIENT_ID", "9B0gJF1b5OSkkrjPrkKHeYHgWLOJ0N1Uxv2tW3KS") diff --git a/tests/testthat/test-download_folder_asset.R b/tests/testthat/test-download_folder_asset.R index 16ca27ac..1e12d192 100644 --- a/tests/testthat/test-download_folder_asset.R +++ b/tests/testthat/test-download_folder_asset.R @@ -42,7 +42,9 @@ test_that("download_folder_asset rejects bad input parameters", { }) test_that("download_folder_asset fetches signed link", { - tmp_dir <- tempdir() + tmp_dir <- tempfile("download_folder_asset_test_") + dir.create(tmp_dir, recursive = TRUE, showWarnings = FALSE) + on.exit(unlink(tmp_dir, recursive = TRUE), add = TRUE) fake_link <- list(download_url = "https://example.com/file.bin", file_name = "example.bin") class(fake_link) <- c("databrary_signed_download", "list") @@ -50,7 +52,13 @@ test_that("download_folder_asset fetches signed link", { captured_dest <- NULL result <- with_mocked_bindings( - download_folder_asset(vol_id = 1, folder_id = 2, asset_id = 3, target_dir = tmp_dir), + download_folder_asset( + vol_id = 1, + folder_id = 2, + asset_id = 3, + file_name = NULL, + target_dir = tmp_dir + ), request_signed_download_link = function(path, rq = NULL, vb = FALSE) { captured_path <<- path fake_link diff --git a/tests/testthat/test-search_for_tags.R b/tests/testthat/test-search_for_tags.R index af54cc01..bd3b422e 100644 --- a/tests/testthat/test-search_for_tags.R +++ b/tests/testthat/test-search_for_tags.R @@ -1,6 +1,8 @@ # search_for_tags() --------------------------------------------------- test_that("search_for_tags returns tagged volumes", { + login_test_account() result <- search_for_tags("ICIS") + skip_if_null_response(result, "search_for_tags(\"ICIS\")") expect_s3_class(result, "tbl_df") expect_gt(nrow(result), 0) }) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 6286b45e..af806abc 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -26,7 +26,10 @@ test_that("get_release_levels handles vb flag", { # get_supported_file_types ---------------------------------------------------- test_that("get_supported_file_types returns data.frame", { - expect_true(is.data.frame(get_supported_file_types())) + login_test_account() + result <- get_supported_file_types() + skip_if_null_response(result, "get_supported_file_types()") + expect_true(is.data.frame(result)) }) test_that("get_supported_file_types rejects bad input parameters", { From 912c21bbcaa5cc3b19aa83ac232db92ff1699684 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 12 Feb 2026 11:26:03 +0100 Subject: [PATCH 33/77] refactor: standardize error handling and improve messaging in API functions; update constants and documentation --- R/CONSTANTS.R | 3 +-- R/get_institution_avatar.R | 12 ++++----- R/get_user_avatar.R | 12 ++++----- R/get_volume_collaborator_by_id.R | 18 ++++++------- R/list_volume_activity.R | 2 +- R/list_volumes.R | 6 ++++- R/login_db.R | 15 ++++++++--- R/make_login_client.R | 30 ++++++++++----------- R/misc_enums.R | 13 +++++++-- R/utils.R | 9 +++---- vignettes/accessing-data.Rmd | 44 +++++++++++++++---------------- vignettes/databrary.Rmd | 16 +++++------ 12 files changed, 98 insertions(+), 82 deletions(-) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 66edf75a..2a0b850f 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -1,7 +1,6 @@ #' Load Package-wide Constants into Local Environment #' #' -# DATABRARY_BASE_URL <- Sys.getenv("DATABRARY_BASE_URL", "https://api.stg-databrary.its.nyu.edu") DATABRARY_BASE_URL <- Sys.getenv("DATABRARY_BASE_URL", "https://api.databrary.org") API_ACTIVITY_SUMMARY <- "/statistics/summary/" @@ -63,4 +62,4 @@ OAUTH_TEST_URL <- sprintf("%s/oauth2/test/", DATABRARY_BASE_URL) USER_AGENT <- paste0("databraryr/", as.character(utils::packageVersion("databraryr"))) -KEYRING_SERVICE <- 'org.databrary.databraryr' +KEYRING_SERVICE <- "org.databrary.databraryr" diff --git a/R/get_institution_avatar.R b/R/get_institution_avatar.R index 61310ddd..e719560c 100644 --- a/R/get_institution_avatar.R +++ b/R/get_institution_avatar.R @@ -82,8 +82,9 @@ get_institution_avatar <- function(institution_id = 1, httr2::req_url(full_url) %>% httr2::req_method("GET") %>% httr2::req_error( - is_error = function(resp) + is_error = function(resp) { FALSE + } ) if (vb) { @@ -131,15 +132,14 @@ get_institution_avatar <- function(institution_id = 1, grepl("filename=", content_disp)) { # Extract filename from content-disposition header filename_match <- regmatches(content_disp, - regexpr("filename=([^;]+)", content_disp)) + regexpr("filename=([^;]+)", content_disp)) if (length(filename_match) > 0) { filename <- sub("filename=", "", filename_match) - filename <- gsub('^"|"$', '', filename) # Remove quotes + filename <- gsub("^\"|\"$", "", filename) # Remove quotes filename <- trimws(filename) } } else { - # Fallback: use URL path basename - url_path <- sprintf(API_INSTITUTION_AVATAR, institution_id) + # Fallback: use default filename when content-disposition lacks filename filename <- paste0("institution_", institution_id, "_avatar.jpg") } @@ -174,6 +174,6 @@ get_institution_avatar <- function(institution_id = 1, ": ", e$message) } - return(NULL) + NULL }) } diff --git a/R/get_user_avatar.R b/R/get_user_avatar.R index dad8dc59..2fc09979 100644 --- a/R/get_user_avatar.R +++ b/R/get_user_avatar.R @@ -75,15 +75,16 @@ get_user_avatar <- function(user_id, rq |> httr2::req_url_path_append(path) |> httr2::req_error( - is_error = function(resp) + is_error = function(resp) { FALSE + } ) |> httr2::req_perform() }, error = function(e) { if (vb) { message("Error downloading user avatar: ", conditionMessage(e)) } - return(NULL) + NULL }) if (is.null(resp)) { @@ -128,12 +129,11 @@ get_user_avatar <- function(user_id, regexpr("filename=([^;]+)", content_disp)) if (length(filename_match) > 0) { filename <- sub("filename=", "", filename_match) - filename <- gsub('^"|"$', '', filename) # Remove quotes + filename <- gsub("^\"|\"$", "", filename) # Remove quotes filename <- trimws(filename) } } else { - # Fallback: use URL path basename - url_path <- sprintf(API_USER_AVATAR, user_id) + # Fallback: use default filename when content-disposition lacks filename filename <- paste0("user_", user_id, "_avatar.jpg") } @@ -157,6 +157,6 @@ get_user_avatar <- function(user_id, if (vb) { message("Error saving avatar to file: ", conditionMessage(e)) } - return(NULL) + NULL }) } diff --git a/R/get_volume_collaborator_by_id.R b/R/get_volume_collaborator_by_id.R index 27549b49..f3f6f3be 100644 --- a/R/get_volume_collaborator_by_id.R +++ b/R/get_volume_collaborator_by_id.R @@ -111,15 +111,15 @@ get_volume_collaborator_by_id <- function(vol_id = 1, # Process sponsored_users if present sponsored_users <- NULL if (!is.null(collaborator$sponsored_users) && - length(collaborator$sponsored_users) > 0) { - sponsored_users <- lapply(collaborator$sponsored_users, function(u) { - list( - user_id = u$id, - first_name = u$first_name, - last_name = u$last_name, - email = u$email - ) - }) + length(collaborator$sponsored_users) > 0) { + sponsored_users <- lapply(collaborator$sponsored_users, function(u) { + list( + user_id = u$id, + first_name = u$first_name, + last_name = u$last_name, + email = u$email + ) + }) } # Return structured list diff --git a/R/list_volume_activity.R b/R/list_volume_activity.R index a4c8cd7f..c813e5cb 100644 --- a/R/list_volume_activity.R +++ b/R/list_volume_activity.R @@ -39,7 +39,7 @@ list_volume_activity <- validate_flag(vb, "vb") if (vb) - message('list_volume_activity()...') + message("list_volume_activity()...") if (is.null(rq)) { rq <- databraryr::make_default_request() diff --git a/R/list_volumes.R b/R/list_volumes.R index 0dc8c6b2..2720e21e 100644 --- a/R/list_volumes.R +++ b/R/list_volumes.R @@ -75,7 +75,11 @@ list_volumes <- function(search = NULL, volume_access_level = volume$access_level, volume_owner_connection_id = if (is.null(owner_connection)) NA_integer_ else owner_connection$id, volume_owner_role = if (is.null(owner_connection$role)) NA_character_ else owner_connection$role, - volume_owner_expiration_date = if (is.null(owner_connection$expiration_date)) NA_character_ else owner_connection$expiration_date, + volume_owner_expiration_date = if (is.null(owner_connection$expiration_date)) { + NA_character_ + } else { + owner_connection$expiration_date + }, volume_owner_user_id = if (is.null(owner_user)) NA_integer_ else owner_user$id, volume_owner_user_first_name = if (is.null(owner_user$first_name)) NA_character_ else owner_user$first_name, volume_owner_user_last_name = if (is.null(owner_user$last_name)) NA_character_ else owner_user$last_name, diff --git a/R/login_db.R b/R/login_db.R index f43e3329..67275f95 100644 --- a/R/login_db.R +++ b/R/login_db.R @@ -110,9 +110,18 @@ login_db <- function(email = NULL, ) if (store) { - store_keyring_value(service = SERVICE, username = paste0(email_value, "::password"), value = password_value, vb = vb) - store_keyring_value(service = SERVICE, username = paste0(email_value, "::client_id"), value = client_id_value, vb = vb) - store_keyring_value(service = SERVICE, username = paste0(email_value, "::client_secret"), value = client_secret_value, vb = vb) + store_keyring_value( + service = SERVICE, username = paste0(email_value, "::password"), + value = password_value, vb = vb + ) + store_keyring_value( + service = SERVICE, username = paste0(email_value, "::client_id"), + value = client_id_value, vb = vb + ) + store_keyring_value( + service = SERVICE, username = paste0(email_value, "::client_secret"), + value = client_secret_value, vb = vb + ) } if (vb) message("Login successful.") diff --git a/R/make_login_client.R b/R/make_login_client.R index 4d896281..5bfaea84 100644 --- a/R/make_login_client.R +++ b/R/make_login_client.R @@ -8,7 +8,8 @@ NULL #' @param email Databrary account email address. #' @param password Databrary password (not recommended as it will displayed as you type) #' @param store A boolean value. If TRUE store/retrieve credentials from the system keyring/keychain. -#' @param overwrite A boolean value. If TRUE and store is TRUE, overwrite/ update stored credentials in keyring/keychain. +#' @param overwrite A boolean value. If TRUE and store is TRUE, overwrite or +#' update stored credentials in keyring/keychain. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param SERVICE A character label for stored credentials in the keyring. Default is "databrary" #' @param rq An `httr2` request object. Defaults to NULL. @@ -30,12 +31,12 @@ NULL #' #' @export make_login_client <- function(email = NULL, - password = NULL, - store = FALSE, - overwrite = FALSE, - vb = options::opt("vb"), - SERVICE = KEYRING_SERVICE, - rq = NULL) { + password = NULL, + store = FALSE, + overwrite = FALSE, + vb = options::opt("vb"), + SERVICE = KEYRING_SERVICE, + rq = NULL) { # Check parameters assertthat::assert_that(length(store) == 1) @@ -89,7 +90,7 @@ make_login_client <- function(email = NULL, "' from keyring.") kl <- keyring::key_list(service = SERVICE) # Make sure our service is in the keyring - if (exists('kl') && is.data.frame(kl)) { + if (exists("kl") && is.data.frame(kl)) { # If it is under the email entered, keep it to try later and not collect it here password <- try(keyring::key_get(service = SERVICE, username = email), @@ -128,8 +129,9 @@ make_login_client <- function(email = NULL, resp <- tryCatch( httr2::req_perform(rq), - httr2_error = function(cnd) + httr2_error = function(cnd) { NULL + } ) if (!is.null(resp)) { @@ -152,23 +154,21 @@ make_login_client <- function(email = NULL, if (vb) message(paste("Login successful.")) } - #return(resp) } if (store) { if (vb) message( paste0( - 'Login failed; nothing stored in keyring; HTTP status ', + "Login failed; nothing stored in keyring; HTTP status ", httr2::resp_status(resp), - '\n' + "\n" ) ) } else { if (vb) - message(paste0('Login failed; HTTP status ', - httr2::resp_status(resp), '\n')) + message(paste0("Login failed; HTTP status ", + httr2::resp_status(resp), "\n")) } resp - #return(FALSE) } diff --git a/R/misc_enums.R b/R/misc_enums.R index b17eb49f..78192dfd 100644 --- a/R/misc_enums.R +++ b/R/misc_enums.R @@ -27,11 +27,20 @@ get_release_levels_enums <- function() { ), list( code = "authorized_users", - description = "This content is restricted to authorized Databrary users and may not be redistributed in any form." + description = paste0( + "This content is restricted to authorized Databrary users and ", + "may not be redistributed in any form." + ) ), list( code = "learning_audiences", - description = "This content is restricted to authorized Databrary users, who may use clips or images from it in presentations for informational or educational purposes. Such presentations may be videotaped or recorded and those videos or recordings may then be made available to the public via the internet (e.g., YouTube)." + description = paste0( + "This content is restricted to authorized Databrary users, who may ", + "use clips or images from it in presentations for informational or ", + "educational purposes. Such presentations may be videotaped or ", + "recorded and those videos or recordings may then be made available ", + "to the public via the internet (e.g., YouTube)." + ) ), list( code = "public", diff --git a/R/utils.R b/R/utils.R index 2826dab2..04e272e4 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,6 +1,4 @@ -# R/utils.R -# -# Utility functions. +# Utility functions for the databraryr package. #------------------------------------------------------------------------------ #' @eval options::as_params() @@ -71,8 +69,9 @@ HHMMSSmmm_to_ms <- function(HHMMSSmmm = "01:01:01:333") { get_release_levels <- function(vb = options::opt("vb")) { validate_flag(vb, "vb") enums <- get_release_levels_enums() - vapply(enums$levels, function(item) - item$code, character(1)) + vapply(enums$levels, function(item) { + item$code + }, character(1)) } #---------------------------------------------------------------------------- diff --git a/vignettes/accessing-data.Rmd b/vignettes/accessing-data.Rmd index b5190ebf..c1b74685 100644 --- a/vignettes/accessing-data.Rmd +++ b/vignettes/accessing-data.Rmd @@ -48,15 +48,15 @@ Use `tempdir()` to find the directory where `test.mp4` is stored. Now, let's see what other files are shared in volume 1, not just those in session (slot) 9807. This takes a moment to run because there are *many* files in this volume. -```{r} +**NOTE**: With Databrary 2.0, all Databrary API access requires authentication. Log in with `login_db()` first (see [authorized users](authorized-users.Rmd)). + +```{r, eval=FALSE} databraryr::list_volume_assets() ``` - -**NOTE**: These commands return public data, that is, data we do not need an account or log-in to see. We have not provided an `httr2` request parameter, so the function generates a default one. We can see this happening if we set `vb = TRUE`. -```{r} +```{r, eval=FALSE} databraryr::list_volume_assets(vb = TRUE) ``` @@ -71,14 +71,14 @@ Obviously, you would need to supply a `vol_id` for some other non-public dataset The `list_volume_assets()` command returns a data frame we can manipulate using standard R commands. Here are the variables in the data frame. -```{r} +```{r, eval=FALSE} vol1_assets <- databraryr::list_volume_assets() names(vol1_assets) ``` Or, if you use the R (> version 4.3) 'pipe' syntax: -```{r} +```{r, eval=FALSE} databraryr::list_volume_assets() |> names() ``` @@ -87,14 +87,14 @@ The `magrittr` package pipe ('%>%') also works (as of databraryr v0.6.2). The `asset_format_id` variable tells us information about the type of the data file. -```{r} +```{r, eval=FALSE} unique(vol1_assets$asset_format_id) ``` But this isn't especially informative since the `asset_format` is a code, and we don't really know what `-800` or `6` or the other numbers refer to. To decode it, we create a data frame of all the file formats Databrary currently recognizes. -```{r} +```{r, eval=FALSE} db_constants <- databraryr::assign_constants() formats_df <- purrr::map(db_constants$format, as.data.frame) |> @@ -111,13 +111,13 @@ As of 0.6.0, `list_volume_assets()` adds this information to the data frame. We can summarize the number of files using the `stats::xtabs()` function: -```{r} +```{r, eval=FALSE} stats::xtabs(~ format_name, data = vol1_assets) ``` So, there are lots of videos and PDFs to examine in volume 1. Here is a table of the ten longest videos. -```{r} +```{r, eval=FALSE} vol1_assets |> dplyr::filter(format_name == "MPEG-4 video") |> dplyr::select(asset_name, asset_duration) |> @@ -136,14 +136,14 @@ The `list_volume_collaborators()` function returns a data frame with information The function has a parameter `vol_id` which is an integer, unique across Databrary, that refers to the specific dataset. The `list_volume_collaborators()` function uses volume 1 as the default. -```{r} +```{r, eval=FALSE} databraryr::list_volume_collaborators() ``` The command (and many like it) can be "vectorized" using the `purrr` package. This let's us generate a tibble with the owners of the first fifteen volumes. -```{r} +```{r, eval=FALSE} purrr::map(1:15, databraryr::list_volume_collaborators) |> purrr::list_rbind() ``` @@ -151,13 +151,13 @@ purrr::map(1:15, databraryr::list_volume_collaborators) |> As of 0.6.0, the `get_volume_by_id()` function returns a tibble summarising all data about a volume that is accessible to a particular user. The default is volume 1. -```{r} +```{r, eval=FALSE} vol1_list <- databraryr::get_volume_by_id() vol1_list ``` Let's create our own tibble/data frame with a subset of these variables. -```{r} +```{r, eval=FALSE} vol1_df <- vol1_list |> dplyr::select(id, title, sharing_level, access_level) vol1_df @@ -169,29 +169,27 @@ So, if you are not logged-in to Databrary, only data that are visible to the pub Assuming you are *not* logged-in, the above commands will show volumes with `access_level` equal to 1. The `access_level` field derives from a set of constants the system uses. -```{r} +```{r, eval=FALSE} db_constants <- databraryr::assign_constants() db_constants$permission ``` The `permission` array is indexed beginning with 0. -So the 1th (1st) value is "`r db_constants$permission[2]`". -So, the `1` means that the volumes shown above are all visible to the public, and to you. - -Volumes that you have not shared and are not visible to the public, will have `access_level` equal to 5, or "`r db_constants$permission[6]`". -We can't demonstrate this to you because we don't have privileges on the same unshared volume, but you can try it on a volume you've created but not yet shared. +The first value typically means volumes visible to the public. +Volumes that you have not shared and are not visible to the public will have `access_level` equal to 5. +We can't demonstrate this in the vignette because we don't have privileges on the same unshared volume, but you can try it on a volume you've created but not yet shared. Other functions with the form `list_volume_*()` provide information about Databrary volumes. For example, the `list_volume_funding()` command returns information about any funders listed for the project. Again, the default volume is 1. -```{r} +```{r, eval=FALSE} databraryr::list_volume_funding() ``` The `list_volume_links()` command returns information about any external (web) links that have been added to a volume, such as to related publications or a GitHub repo. -```{r} +```{r, eval=FALSE} databraryr::list_volume_links() ``` @@ -204,7 +202,7 @@ The following set of commands downloads all of the 'csv' files in volume 1 using The code below creates a new directory based on the session/slot ID (9807). The function returns the file path to the downloaded files. -```{r} +```{r, eval=FALSE} vol1_assets |> dplyr::filter(format_extension == "csv") |> databraryr::download_session_assets_fr_df() diff --git a/vignettes/databrary.Rmd b/vignettes/databrary.Rmd index 72a077f8..f84f7a97 100644 --- a/vignettes/databrary.Rmd +++ b/vignettes/databrary.Rmd @@ -46,21 +46,19 @@ Then, when you log in with your new credentials, you'll select an existing insti - The latest version of the code is v0.6.5. The v0.6.x code uses the `httr2` package under the hood, and it runs much faster than v0.5.x. -## First steps (while you await authorization) - -But even before formal authorization is complete, a user can access the public materials on Databrary. -For this vignette, we'll assume you fall into this category. +## First steps +All Databrary API access requires authentication. See the [authorized users](authorized-users.Rmd) vignette to learn how to log in. Once you've installed the package following one of the above routes, it's a good idea to check that your installation worked by loading it into your local workspace. ```{r eval=FALSE} library(databraryr) ``` -Then, try this command to pull data about one of Databrary's founders: +After logging in with `login_db()`, you can try this command to pull data about one of Databrary's founders: -```{r get_user_by_id} -# Retrieve public metadata about one of Databrary's founders. +```{r get_user_by_id, eval=FALSE} +# Retrieve metadata about one of Databrary's founders. user_6 <- databraryr::get_user_by_id(user_id = 6) tibble::as_tibble(user_6) @@ -71,7 +69,7 @@ Note that this command returns a tibble with columns that include the first name Databrary assigns a unique integer for each registered user on the system. We can create a simple helper function to collect information about a larger group of people. -```{r list-people-5-7} +```{r list-people-5-7, eval=FALSE} # Helper function get_user_as_df <- function(user_id) { this_user <- databraryr::get_user_by_id(user_id = user_id) @@ -93,7 +91,7 @@ You can also try seeing what's new on Databrary. The `get_db_stats()` command gives you information about the newly authorized people, institutions, and newly uploaded datasets. Try this: -```{r get-db-stats} +```{r get-db-stats, eval=FALSE} databraryr::get_db_stats("stats") databraryr::get_db_stats("people") databraryr::get_db_stats("institutions") From ce3a52ed70fa340809b3f90a2160a4d493f5a48e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 12 Feb 2026 11:40:27 +0100 Subject: [PATCH 34/77] refactor: enhance lintr configuration and add global variables --- .lintr | 4 +- NAMESPACE | 4 +- R/CONSTANTS.R | 1 + R/download_folder_assets_fr_df.R | 2 +- R/download_session_assets_fr_df.R | 2 +- R/download_single_folder_asset_fr_df.R | 18 ++-- R/download_single_session_asset_fr_df.R | 18 ++-- R/list_user_volumes.R | 2 + R/login_db.R | 20 ++--- R/make_login_client.R | 20 ++--- R/utils.R | 2 + ...df.Rd => download_folder_asset_from_df.Rd} | 6 +- ...f.Rd => download_session_asset_from_df.Rd} | 6 +- man/login_db.Rd | 4 +- man/make_login_client.Rd | 7 +- .../test-download_folder_assets_fr_df.R | 2 +- .../test-download_single_folder_asset_fr_df.R | 76 ++++++++-------- ...test-download_single_session_asset_fr_df.R | 86 +++++++++---------- tests/testthat/test-make_login_client.R | 6 +- 19 files changed, 146 insertions(+), 140 deletions(-) rename man/{download_single_folder_asset_fr_df.Rd => download_folder_asset_from_df.Rd} (91%) rename man/{download_single_session_asset_fr_df.Rd => download_session_asset_from_df.Rd} (91%) diff --git a/.lintr b/.lintr index a6c66901..bb8d5899 100644 --- a/.lintr +++ b/.lintr @@ -1,2 +1,2 @@ -linters: linters_with_defaults(line_length_linter = line_length_linter(120), cyclocomp_linter = NULL) -exclusions: list("_wip", "tests/testthat", "vignettes", "R/CONSTANTS.R" = list(object_name_linter = Inf)) +linters: linters_with_defaults(line_length_linter = line_length_linter(120)) +exclusions: list("_wip", "tests/testthat", "vignettes", "R/CONSTANTS.R" = list(object_name_linter = Inf), "R/aaa.R" = list(object_name_linter = Inf), "R/auth_utils.R" = list(object_name_linter = Inf), "R/utils.R" = list(object_name_linter = Inf)) diff --git a/NAMESPACE b/NAMESPACE index a406a9d6..b7f4a297 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,14 +5,14 @@ export(HHMMSSmmm_to_ms) export(assign_constants) export(check_ssl_certs) export(download_folder_asset) +export(download_folder_asset_from_df) export(download_folder_assets_fr_df) export(download_folder_zip) export(download_session_asset) +export(download_session_asset_from_df) export(download_session_assets_fr_df) export(download_session_csv) export(download_session_zip) -export(download_single_folder_asset_fr_df) -export(download_single_session_asset_fr_df) export(download_video) export(download_volume_zip) export(get_category_by_id) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 2a0b850f..ae81469d 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -59,6 +59,7 @@ REQUEST_TIMEOUT_VERY_LONG <- 600 OAUTH_TOKEN_URL <- sprintf("%s/o/token/", DATABRARY_BASE_URL) OAUTH_TEST_URL <- sprintf("%s/oauth2/test/", DATABRARY_BASE_URL) +LOGIN <- sprintf("%s/login/", DATABRARY_BASE_URL) USER_AGENT <- paste0("databraryr/", as.character(utils::packageVersion("databraryr"))) diff --git a/R/download_folder_assets_fr_df.R b/R/download_folder_assets_fr_df.R index 1e81d85a..58a7dcac 100644 --- a/R/download_folder_assets_fr_df.R +++ b/R/download_folder_assets_fr_df.R @@ -100,7 +100,7 @@ download_folder_assets_fr_df <- purrr::map( seq_len(nrow(folder_df)), - download_single_folder_asset_fr_df, + download_folder_asset_from_df, folder_df = folder_df, target_dir = target_dir, add_folder_subdir = add_folder_subdir, diff --git a/R/download_session_assets_fr_df.R b/R/download_session_assets_fr_df.R index c596fb57..64379bc5 100644 --- a/R/download_session_assets_fr_df.R +++ b/R/download_session_assets_fr_df.R @@ -101,7 +101,7 @@ download_session_assets_fr_df <- purrr::map( seq_len(nrow(session_df)), - download_single_session_asset_fr_df, + download_session_asset_from_df, session_df = session_df, target_dir = target_dir, add_session_subdir = add_session_subdir, diff --git a/R/download_single_folder_asset_fr_df.R b/R/download_single_folder_asset_fr_df.R index 1a6a4bd8..0c485027 100644 --- a/R/download_single_folder_asset_fr_df.R +++ b/R/download_single_folder_asset_fr_df.R @@ -27,15 +27,15 @@ NULL #' @inheritParams options_params #' #' @export -download_single_folder_asset_fr_df <- function(i = NULL, - folder_df = NULL, - target_dir = tempdir(), - add_folder_subdir = TRUE, - overwrite = TRUE, - make_portable_fn = FALSE, - timeout_secs = REQUEST_TIMEOUT_VERY_LONG, - vb = options::opt("vb"), - rq = NULL) { +download_folder_asset_from_df <- function(i = NULL, + folder_df = NULL, + target_dir = tempdir(), + add_folder_subdir = TRUE, + overwrite = TRUE, + make_portable_fn = FALSE, + timeout_secs = REQUEST_TIMEOUT_VERY_LONG, + vb = options::opt("vb"), + rq = NULL) { assertthat::assert_that(length(i) == 1) assertthat::is.number(i) assertthat::assert_that(i > 0) diff --git a/R/download_single_session_asset_fr_df.R b/R/download_single_session_asset_fr_df.R index 55d26d3a..ab54bc35 100644 --- a/R/download_single_session_asset_fr_df.R +++ b/R/download_single_session_asset_fr_df.R @@ -27,15 +27,15 @@ NULL #' @inheritParams options_params #' #' @export -download_single_session_asset_fr_df <- function(i = NULL, - session_df = NULL, - target_dir = tempdir(), - add_session_subdir = TRUE, - overwrite = TRUE, - make_portable_fn = FALSE, - timeout_secs = REQUEST_TIMEOUT_VERY_LONG, - vb = options::opt("vb"), - rq = NULL) { +download_session_asset_from_df <- function(i = NULL, + session_df = NULL, + target_dir = tempdir(), + add_session_subdir = TRUE, + overwrite = TRUE, + make_portable_fn = FALSE, + timeout_secs = REQUEST_TIMEOUT_VERY_LONG, + vb = options::opt("vb"), + rq = NULL) { assertthat::assert_that(length(i) == 1) assertthat::is.number(i) assertthat::assert_that(i > 0) diff --git a/R/list_user_volumes.R b/R/list_user_volumes.R index 02fd5f2a..ae6a1a56 100644 --- a/R/list_user_volumes.R +++ b/R/list_user_volumes.R @@ -3,6 +3,8 @@ #' NULL +utils::globalVariables("vol_id") + #' List Volumes Associated With A User #' #' @param user_id User identifier. Must be a positive integer. Default is 6. diff --git a/R/login_db.R b/R/login_db.R index 67275f95..cb00ee73 100644 --- a/R/login_db.R +++ b/R/login_db.R @@ -9,7 +9,7 @@ #' system keyring/keychain. #' @param overwrite A boolean value. If TRUE and store is TRUE, overwrite/ #' update stored credentials in keyring/keychain. -#' @param SERVICE A character label for stored credentials in the keyring. +#' @param service A character label for stored credentials in the keyring. #' Default is `org.databrary.databraryr`. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @@ -33,12 +33,12 @@ login_db <- function(email = NULL, client_secret = NULL, store = FALSE, overwrite = FALSE, - SERVICE = KEYRING_SERVICE, + service = KEYRING_SERVICE, vb = options::opt("vb")) { assertthat::assert_that(length(store) == 1, is.logical(store)) validate_flag(overwrite, "overwrite") validate_flag(vb, "vb") - assertthat::assert_that(length(SERVICE) == 1, is.character(SERVICE)) + assertthat::assert_that(length(service) == 1, is.character(service)) # If the user wants to store or use their stored credentials, # check for keyring support @@ -51,7 +51,7 @@ login_db <- function(email = NULL, label = "email", value = email, prompt_label = "Databrary user ID (email)", - service = SERVICE, + service = service, overwrite = overwrite, vb = vb ) @@ -60,7 +60,7 @@ login_db <- function(email = NULL, label = "password", value = password, prompt_label = "Databrary password", - service = SERVICE, + service = service, username = paste0(email_value, "::password"), overwrite = overwrite, vb = vb @@ -70,7 +70,7 @@ login_db <- function(email = NULL, label = "client_id", value = client_id, prompt_label = "OAuth client ID", - service = SERVICE, + service = service, username = paste0(email_value, "::client_id"), overwrite = overwrite, vb = vb @@ -80,7 +80,7 @@ login_db <- function(email = NULL, label = "client_secret", value = client_secret, prompt_label = "OAuth client secret", - service = SERVICE, + service = service, username = paste0(email_value, "::client_secret"), overwrite = overwrite, vb = vb @@ -111,15 +111,15 @@ login_db <- function(email = NULL, if (store) { store_keyring_value( - service = SERVICE, username = paste0(email_value, "::password"), + service = service, username = paste0(email_value, "::password"), value = password_value, vb = vb ) store_keyring_value( - service = SERVICE, username = paste0(email_value, "::client_id"), + service = service, username = paste0(email_value, "::client_id"), value = client_id_value, vb = vb ) store_keyring_value( - service = SERVICE, username = paste0(email_value, "::client_secret"), + service = service, username = paste0(email_value, "::client_secret"), value = client_secret_value, vb = vb ) } diff --git a/R/make_login_client.R b/R/make_login_client.R index 5bfaea84..df2de348 100644 --- a/R/make_login_client.R +++ b/R/make_login_client.R @@ -11,7 +11,7 @@ NULL #' @param overwrite A boolean value. If TRUE and store is TRUE, overwrite or #' update stored credentials in keyring/keychain. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. -#' @param SERVICE A character label for stored credentials in the keyring. Default is "databrary" +#' @param service A character label for stored credentials in the keyring. Default is "databrary" #' @param rq An `httr2` request object. Defaults to NULL. #' #' @returns Logical value indicating whether log in is successful or not. @@ -35,7 +35,7 @@ make_login_client <- function(email = NULL, store = FALSE, overwrite = FALSE, vb = options::opt("vb"), - SERVICE = KEYRING_SERVICE, + service = KEYRING_SERVICE, rq = NULL) { # Check parameters @@ -46,8 +46,8 @@ make_login_client <- function(email = NULL, validate_flag(overwrite, "overwrite") validate_flag(vb, "vb") - assertthat::assert_that(length(SERVICE) == 1) - assertthat::assert_that(is.character(SERVICE)) + assertthat::assert_that(length(service) == 1) + assertthat::assert_that(is.character(service)) assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) @@ -86,19 +86,19 @@ make_login_client <- function(email = NULL, if (store && is.null(password) && !overwrite) { if (vb) message("Retrieving password for service='", - SERVICE, + service, "' from keyring.") - kl <- keyring::key_list(service = SERVICE) + kl <- keyring::key_list(service = service) # Make sure our service is in the keyring if (exists("kl") && is.data.frame(kl)) { # If it is under the email entered, keep it to try later and not collect it here password <- - try(keyring::key_get(service = SERVICE, username = email), + try(keyring::key_get(service = service, username = email), silent = TRUE) if ("try-error" %in% class(password)) { do_collect_password <- TRUE if (vb) - message("No password found in keyring for service='", SERVICE, ".") + message("No password found in keyring for service='", service, ".") } else { do_collect_password <- FALSE if (vb) @@ -107,7 +107,7 @@ make_login_client <- function(email = NULL, } else { if (vb) message("Error retrieving keyring data for service='", - SERVICE, + service, "'.") } } @@ -145,7 +145,7 @@ make_login_client <- function(email = NULL, # Store them in the keyring if (is_login_successful) { if (store && (do_collect_password || overwrite)) { - keyring::key_set_with_value(service = SERVICE, + keyring::key_set_with_value(service = service, username = email, password = password) if (vb) diff --git a/R/utils.R b/R/utils.R index 04e272e4..5d2b8e15 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,5 +1,7 @@ # Utility functions for the databraryr package. +utils::globalVariables(c("name", "id", "category")) + #------------------------------------------------------------------------------ #' @eval options::as_params() #' @name options_params diff --git a/man/download_single_folder_asset_fr_df.Rd b/man/download_folder_asset_from_df.Rd similarity index 91% rename from man/download_single_folder_asset_fr_df.Rd rename to man/download_folder_asset_from_df.Rd index 4d3c0167..f1f9f710 100644 --- a/man/download_single_folder_asset_fr_df.Rd +++ b/man/download_folder_asset_from_df.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/download_single_folder_asset_fr_df.R -\name{download_single_folder_asset_fr_df} -\alias{download_single_folder_asset_fr_df} +\name{download_folder_asset_from_df} +\alias{download_folder_asset_from_df} \title{Download a Single Folder Asset From a Data Frame Row.} \usage{ -download_single_folder_asset_fr_df( +download_folder_asset_from_df( i = NULL, folder_df = NULL, target_dir = tempdir(), diff --git a/man/download_single_session_asset_fr_df.Rd b/man/download_session_asset_from_df.Rd similarity index 91% rename from man/download_single_session_asset_fr_df.Rd rename to man/download_session_asset_from_df.Rd index a43b0fd5..9253a26d 100644 --- a/man/download_single_session_asset_fr_df.Rd +++ b/man/download_session_asset_from_df.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/download_single_session_asset_fr_df.R -\name{download_single_session_asset_fr_df} -\alias{download_single_session_asset_fr_df} +\name{download_session_asset_from_df} +\alias{download_session_asset_from_df} \title{Download a Single Asset From a Session Data Frame Row.} \usage{ -download_single_session_asset_fr_df( +download_session_asset_from_df( i = NULL, session_df = NULL, target_dir = tempdir(), diff --git a/man/login_db.Rd b/man/login_db.Rd index 21bcf667..9825446b 100644 --- a/man/login_db.Rd +++ b/man/login_db.Rd @@ -11,7 +11,7 @@ login_db( client_secret = NULL, store = FALSE, overwrite = FALSE, - SERVICE = KEYRING_SERVICE, + service = KEYRING_SERVICE, vb = options::opt("vb") ) } @@ -31,7 +31,7 @@ system keyring/keychain.} \item{overwrite}{A boolean value. If TRUE and store is TRUE, overwrite/ update stored credentials in keyring/keychain.} -\item{SERVICE}{A character label for stored credentials in the keyring. +\item{service}{A character label for stored credentials in the keyring. Default is \code{org.databrary.databraryr}.} \item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} diff --git a/man/make_login_client.Rd b/man/make_login_client.Rd index 2be34d26..88248f27 100644 --- a/man/make_login_client.Rd +++ b/man/make_login_client.Rd @@ -10,7 +10,7 @@ make_login_client( store = FALSE, overwrite = FALSE, vb = options::opt("vb"), - SERVICE = KEYRING_SERVICE, + service = KEYRING_SERVICE, rq = NULL ) } @@ -21,11 +21,12 @@ make_login_client( \item{store}{A boolean value. If TRUE store/retrieve credentials from the system keyring/keychain.} -\item{overwrite}{A boolean value. If TRUE and store is TRUE, overwrite/ update stored credentials in keyring/keychain.} +\item{overwrite}{A boolean value. If TRUE and store is TRUE, overwrite or +update stored credentials in keyring/keychain.} \item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} -\item{SERVICE}{A character label for stored credentials in the keyring. Default is "databrary"} +\item{service}{A character label for stored credentials in the keyring. Default is "databrary"} \item{rq}{An \code{httr2} request object. Defaults to NULL.} } diff --git a/tests/testthat/test-download_folder_assets_fr_df.R b/tests/testthat/test-download_folder_assets_fr_df.R index ccb4485e..b22cb839 100644 --- a/tests/testthat/test-download_folder_assets_fr_df.R +++ b/tests/testthat/test-download_folder_assets_fr_df.R @@ -53,7 +53,7 @@ test_that("download_folder_assets_fr_df iterates rows", { calls <- list() results <- with_mocked_bindings( download_folder_assets_fr_df(folder_df = folder_df, target_dir = tempdir(), vb = FALSE), - download_single_folder_asset_fr_df = function(i, folder_df, ...) { + download_folder_asset_from_df = function(i, folder_df, ...) { calls[[length(calls) + 1]] <<- list(i = i, folder_df = folder_df) paste0("path-", i) } diff --git a/tests/testthat/test-download_single_folder_asset_fr_df.R b/tests/testthat/test-download_single_folder_asset_fr_df.R index 91b31a25..261d9413 100644 --- a/tests/testthat/test-download_single_folder_asset_fr_df.R +++ b/tests/testthat/test-download_single_folder_asset_fr_df.R @@ -1,52 +1,52 @@ -# download_single_folder_asset_fr_df ---------------------------------------- -test_that("download_single_folder_asset_fr_df rejects bad input parameters", { - expect_error(download_single_folder_asset_fr_df(i = 0)) - expect_error(download_single_folder_asset_fr_df(i = -1)) - expect_error(download_single_folder_asset_fr_df(i = "a")) +# download_folder_asset_from_df ---------------------------------------- +test_that("download_folder_asset_from_df rejects bad input parameters", { + expect_error(download_folder_asset_from_df(i = 0)) + expect_error(download_folder_asset_from_df(i = -1)) + expect_error(download_folder_asset_from_df(i = "a")) - expect_error(download_single_folder_asset_fr_df(i = 1, folder_df = 3)) - expect_error(download_single_folder_asset_fr_df(i = 1, folder_df = "a")) - expect_error(download_single_folder_asset_fr_df(i = 1, folder_df = TRUE)) + expect_error(download_folder_asset_from_df(i = 1, folder_df = 3)) + expect_error(download_folder_asset_from_df(i = 1, folder_df = "a")) + expect_error(download_folder_asset_from_df(i = 1, folder_df = TRUE)) missing_cols <- data.frame(vol_id = 1, folder_id = 1, asset_id = 1) - expect_error(download_single_folder_asset_fr_df(i = 1, folder_df = missing_cols)) + expect_error(download_folder_asset_from_df(i = 1, folder_df = missing_cols)) - expect_error(download_single_folder_asset_fr_df(i = 1, target_dir = 3)) - expect_error(download_single_folder_asset_fr_df(i = 1, target_dir = list(a = 1, b = 2))) - expect_error(download_single_folder_asset_fr_df(i = 1, target_dir = TRUE)) + expect_error(download_folder_asset_from_df(i = 1, target_dir = 3)) + expect_error(download_folder_asset_from_df(i = 1, target_dir = list(a = 1, b = 2))) + expect_error(download_folder_asset_from_df(i = 1, target_dir = TRUE)) - expect_error(download_single_folder_asset_fr_df(i = 1, add_folder_subdir = -1)) - expect_error(download_single_folder_asset_fr_df(i = 1, add_folder_subdir = 3)) - expect_error(download_single_folder_asset_fr_df(i = 1, add_folder_subdir = "a")) - expect_error(download_single_folder_asset_fr_df(i = 1, add_folder_subdir = list(a = 1, b = 2))) + expect_error(download_folder_asset_from_df(i = 1, add_folder_subdir = -1)) + expect_error(download_folder_asset_from_df(i = 1, add_folder_subdir = 3)) + expect_error(download_folder_asset_from_df(i = 1, add_folder_subdir = "a")) + expect_error(download_folder_asset_from_df(i = 1, add_folder_subdir = list(a = 1, b = 2))) - expect_error(download_single_folder_asset_fr_df(i = 1, overwrite = -1)) - expect_error(download_single_folder_asset_fr_df(i = 1, overwrite = 3)) - expect_error(download_single_folder_asset_fr_df(i = 1, overwrite = "a")) - expect_error(download_single_folder_asset_fr_df(i = 1, overwrite = list(a = 1, b = 2))) + expect_error(download_folder_asset_from_df(i = 1, overwrite = -1)) + expect_error(download_folder_asset_from_df(i = 1, overwrite = 3)) + expect_error(download_folder_asset_from_df(i = 1, overwrite = "a")) + expect_error(download_folder_asset_from_df(i = 1, overwrite = list(a = 1, b = 2))) - expect_error(download_single_folder_asset_fr_df(i = 1, make_portable_fn = -1)) - expect_error(download_single_folder_asset_fr_df(i = 1, make_portable_fn = 3)) - expect_error(download_single_folder_asset_fr_df(i = 1, make_portable_fn = "a")) - expect_error(download_single_folder_asset_fr_df(i = 1, make_portable_fn = list(a = 1, b = 2))) + expect_error(download_folder_asset_from_df(i = 1, make_portable_fn = -1)) + expect_error(download_folder_asset_from_df(i = 1, make_portable_fn = 3)) + expect_error(download_folder_asset_from_df(i = 1, make_portable_fn = "a")) + expect_error(download_folder_asset_from_df(i = 1, make_portable_fn = list(a = 1, b = 2))) - expect_error(download_single_folder_asset_fr_df(i = 1, timeout_secs = -1)) - expect_error(download_single_folder_asset_fr_df(i = 1, timeout_secs = TRUE)) - expect_error(download_single_folder_asset_fr_df(i = 1, timeout_secs = "a")) - expect_error(download_single_folder_asset_fr_df(i = 1, timeout_secs = list(a = 1, b = 2))) + expect_error(download_folder_asset_from_df(i = 1, timeout_secs = -1)) + expect_error(download_folder_asset_from_df(i = 1, timeout_secs = TRUE)) + expect_error(download_folder_asset_from_df(i = 1, timeout_secs = "a")) + expect_error(download_folder_asset_from_df(i = 1, timeout_secs = list(a = 1, b = 2))) - expect_error(download_single_folder_asset_fr_df(i = 1, vb = -1)) - expect_error(download_single_folder_asset_fr_df(i = 1, vb = 3)) - expect_error(download_single_folder_asset_fr_df(i = 1, vb = "a")) - expect_error(download_single_folder_asset_fr_df(i = 1, vb = list(a = 1, b = 2))) + expect_error(download_folder_asset_from_df(i = 1, vb = -1)) + expect_error(download_folder_asset_from_df(i = 1, vb = 3)) + expect_error(download_folder_asset_from_df(i = 1, vb = "a")) + expect_error(download_folder_asset_from_df(i = 1, vb = list(a = 1, b = 2))) - expect_error(download_single_folder_asset_fr_df(i = 1, rq = "a")) - expect_error(download_single_folder_asset_fr_df(i = 1, rq = -1)) - expect_error(download_single_folder_asset_fr_df(i = 1, rq = c(2, 3))) - expect_error(download_single_folder_asset_fr_df(i = 1, rq = list(a = 1, b = 2))) + expect_error(download_folder_asset_from_df(i = 1, rq = "a")) + expect_error(download_folder_asset_from_df(i = 1, rq = -1)) + expect_error(download_folder_asset_from_df(i = 1, rq = c(2, 3))) + expect_error(download_folder_asset_from_df(i = 1, rq = list(a = 1, b = 2))) }) -test_that("download_single_folder_asset_fr_df delegates to download_folder_asset", { +test_that("download_folder_asset_from_df delegates to download_folder_asset", { folder_df <- tibble::tibble( vol_id = 1, folder_id = 2, @@ -57,7 +57,7 @@ test_that("download_single_folder_asset_fr_df delegates to download_folder_asset captured <- NULL result <- with_mocked_bindings( - download_single_folder_asset_fr_df(i = 1, folder_df = folder_df, target_dir = tempdir()), + download_folder_asset_from_df(i = 1, folder_df = folder_df, target_dir = tempdir()), download_folder_asset = function(vol_id, folder_id, asset_id, file_name, target_dir, ...) { captured <<- list( vol_id = vol_id, diff --git a/tests/testthat/test-download_single_session_asset_fr_df.R b/tests/testthat/test-download_single_session_asset_fr_df.R index 263cccb8..ae72dcaa 100644 --- a/tests/testthat/test-download_single_session_asset_fr_df.R +++ b/tests/testthat/test-download_single_session_asset_fr_df.R @@ -1,47 +1,47 @@ -# download_single_session_asset_fr_df --------------------------------------------------------- -test_that("download_single_session_asset_fr_df rejects bad input parameters", { - expect_error(download_single_session_asset_fr_df(i = 0)) - expect_error(download_single_session_asset_fr_df(i = -1)) - expect_error(download_single_session_asset_fr_df(i = "a")) +# download_session_asset_from_df --------------------------------------------------------- +test_that("download_session_asset_from_df rejects bad input parameters", { + expect_error(download_session_asset_from_df(i = 0)) + expect_error(download_session_asset_from_df(i = -1)) + expect_error(download_session_asset_from_df(i = "a")) - expect_error(download_single_session_asset_fr_df(session_df = 3)) - expect_error(download_single_session_asset_fr_df(session_df = "a")) - expect_error(download_single_session_asset_fr_df(session_df = TRUE)) + expect_error(download_session_asset_from_df(session_df = 3)) + expect_error(download_session_asset_from_df(session_df = "a")) + expect_error(download_session_asset_from_df(session_df = TRUE)) missing_cols <- data.frame(vol_id = 1, session_id = 1, asset_id = 1) - expect_error(download_single_session_asset_fr_df(i = 1, session_df = missing_cols)) - - expect_error(download_single_session_asset_fr_df(i = 1, target_dir = 3)) - expect_error(download_single_session_asset_fr_df(i = 1, target_dir = list(a = 1, b = 2))) - expect_error(download_single_session_asset_fr_df(i = 1, target_dir = TRUE)) - - expect_error(download_single_session_asset_fr_df(i = 1, add_session_subdir = -1)) - expect_error(download_single_session_asset_fr_df(i = 1, add_session_subdir = 3)) - expect_error(download_single_session_asset_fr_df(i = 1, add_session_subdir = "a")) - expect_error(download_single_session_asset_fr_df(i = 1, add_session_subdir = list(a = 1, b = 2))) - - expect_error(download_single_session_asset_fr_df(i = 1, overwrite = -1)) - expect_error(download_single_session_asset_fr_df(i = 1, overwrite = 3)) - expect_error(download_single_session_asset_fr_df(i = 1, overwrite = "a")) - expect_error(download_single_session_asset_fr_df(i = 1, overwrite = list(a = 1, b = 2))) - - expect_error(download_single_session_asset_fr_df(i = 1, make_portable_fn = -1)) - expect_error(download_single_session_asset_fr_df(i = 1, make_portable_fn = 3)) - expect_error(download_single_session_asset_fr_df(i = 1, make_portable_fn = "a")) - expect_error(download_single_session_asset_fr_df(i = 1, make_portable_fn = list(a = 1, b = 2))) - - expect_error(download_single_session_asset_fr_df(i = 1, timeout_secs = -1)) - expect_error(download_single_session_asset_fr_df(i = 1, timeout_secs = TRUE)) - expect_error(download_single_session_asset_fr_df(i = 1, timeout_secs = "a")) - expect_error(download_single_session_asset_fr_df(i = 1, timeout_secs = list(a = 1, b = 2))) - - expect_error(download_single_session_asset_fr_df(i = 1, vb = -1)) - expect_error(download_single_session_asset_fr_df(i = 1, vb = 3)) - expect_error(download_single_session_asset_fr_df(i = 1, vb = "a")) - expect_error(download_single_session_asset_fr_df(i = 1, vb = list(a = 1, b = 2))) - - expect_error(download_single_session_asset_fr_df(i = 1, rq = "a")) - expect_error(download_single_session_asset_fr_df(i = 1, rq = -1)) - expect_error(download_single_session_asset_fr_df(i = 1, rq = c(2, 3))) - expect_error(download_single_session_asset_fr_df(i = 1, rq = list(a = 1, b = 2))) + expect_error(download_session_asset_from_df(i = 1, session_df = missing_cols)) + + expect_error(download_session_asset_from_df(i = 1, target_dir = 3)) + expect_error(download_session_asset_from_df(i = 1, target_dir = list(a = 1, b = 2))) + expect_error(download_session_asset_from_df(i = 1, target_dir = TRUE)) + + expect_error(download_session_asset_from_df(i = 1, add_session_subdir = -1)) + expect_error(download_session_asset_from_df(i = 1, add_session_subdir = 3)) + expect_error(download_session_asset_from_df(i = 1, add_session_subdir = "a")) + expect_error(download_session_asset_from_df(i = 1, add_session_subdir = list(a = 1, b = 2))) + + expect_error(download_session_asset_from_df(i = 1, overwrite = -1)) + expect_error(download_session_asset_from_df(i = 1, overwrite = 3)) + expect_error(download_session_asset_from_df(i = 1, overwrite = "a")) + expect_error(download_session_asset_from_df(i = 1, overwrite = list(a = 1, b = 2))) + + expect_error(download_session_asset_from_df(i = 1, make_portable_fn = -1)) + expect_error(download_session_asset_from_df(i = 1, make_portable_fn = 3)) + expect_error(download_session_asset_from_df(i = 1, make_portable_fn = "a")) + expect_error(download_session_asset_from_df(i = 1, make_portable_fn = list(a = 1, b = 2))) + + expect_error(download_session_asset_from_df(i = 1, timeout_secs = -1)) + expect_error(download_session_asset_from_df(i = 1, timeout_secs = TRUE)) + expect_error(download_session_asset_from_df(i = 1, timeout_secs = "a")) + expect_error(download_session_asset_from_df(i = 1, timeout_secs = list(a = 1, b = 2))) + + expect_error(download_session_asset_from_df(i = 1, vb = -1)) + expect_error(download_session_asset_from_df(i = 1, vb = 3)) + expect_error(download_session_asset_from_df(i = 1, vb = "a")) + expect_error(download_session_asset_from_df(i = 1, vb = list(a = 1, b = 2))) + + expect_error(download_session_asset_from_df(i = 1, rq = "a")) + expect_error(download_session_asset_from_df(i = 1, rq = -1)) + expect_error(download_session_asset_from_df(i = 1, rq = c(2, 3))) + expect_error(download_session_asset_from_df(i = 1, rq = list(a = 1, b = 2))) }) diff --git a/tests/testthat/test-make_login_client.R b/tests/testthat/test-make_login_client.R index f18b3706..be18e185 100644 --- a/tests/testthat/test-make_login_client.R +++ b/tests/testthat/test-make_login_client.R @@ -21,9 +21,9 @@ test_that("make_login_client rejects bad input parameters", { expect_error(make_login_client(vb = 3)) expect_error(make_login_client(vb = "a")) - expect_error(make_login_client(SERVICE = -1, email = "user@example.com", password = "pw")) - expect_error(make_login_client(SERVICE = TRUE, email = "user@example.com", password = "pw")) - expect_error(make_login_client(SERVICE = list("a", "b"), email = "user@example.com", password = "pw")) + expect_error(make_login_client(service = -1, email = "user@example.com", password = "pw")) + expect_error(make_login_client(service = TRUE, email = "user@example.com", password = "pw")) + expect_error(make_login_client(service = list("a", "b"), email = "user@example.com", password = "pw")) expect_error(make_login_client(rq = 3, email = "user@example.com", password = "pw")) expect_error(make_login_client(rq = "a", email = "user@example.com", password = "pw")) From 6f4e18deec69869bec034e3af360dcdb97de0a42 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 12 Feb 2026 11:50:28 +0100 Subject: [PATCH 35/77] chore: update documentation to include `rq` parameter in relevant functions and fix formatting in examples --- .Rbuildignore | 1 + .github/workflows/lint.yaml | 2 +- R/get_institution_by_id.R | 1 + R/get_user_by_id.R | 1 + R/list_session_activity.R | 4 ++-- R/list_user_sponsors.R | 1 + R/whoami.R | 2 +- man/get_institution_by_id.Rd | 2 ++ man/get_user_by_id.Rd | 2 ++ man/list_session_activity.Rd | 4 ++-- man/list_user_sponsors.Rd | 2 ++ man/whoami.Rd | 2 +- 12 files changed, 17 insertions(+), 7 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index 4f1536ac..91d3c5d4 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -9,6 +9,7 @@ ^_notes$ ^tmp$ ^_wip +^\.lintr$ ^\.github$ ^cran-comments\.md$ ^CRAN-SUBMISSION$ diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml index 185be140..ef5a5b45 100644 --- a/.github/workflows/lint.yaml +++ b/.github/workflows/lint.yaml @@ -24,7 +24,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::lintr, any::pkgload, local::. + extra-packages: lintr@3.2.0, any::pkgload, local::. needs: lint - name: Lint diff --git a/R/get_institution_by_id.R b/R/get_institution_by_id.R index 5dcd9baa..9c7a9e7b 100644 --- a/R/get_institution_by_id.R +++ b/R/get_institution_by_id.R @@ -7,6 +7,7 @@ NULL #' #' @param institution_id Institution identifier. Must be a positive integer. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @param rq An `httr2` request object. Defaults to `NULL`. #' @inheritParams options_params #' #' @return List of institution metadata or NULL when inaccessible. diff --git a/R/get_user_by_id.R b/R/get_user_by_id.R index a7698bb0..11d972a1 100644 --- a/R/get_user_by_id.R +++ b/R/get_user_by_id.R @@ -7,6 +7,7 @@ NULL #' #' @param user_id User identifier. Must be a positive integer. Default is 6. #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @param rq An `httr2` request object. Defaults to `NULL`. #' @inheritParams options_params #' #' @return A list with the user's public metadata. diff --git a/R/list_session_activity.R b/R/list_session_activity.R index 985f12f4..c8326fa1 100644 --- a/R/list_session_activity.R +++ b/R/list_session_activity.R @@ -21,8 +21,8 @@ NULL #' @inheritParams options_params #' #' @examples -#' \\donttest{ -#' \\dontrun{ +#' \donttest{ +#' \dontrun{ #' list_session_activity(vol_id = 1892, session_id = 76113) #' } #' } diff --git a/R/list_user_sponsors.R b/R/list_user_sponsors.R index 49d30c57..1af17b40 100644 --- a/R/list_user_sponsors.R +++ b/R/list_user_sponsors.R @@ -6,6 +6,7 @@ NULL #' List sponsorships for a user #' #' @param user_id User identifier. +#' @param rq An `httr2` request object. Defaults to `NULL`. #' @inheritParams options_params #' #' @returns Tibble of sponsors for the user. diff --git a/R/whoami.R b/R/whoami.R index deda9f9a..766a56e8 100644 --- a/R/whoami.R +++ b/R/whoami.R @@ -14,7 +14,7 @@ #' `NULL` if the request fails due to lack of authentication. #' #' @examples -#' \\dontrun{ +#' \dontrun{ #' login_db() #' whoami() #' } diff --git a/man/get_institution_by_id.Rd b/man/get_institution_by_id.Rd index 924650c8..a36c5328 100644 --- a/man/get_institution_by_id.Rd +++ b/man/get_institution_by_id.Rd @@ -10,6 +10,8 @@ get_institution_by_id(institution_id = 12, vb = options::opt("vb"), rq = NULL) \item{institution_id}{Institution identifier. Must be a positive integer.} \item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } \value{ List of institution metadata or NULL when inaccessible. diff --git a/man/get_user_by_id.Rd b/man/get_user_by_id.Rd index f730942b..dad3bbc9 100644 --- a/man/get_user_by_id.Rd +++ b/man/get_user_by_id.Rd @@ -10,6 +10,8 @@ get_user_by_id(user_id = 6, vb = options::opt("vb"), rq = NULL) \item{user_id}{User identifier. Must be a positive integer. Default is 6.} \item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } \value{ A list with the user's public metadata. diff --git a/man/list_session_activity.Rd b/man/list_session_activity.Rd index 863c85ad..ffa4fab1 100644 --- a/man/list_session_activity.Rd +++ b/man/list_session_activity.Rd @@ -31,8 +31,8 @@ For an accessible session, returns the logged history events associated with the session. Requires authenticated access with sufficient permissions. } \examples{ -\\donttest{ -\\dontrun{ +\donttest{ +\dontrun{ list_session_activity(vol_id = 1892, session_id = 76113) } } diff --git a/man/list_user_sponsors.Rd b/man/list_user_sponsors.Rd index 8dd7fbe5..d7f5300e 100644 --- a/man/list_user_sponsors.Rd +++ b/man/list_user_sponsors.Rd @@ -10,6 +10,8 @@ list_user_sponsors(user_id = 6, vb = options::opt("vb"), rq = NULL) \item{user_id}{User identifier.} \item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } \value{ Tibble of sponsors for the user. diff --git a/man/whoami.Rd b/man/whoami.Rd index dc27236b..8b21677e 100644 --- a/man/whoami.Rd +++ b/man/whoami.Rd @@ -22,7 +22,7 @@ method and user profile. Requires a valid OAuth2 access token acquired via \code{login_db()}. } \examples{ -\\dontrun{ +\dontrun{ login_db() whoami() } From d0a8fcb45e60af7ec0c0342f1202406bc39bf333 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 12 Feb 2026 12:08:14 +0100 Subject: [PATCH 36/77] chore: update documentation examples to use \dontrun instead of \donttest for consistency --- R/assign_constants.R | 2 +- R/check_ssl_certs.R | 2 +- R/get_db_stats.R | 2 +- R/get_volume_by_id.R | 2 +- R/list_asset_formats.R | 2 +- R/list_volume_tags.R | 2 +- R/make_default_request.R | 2 +- R/search_for_funder.R | 2 +- man/assign_constants.Rd | 2 +- man/check_ssl_certs.Rd | 2 +- man/get_db_stats.Rd | 2 +- man/get_volume_by_id.Rd | 2 +- man/list_asset_formats.Rd | 2 +- man/list_volume_tags.Rd | 2 +- man/make_default_request.Rd | 2 +- man/search_for_funder.Rd | 2 +- 16 files changed, 16 insertions(+), 16 deletions(-) diff --git a/R/assign_constants.R b/R/assign_constants.R index 1d295b92..eb9ae9ed 100644 --- a/R/assign_constants.R +++ b/R/assign_constants.R @@ -13,7 +13,7 @@ NULL #' @inheritParams options_params #' #' @examples -#' \donttest{ +#' \dontrun{ #' assign_constants() #' } #' @export diff --git a/R/check_ssl_certs.R b/R/check_ssl_certs.R index 038fdc51..bbb5b654 100644 --- a/R/check_ssl_certs.R +++ b/R/check_ssl_certs.R @@ -8,7 +8,7 @@ #' @returns A data frame with information about the SSL certificates. #' #' @examples -#' \donttest{ +#' \dontrun{ #' check_ssl_certs() #' } #' @export diff --git a/R/get_db_stats.R b/R/get_db_stats.R index 5538689a..9827341f 100644 --- a/R/get_db_stats.R +++ b/R/get_db_stats.R @@ -18,7 +18,7 @@ NULL #' @inheritParams options_params #' #' @examples -#' \donttest{ +#' \dontrun{ #' get_db_stats() #' get_db_stats("stats") #' } diff --git a/R/get_volume_by_id.R b/R/get_volume_by_id.R index 71a906ec..c8c8e34a 100644 --- a/R/get_volume_by_id.R +++ b/R/get_volume_by_id.R @@ -16,7 +16,7 @@ NULL #' @inheritParams options_params #' #' @examples -#' \donttest{ +#' \dontrun{ #' get_volume_by_id() # Default is Volume 1 #' } #' diff --git a/R/list_asset_formats.R b/R/list_asset_formats.R index 32e8e0ea..97d14290 100644 --- a/R/list_asset_formats.R +++ b/R/list_asset_formats.R @@ -15,7 +15,7 @@ NULL #' @inheritParams options_params #' #' @examples -#' \donttest{ +#' \dontrun{ #' list_asset_formats() #' } #' @export diff --git a/R/list_volume_tags.R b/R/list_volume_tags.R index b137e028..696e9cd7 100644 --- a/R/list_volume_tags.R +++ b/R/list_volume_tags.R @@ -14,7 +14,7 @@ NULL #' @inheritParams options_params #' #' @examples -#' \donttest{ +#' \dontrun{ #' list_volume_tags() #' } #' @export diff --git a/R/make_default_request.R b/R/make_default_request.R index 5866c638..5962e1af 100644 --- a/R/make_default_request.R +++ b/R/make_default_request.R @@ -13,7 +13,7 @@ #' @returns An `httr2_request` object configured for the Databrary API. #' #' @examples -#' make_default_request() +#' make_default_request(with_token = FALSE) #' @export make_default_request <- function(with_token = TRUE, refresh = TRUE, diff --git a/R/search_for_funder.R b/R/search_for_funder.R index 4942f072..2d3f7b49 100644 --- a/R/search_for_funder.R +++ b/R/search_for_funder.R @@ -16,7 +16,7 @@ NULL #' @inheritParams options_params #' #' @examples -#' \donttest{ +#' \dontrun{ #' search_for_funder("national+science+foundation") #' } #' diff --git a/man/assign_constants.Rd b/man/assign_constants.Rd index 99803e21..b276ae0e 100644 --- a/man/assign_constants.Rd +++ b/man/assign_constants.Rd @@ -18,7 +18,7 @@ A data frame with the constants. Download Databrary Constants From API. } \examples{ -\donttest{ +\dontrun{ assign_constants() } } diff --git a/man/check_ssl_certs.Rd b/man/check_ssl_certs.Rd index 3978b43a..5f023fce 100644 --- a/man/check_ssl_certs.Rd +++ b/man/check_ssl_certs.Rd @@ -17,7 +17,7 @@ A data frame with information about the SSL certificates. and returns a data frame with the relevant information. } \examples{ -\donttest{ +\dontrun{ check_ssl_certs() } } diff --git a/man/get_db_stats.Rd b/man/get_db_stats.Rd index 3036c764..369672ff 100644 --- a/man/get_db_stats.Rd +++ b/man/get_db_stats.Rd @@ -22,7 +22,7 @@ Returns basic summary information about the institutions, people, and video data hosted on Databrary. } \examples{ -\donttest{ +\dontrun{ get_db_stats() get_db_stats("stats") } diff --git a/man/get_volume_by_id.Rd b/man/get_volume_by_id.Rd index 91505b60..6b24e545 100644 --- a/man/get_volume_by_id.Rd +++ b/man/get_volume_by_id.Rd @@ -22,7 +22,7 @@ A tibble with summary information about a volume. Get Summary Data About A Databrary Volume } \examples{ -\donttest{ +\dontrun{ get_volume_by_id() # Default is Volume 1 } diff --git a/man/list_asset_formats.Rd b/man/list_asset_formats.Rd index 07960491..4101da61 100644 --- a/man/list_asset_formats.Rd +++ b/man/list_asset_formats.Rd @@ -17,7 +17,7 @@ supports. List the data (file) formats supported by Databrary. } \examples{ -\donttest{ +\dontrun{ list_asset_formats() } } diff --git a/man/list_volume_tags.Rd b/man/list_volume_tags.Rd index 5a45843c..dd8e68f7 100644 --- a/man/list_volume_tags.Rd +++ b/man/list_volume_tags.Rd @@ -20,7 +20,7 @@ A data frame with the requested data. Lists Keywords And Tags For A Volume. } \examples{ -\donttest{ +\dontrun{ list_volume_tags() } } diff --git a/man/make_default_request.Rd b/man/make_default_request.Rd index b79abc2d..2352cafb 100644 --- a/man/make_default_request.Rd +++ b/man/make_default_request.Rd @@ -27,5 +27,5 @@ Creates an \code{httr2} request with the package's default options, including base URL, user agent, Accept header, and timeout tuned for the Django API. } \examples{ -make_default_request() +make_default_request(with_token = FALSE) } diff --git a/man/search_for_funder.Rd b/man/search_for_funder.Rd index abf2cbd5..e40c89b0 100644 --- a/man/search_for_funder.Rd +++ b/man/search_for_funder.Rd @@ -28,7 +28,7 @@ A data frame with information about the funder. Report Information About A Funder. } \examples{ -\donttest{ +\dontrun{ search_for_funder("national+science+foundation") } From fcf0ac2de44ce30396bdff8d5b9caf8e494b4645 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 12 Feb 2026 12:14:03 +0100 Subject: [PATCH 37/77] chore: remove unnecessary namespace prefixes in constants and update DESCRIPTION imports --- DESCRIPTION | 4 +--- R/assign_constants.R | 4 ++-- R/utils.R | 2 +- man/get_supported_file_types.Rd | 2 +- 4 files changed, 5 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 75cce7dd..01f9e66c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,15 +25,13 @@ Imports: httr2 (>= 1.0.0), keyring (>= 1.3.2), lifecycle (>= 1.0.4), - magick (>= 2.8.2), magrittr, methods (>= 4.3.2), options (>= 0.2.0), purrr (>= 1.0.2), stringr (>= 1.5.1), stats, - tibble (>= 3.2.1), - xfun (>= 0.41) + tibble (>= 3.2.1) Suggests: av (>= 0.9.0), covr (>= 3.6.0), diff --git a/R/assign_constants.R b/R/assign_constants.R index eb9ae9ed..85dfbf0b 100644 --- a/R/assign_constants.R +++ b/R/assign_constants.R @@ -54,7 +54,7 @@ assign_constants <- function(vb = options::opt("vb"), rq = NULL) { list( format = format_entries, format_df = formats_df, - permission = databraryr:::get_permission_levels_enums(), - release = databraryr:::get_release_levels_enums() + permission = get_permission_levels_enums(), + release = get_release_levels_enums() ) } diff --git a/R/utils.R b/R/utils.R index 5d2b8e15..28dbcd54 100644 --- a/R/utils.R +++ b/R/utils.R @@ -85,7 +85,7 @@ get_release_levels <- function(vb = options::opt("vb")) { #' @inheritParams options_params #' #' @examples -#' \donttest{ +#' \dontrun{ #' get_supported_file_types() #' } #' diff --git a/man/get_supported_file_types.Rd b/man/get_supported_file_types.Rd index 428f008a..9f004d4f 100644 --- a/man/get_supported_file_types.Rd +++ b/man/get_supported_file_types.Rd @@ -16,7 +16,7 @@ A data frame with the file types permitted on Databrary. Extracts File Types Supported by Databrary. } \examples{ -\donttest{ +\dontrun{ get_supported_file_types() } From 9e311b1fda8b738842a3a37e4442d366ac4447a1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 12 Feb 2026 12:15:15 +0100 Subject: [PATCH 38/77] chore: temporarily disable coverage threshold enforcement and update messaging for coverage results --- .github/workflows/test-coverage.yaml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index f382f79d..40a5f6bf 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -37,10 +37,12 @@ jobs: covr::to_cobertura(cov) pct <- covr::percent_coverage(cov) cat("Coverage:", pct, "%\n") + # TODO: Re-enable coverage threshold once target is met + # if (pct < 80) stop("Coverage is below 80% (", pct, "%)") if (pct < 80) { - stop("Coverage is below 80% (", pct, "%)") + warning("Coverage is below 80% (", pct, "%) - threshold temporarily disabled") } else if (pct < 90) { - warning("Coverage is below 90% (", pct, "%)") + message("Coverage is below 90% (", pct, "%)") } else { message("Coverage is above 90% (", pct, "%)") } From f61e67eb5d771dae0cbf2fa84a1ad7ea0fab90cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Fri, 20 Feb 2026 08:55:46 +0100 Subject: [PATCH 39/77] feat: enhance validation and testing documentation for Databrary API interactions --- .gitignore | 1 + R/api_utils.R | 36 ++++++++++++++++++++++++++- R/assign_record_to_file.R | 46 ++++------------------------------ R/create_volume_record.R | 28 +++------------------ R/delete_record_measure.R | 36 +++------------------------ R/delete_volume_record.R | 26 +++---------------- R/set_record_measure.R | 36 +++------------------------ R/unassign_record_from_file.R | 46 ++++------------------------------ R/update_volume_record.R | 47 ++++++++++------------------------- README.md | 30 ++++++++++++++++++++++ tests/testthat/helper-auth.R | 45 ++++++++++++++++++--------------- 11 files changed, 128 insertions(+), 249 deletions(-) diff --git a/.gitignore b/.gitignore index b7c0678c..5eab9bcf 100644 --- a/.gitignore +++ b/.gitignore @@ -20,4 +20,5 @@ tmp docs /doc/ /Meta/ +.Renviron* diff --git a/R/api_utils.R b/R/api_utils.R index 7f1dc8e7..934eabc8 100644 --- a/R/api_utils.R +++ b/R/api_utils.R @@ -1,5 +1,29 @@ # Internal helpers for interacting with the Databrary Django API. +#' Validate that a value is a single positive integer (e.g. vol_id, record_id). +#' @noRd +assert_positive_integer <- function(x, name = deparse(substitute(x))) { + assertthat::assert_that( + length(x) == 1, + msg = paste(name, "must have length 1") + ) + assertthat::assert_that( + is.numeric(x), + msg = paste(name, "must be numeric") + ) + assertthat::assert_that(x >= 1, msg = paste(name, "must be >= 1")) + assertthat::assert_that( + x == floor(x), + msg = paste(name, "must be an integer") + ) + invisible(TRUE) +} + +#' @noRd +resp_has_body <- function(response) { + length(httr2::resp_body_raw(response)) > 0 +} + #' @noRd ensure_leading_slash <- function(path) { assertthat::assert_that(assertthat::is.string(path)) @@ -65,6 +89,11 @@ perform_api_get <- function(path, return(NULL) } + status <- httr2::resp_status(response) + if (status == 204L || !resp_has_body(response)) { + return(NULL) + } + body <- switch( response_type, json = { @@ -208,7 +237,7 @@ perform_api_post <- function(path, } status <- httr2::resp_status(response) - if (status == 204L) { + if (status == 204L || !resp_has_body(response)) { return(TRUE) } @@ -252,6 +281,11 @@ perform_api_patch <- function(path, return(NULL) } + status <- httr2::resp_status(response) + if (status == 204L || !resp_has_body(response)) { + return(TRUE) + } + payload <- httr2::resp_body_json(response) if (isTRUE(normalize)) { payload <- snake_case_list(payload) diff --git a/R/assign_record_to_file.R b/R/assign_record_to_file.R index a4f4ac7a..505b0dc9 100644 --- a/R/assign_record_to_file.R +++ b/R/assign_record_to_file.R @@ -41,47 +41,11 @@ assign_record_to_file <- function( vb = options::opt("vb"), rq = NULL ) { - # Validate vol_id - assertthat::assert_that(length(vol_id) == 1) - assertthat::assert_that(is.numeric(vol_id)) - assertthat::assert_that(vol_id >= 1) - assertthat::assert_that( - vol_id == floor(vol_id), - msg = "vol_id must be an integer" - ) - - # Validate session_id - assertthat::assert_that(is.numeric(session_id)) - assertthat::assert_that(length(session_id) == 1) - assertthat::assert_that(session_id > 0) - assertthat::assert_that( - session_id == floor(session_id), - msg = "session_id must be an integer" - ) - - # Validate file_id - assertthat::assert_that(is.numeric(file_id)) - assertthat::assert_that(length(file_id) == 1) - assertthat::assert_that(file_id > 0) - assertthat::assert_that( - file_id == floor(file_id), - msg = "file_id must be an integer" - ) - - # Validate record_id - assertthat::assert_that(is.numeric(record_id)) - assertthat::assert_that(length(record_id) == 1) - assertthat::assert_that(record_id > 0) - assertthat::assert_that( - record_id == floor(record_id), - msg = "record_id must be an integer" - ) - - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - # Validate rq + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer(file_id, "file_id") + assert_positive_integer(record_id, "record_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) # Build request body diff --git a/R/create_volume_record.R b/R/create_volume_record.R index 7bdf017a..e71d059e 100644 --- a/R/create_volume_record.R +++ b/R/create_volume_record.R @@ -160,42 +160,20 @@ create_volume_record <- function( vb = options::opt("vb"), rq = NULL ) { - # Validate vol_id - assertthat::assert_that(length(vol_id) == 1) - assertthat::assert_that(is.numeric(vol_id)) - assertthat::assert_that(vol_id >= 1) - assertthat::assert_that( - vol_id == floor(vol_id), - msg = "vol_id must be an integer" - ) - - # Validate category_id - assertthat::assert_that(length(category_id) == 1) - assertthat::assert_that(is.numeric(category_id)) - assertthat::assert_that(category_id > 0) - assertthat::assert_that( - category_id == floor(category_id), - msg = "category_id must be an integer" - ) + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(category_id, "category_id") - # Validate name assertthat::assert_that(is.character(name)) assertthat::assert_that(length(name) == 1) assertthat::assert_that(nzchar(trimws(name)), msg = "name must not be empty") - # Validate measures assertthat::assert_that(is.list(measures)) - # Validate participant if (!is.null(participant)) { assertthat::assert_that(is.list(participant)) } - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - # Validate rq + assertthat::assert_that(is.logical(vb), length(vb) == 1) assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) # Resolve name metric and build measures with name diff --git a/R/delete_record_measure.R b/R/delete_record_measure.R index de6b258a..9dd99c1f 100644 --- a/R/delete_record_measure.R +++ b/R/delete_record_measure.R @@ -45,38 +45,10 @@ delete_record_measure <- function( vb = options::opt("vb"), rq = NULL ) { - # Validate vol_id - assertthat::assert_that(length(vol_id) == 1) - assertthat::assert_that(is.numeric(vol_id)) - assertthat::assert_that(vol_id >= 1) - assertthat::assert_that( - vol_id == floor(vol_id), - msg = "vol_id must be an integer" - ) - - # Validate record_id - assertthat::assert_that(is.numeric(record_id)) - assertthat::assert_that(length(record_id) == 1) - assertthat::assert_that(record_id > 0) - assertthat::assert_that( - record_id == floor(record_id), - msg = "record_id must be an integer" - ) - - # Validate metric_id - assertthat::assert_that(is.numeric(metric_id)) - assertthat::assert_that(length(metric_id) == 1) - assertthat::assert_that(metric_id > 0) - assertthat::assert_that( - metric_id == floor(metric_id), - msg = "metric_id must be an integer" - ) - - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - # Validate rq + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(record_id, "record_id") + assert_positive_integer(metric_id, "metric_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) # Perform API call diff --git a/R/delete_volume_record.R b/R/delete_volume_record.R index bc3455d7..7f9e7f0f 100644 --- a/R/delete_volume_record.R +++ b/R/delete_volume_record.R @@ -35,29 +35,9 @@ delete_volume_record <- function( vb = options::opt("vb"), rq = NULL ) { - # Validate vol_id - assertthat::assert_that(is.numeric(vol_id)) - assertthat::assert_that(length(vol_id) == 1) - assertthat::assert_that(vol_id >= 1) - assertthat::assert_that( - vol_id == floor(vol_id), - msg = "vol_id must be an integer" - ) - - # Validate record_id - assertthat::assert_that(is.numeric(record_id)) - assertthat::assert_that(length(record_id) == 1) - assertthat::assert_that(record_id > 0) - assertthat::assert_that( - record_id == floor(record_id), - msg = "record_id must be an integer" - ) - - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - # Validate rq + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(record_id, "record_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) # Perform API call diff --git a/R/set_record_measure.R b/R/set_record_measure.R index f65fce1a..31e42434 100644 --- a/R/set_record_measure.R +++ b/R/set_record_measure.R @@ -58,38 +58,10 @@ set_record_measure <- function( vb = options::opt("vb"), rq = NULL ) { - # Validate vol_id - assertthat::assert_that(length(vol_id) == 1) - assertthat::assert_that(is.numeric(vol_id)) - assertthat::assert_that(vol_id >= 1) - assertthat::assert_that( - vol_id == floor(vol_id), - msg = "vol_id must be an integer" - ) - - # Validate record_id - assertthat::assert_that(is.numeric(record_id)) - assertthat::assert_that(length(record_id) == 1) - assertthat::assert_that(record_id > 0) - assertthat::assert_that( - record_id == floor(record_id), - msg = "record_id must be an integer" - ) - - # Validate metric_id - assertthat::assert_that(is.numeric(metric_id)) - assertthat::assert_that(length(metric_id) == 1) - assertthat::assert_that(metric_id > 0) - assertthat::assert_that( - metric_id == floor(metric_id), - msg = "metric_id must be an integer" - ) - - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - # Validate rq + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(record_id, "record_id") + assert_positive_integer(metric_id, "metric_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) # Build request body diff --git a/R/unassign_record_from_file.R b/R/unassign_record_from_file.R index 105106eb..1069ca59 100644 --- a/R/unassign_record_from_file.R +++ b/R/unassign_record_from_file.R @@ -40,47 +40,11 @@ unassign_record_from_file <- function( vb = options::opt("vb"), rq = NULL ) { - # Validate vol_id - assertthat::assert_that(length(vol_id) == 1) - assertthat::assert_that(is.numeric(vol_id)) - assertthat::assert_that(vol_id >= 1) - assertthat::assert_that( - vol_id == floor(vol_id), - msg = "vol_id must be an integer" - ) - - # Validate session_id - assertthat::assert_that(is.numeric(session_id)) - assertthat::assert_that(length(session_id) == 1) - assertthat::assert_that(session_id > 0) - assertthat::assert_that( - session_id == floor(session_id), - msg = "session_id must be an integer" - ) - - # Validate file_id - assertthat::assert_that(is.numeric(file_id)) - assertthat::assert_that(length(file_id) == 1) - assertthat::assert_that(file_id > 0) - assertthat::assert_that( - file_id == floor(file_id), - msg = "file_id must be an integer" - ) - - # Validate record_id - assertthat::assert_that(is.numeric(record_id)) - assertthat::assert_that(length(record_id) == 1) - assertthat::assert_that(record_id > 0) - assertthat::assert_that( - record_id == floor(record_id), - msg = "record_id must be an integer" - ) - - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - # Validate rq + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer(file_id, "file_id") + assert_positive_integer(record_id, "record_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) # Build request body diff --git a/R/update_volume_record.R b/R/update_volume_record.R index b1ee3032..ef079c0f 100644 --- a/R/update_volume_record.R +++ b/R/update_volume_record.R @@ -54,53 +54,37 @@ update_volume_record <- function( vb = options::opt("vb"), rq = NULL ) { - # Validate vol_id - assertthat::assert_that(length(vol_id) == 1) - assertthat::assert_that(is.numeric(vol_id)) - assertthat::assert_that(vol_id >= 1) - assertthat::assert_that( - vol_id == floor(vol_id), - msg = "vol_id must be an integer" - ) - - # Validate record_id - assertthat::assert_that(is.numeric(record_id)) - assertthat::assert_that(length(record_id) == 1) - assertthat::assert_that(record_id > 0) - assertthat::assert_that( - record_id == floor(record_id), - msg = "record_id must be an integer" - ) + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(record_id, "record_id") - # Validate measures if (!is.null(measures)) { assertthat::assert_that(is.list(measures)) } - # Validate participant if (!is.null(participant)) { assertthat::assert_that(is.list(participant)) } - # Validate vb - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - # Validate rq + assertthat::assert_that(is.logical(vb), length(vb) == 1) assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - # Build request body (only include non-NULL fields) body <- list() - + if (!is.null(measures)) { body$measures <- measures } - + if (!is.null(participant)) { body$participant <- participant } - # Perform API call + if (length(body) == 0) { + if (vb) { + message("No fields provided to update for record ", record_id) + } + return(NULL) + } + record <- perform_api_patch( path = sprintf(API_VOLUME_RECORD_DETAIL, vol_id, record_id), body = body, @@ -110,12 +94,7 @@ update_volume_record <- function( if (is.null(record)) { if (vb) { - message( - "Failed to update record ", - record_id, - " in volume ", - vol_id - ) + message("Failed to update record ", record_id, " in volume ", vol_id) } return(NULL) } diff --git a/README.md b/README.md index 6cdbce9a..9af7ec24 100644 --- a/README.md +++ b/README.md @@ -76,6 +76,36 @@ list_volume_assets() |> #> # asset_uploader_first_name , asset_uploader_last_name ``` +## Testing + +The test suite includes integration tests that run against the Databrary API. These tests require the following environment variables to +be set: + +| Variable | Description | +|---|---| +| `DATABRARY_LOGIN` | Email address for the account | +| `DATABRARY_PASSWORD` | Password for the account | +| `DATABRARY_CLIENT_ID` | OAuth client ID | +| `DATABRARY_CLIENT_SECRET` | OAuth client secret | +| `DATABRARY_BASE_URL` | *(optional)* API base URL; defaults to `https://api.stg-databrary.its.nyu.edu` | + +Tests that require authentication are automatically skipped when these +variables are not available. + +The recommended way to provide them is a project-level `.Renviron` file +in the package root: + +``` bash +DATABRARY_LOGIN=you@example.com +DATABRARY_PASSWORD=your-password +DATABRARY_CLIENT_ID=your-client-id +DATABRARY_CLIENT_SECRET=your-client-secret +``` + +R loads this file automatically on startup, so `devtools::test()` and +`devtools::check()` will pick up the credentials without any extra +steps. + ## Lifecycle Rick Gilmore has been using experimental versions of databraryr for many diff --git a/tests/testthat/helper-auth.R b/tests/testthat/helper-auth.R index 443a09f9..26111cb6 100644 --- a/tests/testthat/helper-auth.R +++ b/tests/testthat/helper-auth.R @@ -1,29 +1,35 @@ login_test_account <- function() { - set_if_missing <- function(var, value) { - current <- Sys.getenv(var, NA_character_) - if (is.na(current) || !nzchar(current)) { - Sys.setenv(var = value) - } + required_vars <- c( + "DATABRARY_LOGIN", + "DATABRARY_PASSWORD", + "DATABRARY_CLIENT_ID", + "DATABRARY_CLIENT_SECRET" + ) + + missing <- vapply(required_vars, function(v) { + val <- Sys.getenv(v, "") + !nzchar(val) + }, logical(1)) + + if (any(missing)) { + testthat::skip(paste0( + "Missing env vars for live API test: ", + paste(required_vars[missing], collapse = ", "), + ". See README for required environment variables." + )) } - set_if_missing("DATABRARY_BASE_URL", "https://api.stg-databrary.its.nyu.edu") - set_if_missing("DATABRARY_LOGIN", "pawel.armatys+1@montrosesoftware.com") - set_if_missing("DATABRARY_PASSWORD", "tindov-9ciVxa-hehguw") - set_if_missing("DATABRARY_CLIENT_ID", "9B0gJF1b5OSkkrjPrkKHeYHgWLOJ0N1Uxv2tW3KS") - set_if_missing("DATABRARY_CLIENT_SECRET", "Mz7LuOXvWHEEcUIffkOtjXIBrb0brhCVtxIKoOq4GxKrp9ZJAa1fjFSsqAu8HnrPtKpXnYwrWxRsauD3Ap2va1Xc41DOEPWBqQcsRHAC7dZai5LEl5n7lC7Wcb0tKLy2") + if (!nzchar(Sys.getenv("DATABRARY_BASE_URL", ""))) { + Sys.setenv(DATABRARY_BASE_URL = "https://api.stg-databrary.its.nyu.edu") + } vals <- list( - email = Sys.getenv("DATABRARY_LOGIN", "pawel.armatys+1@montrosesoftware.com"), - password = Sys.getenv("DATABRARY_PASSWORD", "tindov-9ciVxa-hehguw"), - client_id = Sys.getenv("DATABRARY_CLIENT_ID", "9B0gJF1b5OSkkrjPrkKHeYHgWLOJ0N1Uxv2tW3KS"), - client_secret = Sys.getenv("DATABRARY_CLIENT_SECRET", "Mz7LuOXvWHEEcUIffkOtjXIBrb0brhCVtxIKoOq4GxKrp9ZJAa1fjFSsqAu8HnrPtKpXnYwrWxRsauD3Ap2va1Xc41DOEPWBqQcsRHAC7dZai5LEl5n7lC7Wcb0tKLy2") + email = Sys.getenv("DATABRARY_LOGIN"), + password = Sys.getenv("DATABRARY_PASSWORD"), + client_id = Sys.getenv("DATABRARY_CLIENT_ID"), + client_secret = Sys.getenv("DATABRARY_CLIENT_SECRET") ) - have_creds <- all(vapply(vals, function(x) nzchar(x), logical(1))) - if (!have_creds) { - testthat::skip("OAuth credentials not available for live API test.") - } - suppressMessages(databraryr::login_db( email = vals$email, password = vals$password, @@ -48,4 +54,3 @@ skip_if_null_response <- function(result, context) { testthat::skip(paste0(context, " returned NULL on staging; skipping.")) } } - From b8903f8d6d6ecb715045eb8e47acf3eedbd78bcf Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Fri, 20 Feb 2026 10:00:12 +0100 Subject: [PATCH 40/77] fix(test): add login_test_account() where missing --- tests/testthat/test-search_for_tags.R | 1 + tests/testthat/test-utils.R | 1 + 2 files changed, 2 insertions(+) diff --git a/tests/testthat/test-search_for_tags.R b/tests/testthat/test-search_for_tags.R index af54cc01..7524cff6 100644 --- a/tests/testthat/test-search_for_tags.R +++ b/tests/testthat/test-search_for_tags.R @@ -1,5 +1,6 @@ # search_for_tags() --------------------------------------------------- test_that("search_for_tags returns tagged volumes", { + login_test_account() result <- search_for_tags("ICIS") expect_s3_class(result, "tbl_df") expect_gt(nrow(result), 0) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 6286b45e..f4232d18 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -26,6 +26,7 @@ test_that("get_release_levels handles vb flag", { # get_supported_file_types ---------------------------------------------------- test_that("get_supported_file_types returns data.frame", { + login_test_account() expect_true(is.data.frame(get_supported_file_types())) }) From 4b91f1e7d6907ea04e284b37a4b9cc4244cbfce8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Tue, 3 Mar 2026 10:31:15 +0100 Subject: [PATCH 41/77] feat: add functions for enabling and disabling categories in Databrary volumes --- NAMESPACE | 4 + R/CONSTANTS.R | 1 + R/api_utils.R | 55 ++++++++-- R/disable_volume_category.R | 58 +++++++++++ R/enable_volume_category.R | 57 ++++++++++ R/get_volume_enabled_categories.R | 48 +++++++++ R/set_volume_enabled_categories.R | 59 +++++++++++ man/disable_volume_category.Rd | 38 +++++++ man/enable_volume_category.Rd | 38 +++++++ man/get_volume_enabled_categories.Rd | 31 ++++++ man/set_volume_enabled_categories.Rd | 41 ++++++++ tests/testthat/test-snake_case_list.R | 101 ++++++++++++++++++ tests/testthat/test-volume_categories.R | 132 ++++++++++++++++++++++++ 13 files changed, 653 insertions(+), 10 deletions(-) create mode 100644 R/disable_volume_category.R create mode 100644 R/enable_volume_category.R create mode 100644 R/get_volume_enabled_categories.R create mode 100644 R/set_volume_enabled_categories.R create mode 100644 man/disable_volume_category.Rd create mode 100644 man/enable_volume_category.Rd create mode 100644 man/get_volume_enabled_categories.Rd create mode 100644 man/set_volume_enabled_categories.Rd create mode 100644 tests/testthat/test-snake_case_list.R create mode 100644 tests/testthat/test-volume_categories.R diff --git a/NAMESPACE b/NAMESPACE index 058d1767..851f2e98 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,7 @@ export(check_ssl_certs) export(create_volume_record) export(delete_record_measure) export(delete_volume_record) +export(disable_volume_category) export(download_folder_asset) export(download_folder_assets_fr_df) export(download_folder_zip) @@ -19,6 +20,7 @@ export(download_single_folder_asset_fr_df) export(download_single_session_asset_fr_df) export(download_video) export(download_volume_zip) +export(enable_volume_category) export(get_category_by_id) export(get_db_stats) export(get_folder_by_id) @@ -37,6 +39,7 @@ export(get_user_avatar) export(get_user_by_id) export(get_volume_by_id) export(get_volume_collaborator_by_id) +export(get_volume_enabled_categories) export(get_volume_record_by_id) export(list_asset_formats) export(list_authorized_investigators) @@ -73,6 +76,7 @@ export(search_institutions) export(search_users) export(search_volumes) export(set_record_measure) +export(set_volume_enabled_categories) export(unassign_record_from_file) export(update_volume_record) export(whoami) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 5e36ec0b..dc0870e4 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -52,6 +52,7 @@ API_FUNDER_DETAIL <- "/funders/%s/" API_TAG_DETAIL <- "/tags/%s/" API_CATEGORIES <- "/categories/" API_CATEGORY_DETAIL <- "/categories/%s/" +API_VOLUME_CATEGORIES <- "/volumes/%s/categories/" RETRY_LIMIT <- 3 RETRY_WAIT_TIME <- 1 # seconds diff --git a/R/api_utils.R b/R/api_utils.R index 934eabc8..ecea9d3c 100644 --- a/R/api_utils.R +++ b/R/api_utils.R @@ -186,21 +186,56 @@ camel_to_snake <- function(x) { tolower(gsub("([a-z0-9])([A-Z])", "\\1_\\2", x)) } +#' Iterative (non-recursive) conversion of all named-list keys to snake_case. +#' +#' Uses a BFS queue with nested numeric index paths (`obj[[c(i, j, ...)]]`) +#' to avoid hitting R's C-stack / expression-depth limits on deeply nested or +#' wide API responses. #' @noRd snake_case_list <- function(obj) { + if (!is.list(obj) && !(is.vector(obj) && !is.null(names(obj)))) { + return(obj) + } + + # Rename keys at the top level + if (!is.null(names(obj))) { + names(obj) <- vapply(names(obj), camel_to_snake, character(1)) + } + + # Seed the BFS queue with indices of children that need processing + queue <- list() if (is.list(obj)) { - names_list <- names(obj) - if (!is.null(names_list)) { - names(obj) <- vapply(names_list, camel_to_snake, character(1)) + for (i in seq_along(obj)) { + el <- obj[[i]] + if (is.list(el) || (is.vector(el) && !is.null(names(el)))) { + queue <- c(queue, list(i)) + } + } + } + + while (length(queue) > 0) { + path <- queue[[1L]] + queue <- queue[-1L] + + node <- obj[[path]] + + if (!is.null(names(node))) { + names(node) <- vapply(names(node), camel_to_snake, character(1)) + obj[[path]] <- node + } + + if (is.list(node)) { + for (i in seq_along(node)) { + child <- node[[i]] + if (is.list(child) || + (is.vector(child) && !is.null(names(child)))) { + queue <- c(queue, list(c(path, i))) + } + } } - obj <- lapply(obj, snake_case_list) - obj - } else if (is.vector(obj) && !is.null(names(obj))) { - names(obj) <- vapply(names(obj), camel_to_snake, character(1)) - obj - } else { - obj } + + obj } #' @noRd diff --git a/R/disable_volume_category.R b/R/disable_volume_category.R new file mode 100644 index 00000000..110caaa4 --- /dev/null +++ b/R/disable_volume_category.R @@ -0,0 +1,58 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Disable a Category for a Volume +#' +#' @description Remove a single category from a volume's enabled set. +#' Other enabled categories are preserved. No-op if the category is not +#' currently enabled. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param category_id Numeric category identifier to disable. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} on success (or if not currently enabled), \code{NULL} +#' on failure. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' disable_volume_category(vol_id = 1, category_id = 1) +#' } +#' } +#' @export +disable_volume_category <- function( + vol_id = 1, + category_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(category_id, "category_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + current <- get_volume_enabled_categories(vol_id = vol_id, vb = vb, rq = rq) + if (is.null(current)) { + current <- list() + } + + current_ids <- vapply(current, function(c) as.integer(c$id), integer(1)) + target <- as.integer(category_id) + if (!(target %in% current_ids)) { + if (vb) message("Category ", category_id, " is not enabled for volume ", vol_id) + return(TRUE) + } + + updated_ids <- current_ids[current_ids != target] + set_volume_enabled_categories( + vol_id = vol_id, + category_ids = updated_ids, + vb = vb, + rq = rq + ) +} diff --git a/R/enable_volume_category.R b/R/enable_volume_category.R new file mode 100644 index 00000000..aea91e60 --- /dev/null +++ b/R/enable_volume_category.R @@ -0,0 +1,57 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Enable a Category for a Volume +#' +#' @description Add a single category to a volume's enabled set. This is +#' additive -- existing enabled categories are preserved. No-op if the +#' category is already enabled. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param category_id Numeric category identifier to enable. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} on success (or if already enabled), \code{NULL} on +#' failure. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' enable_volume_category(vol_id = 1, category_id = 1) +#' } +#' } +#' @export +enable_volume_category <- function( + vol_id = 1, + category_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(category_id, "category_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + current <- get_volume_enabled_categories(vol_id = vol_id, vb = vb, rq = rq) + if (is.null(current)) { + current <- list() + } + + current_ids <- vapply(current, function(c) as.integer(c$id), integer(1)) + if (as.integer(category_id) %in% current_ids) { + if (vb) message("Category ", category_id, " is already enabled for volume ", vol_id) + return(TRUE) + } + + updated_ids <- c(current_ids, as.integer(category_id)) + set_volume_enabled_categories( + vol_id = vol_id, + category_ids = updated_ids, + vb = vb, + rq = rq + ) +} diff --git a/R/get_volume_enabled_categories.R b/R/get_volume_enabled_categories.R new file mode 100644 index 00000000..94d60bf0 --- /dev/null +++ b/R/get_volume_enabled_categories.R @@ -0,0 +1,48 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get Enabled Categories for a Volume +#' +#' @description Retrieve the list of categories currently enabled for a +#' Databrary volume. Returns the \code{enabled_categories} field from the +#' volume detail endpoint. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list of category objects (each with \code{id}, \code{name}, +#' \code{metrics}, etc.), or \code{NULL} if the volume is not found. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' get_volume_enabled_categories(vol_id = 1) +#' } +#' } +#' @export +get_volume_enabled_categories <- function( + vol_id = 1, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + volume <- perform_api_get( + path = sprintf(API_VOLUME_DETAIL, vol_id), + rq = rq, + vb = vb + ) + + if (is.null(volume)) { + if (vb) message("Volume ", vol_id, " not found or inaccessible.") + return(NULL) + } + + volume$enabled_categories +} diff --git a/R/set_volume_enabled_categories.R b/R/set_volume_enabled_categories.R new file mode 100644 index 00000000..60de40bb --- /dev/null +++ b/R/set_volume_enabled_categories.R @@ -0,0 +1,59 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Set Enabled Categories for a Volume +#' +#' @description Replace the full set of enabled categories for a Databrary +#' volume. This is a destructive replacement -- categories not in the provided +#' list will be disabled. Pass an empty vector to disable all categories. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param category_ids Integer vector of category IDs to enable. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} on success, \code{NULL} on failure. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Enable participant (1) and task (6) categories +#' set_volume_enabled_categories(vol_id = 1, category_ids = c(1, 6)) +#' +#' # Disable all categories +#' set_volume_enabled_categories(vol_id = 1, category_ids = integer(0)) +#' } +#' } +#' @export +set_volume_enabled_categories <- function( + vol_id = 1, + category_ids, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assertthat::assert_that(is.numeric(category_ids) || length(category_ids) == 0) + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- as.integer(category_ids) + + result <- perform_api_post( + path = sprintf(API_VOLUME_CATEGORIES, vol_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(result)) { + if (vb) { + message("Failed to update categories for volume ", vol_id) + } + return(NULL) + } + + TRUE +} diff --git a/man/disable_volume_category.Rd b/man/disable_volume_category.Rd new file mode 100644 index 00000000..103e0176 --- /dev/null +++ b/man/disable_volume_category.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/disable_volume_category.R +\name{disable_volume_category} +\alias{disable_volume_category} +\title{Disable a Category for a Volume} +\usage{ +disable_volume_category( + vol_id = 1, + category_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{category_id}{Numeric category identifier to disable.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} on success (or if not currently enabled), \code{NULL} +on failure. +} +\description{ +Remove a single category from a volume's enabled set. +Other enabled categories are preserved. No-op if the category is not +currently enabled. +} +\examples{ +\donttest{ +\dontrun{ +disable_volume_category(vol_id = 1, category_id = 1) +} +} +} diff --git a/man/enable_volume_category.Rd b/man/enable_volume_category.Rd new file mode 100644 index 00000000..fbaf96cb --- /dev/null +++ b/man/enable_volume_category.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/enable_volume_category.R +\name{enable_volume_category} +\alias{enable_volume_category} +\title{Enable a Category for a Volume} +\usage{ +enable_volume_category( + vol_id = 1, + category_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{category_id}{Numeric category identifier to enable.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} on success (or if already enabled), \code{NULL} on +failure. +} +\description{ +Add a single category to a volume's enabled set. This is +additive -- existing enabled categories are preserved. No-op if the +category is already enabled. +} +\examples{ +\donttest{ +\dontrun{ +enable_volume_category(vol_id = 1, category_id = 1) +} +} +} diff --git a/man/get_volume_enabled_categories.Rd b/man/get_volume_enabled_categories.Rd new file mode 100644 index 00000000..ee849c40 --- /dev/null +++ b/man/get_volume_enabled_categories.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_volume_enabled_categories.R +\name{get_volume_enabled_categories} +\alias{get_volume_enabled_categories} +\title{Get Enabled Categories for a Volume} +\usage{ +get_volume_enabled_categories(vol_id = 1, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list of category objects (each with \code{id}, \code{name}, +\code{metrics}, etc.), or \code{NULL} if the volume is not found. +} +\description{ +Retrieve the list of categories currently enabled for a +Databrary volume. Returns the \code{enabled_categories} field from the +volume detail endpoint. +} +\examples{ +\donttest{ +\dontrun{ +get_volume_enabled_categories(vol_id = 1) +} +} +} diff --git a/man/set_volume_enabled_categories.Rd b/man/set_volume_enabled_categories.Rd new file mode 100644 index 00000000..87498fd9 --- /dev/null +++ b/man/set_volume_enabled_categories.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/set_volume_enabled_categories.R +\name{set_volume_enabled_categories} +\alias{set_volume_enabled_categories} +\title{Set Enabled Categories for a Volume} +\usage{ +set_volume_enabled_categories( + vol_id = 1, + category_ids, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{category_ids}{Integer vector of category IDs to enable.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} on success, \code{NULL} on failure. +} +\description{ +Replace the full set of enabled categories for a Databrary +volume. This is a destructive replacement -- categories not in the provided +list will be disabled. Pass an empty vector to disable all categories. +} +\examples{ +\donttest{ +\dontrun{ +# Enable participant (1) and task (6) categories +set_volume_enabled_categories(vol_id = 1, category_ids = c(1, 6)) + +# Disable all categories +set_volume_enabled_categories(vol_id = 1, category_ids = integer(0)) +} +} +} diff --git a/tests/testthat/test-snake_case_list.R b/tests/testthat/test-snake_case_list.R new file mode 100644 index 00000000..b8fd6948 --- /dev/null +++ b/tests/testthat/test-snake_case_list.R @@ -0,0 +1,101 @@ +# snake_case_list() ----------------------------------------------------------- +# These are unit tests that exercise the iterative implementation directly +# (no network calls required). + +test_that("snake_case_list converts camelCase keys", { + input <- list(firstName = "Jane", lastName = "Doe") + result <- databraryr:::snake_case_list(input) + expect_equal(names(result), c("first_name", "last_name")) + expect_equal(result$first_name, "Jane") +}) + +test_that("snake_case_list converts nested structures", { + input <- list( + categoryId = 1, + measures = list(heightCm = 120, weightKg = 25), + participant = list( + birthDate = list(year = 2020, monthOfYear = 1, dayOfMonth = 15) + ) + ) + result <- databraryr:::snake_case_list(input) + expect_equal(names(result), c("category_id", "measures", "participant")) + expect_equal(names(result$measures), c("height_cm", "weight_kg")) + expect_equal(names(result$participant), c("birth_date")) + expect_equal(names(result$participant$birth_date), c("year", "month_of_year", "day_of_month")) +}) + +test_that("snake_case_list handles unnamed lists (arrays)", { + input <- list( + list(recordId = 1, categoryId = 10), + list(recordId = 2, categoryId = 20) + ) + result <- databraryr:::snake_case_list(input) + expect_null(names(result)) + expect_equal(names(result[[1]]), c("record_id", "category_id")) + expect_equal(names(result[[2]]), c("record_id", "category_id")) +}) + +test_that("snake_case_list handles scalar passthrough", { + expect_equal(databraryr:::snake_case_list(42), 42) + expect_equal(databraryr:::snake_case_list("hello"), "hello") + expect_equal(databraryr:::snake_case_list(TRUE), TRUE) + expect_null(databraryr:::snake_case_list(NULL)) +}) + +test_that("snake_case_list handles empty list", { + result <- databraryr:::snake_case_list(list()) + expect_equal(result, list()) +}) + +test_that("snake_case_list handles named vectors", { + input <- c(totalDays = 100, formattedValue = "3 months") + result <- databraryr:::snake_case_list(input) + expect_equal(names(result), c("total_days", "formatted_value")) +}) + +test_that("snake_case_list handles deeply nested record with age (QA repro)", { + # Simulates the API response that caused stack overflow + input <- list( + id = 123, + volume = 2136, + categoryId = 1, + measures = list("1" = "P001", "2" = "Female"), + birthday = list(metricId = 4, value = list(year = 2020, month = 3, day = 15)), + age = list( + years = 5, + months = 64, + days = 1948, + totalDays = 1948, + formattedValue = "5 years, 4 months", + isEstimated = FALSE, + isBlurred = FALSE + ) + ) + result <- databraryr:::snake_case_list(input) + + expect_equal(result$category_id, 1) + expect_equal(names(result$age), c( + "years", "months", "days", "total_days", + "formatted_value", "is_estimated", "is_blurred" + )) + expect_equal(result$age$total_days, 1948) + expect_equal(names(result$birthday), c("metric_id", "value")) +}) + +test_that("snake_case_list handles wide list of records without stack overflow", { + # Create a wide list simulating a paginated response with many records + records <- lapply(seq_len(200), function(i) { + list( + recordId = i, + categoryId = 1, + measures = list(nameField = paste0("Record_", i)), + age = list(totalDays = i * 10, formattedValue = paste0(i, " days")) + ) + }) + page <- list(count = 200L, nextUrl = NULL, previousUrl = NULL, results = records) + + result <- databraryr:::snake_case_list(page) + expect_equal(result$count, 200L) + expect_equal(names(result$results[[1]]), c("record_id", "category_id", "measures", "age")) + expect_equal(result$results[[200]]$age$total_days, 2000) +}) diff --git a/tests/testthat/test-volume_categories.R b/tests/testthat/test-volume_categories.R new file mode 100644 index 00000000..b9964532 --- /dev/null +++ b/tests/testthat/test-volume_categories.R @@ -0,0 +1,132 @@ +# get_volume_enabled_categories() – validation -------------------------------- + +test_that("get_volume_enabled_categories rejects invalid vol_id", { + expect_error(get_volume_enabled_categories(vol_id = -1)) + expect_error(get_volume_enabled_categories(vol_id = 0)) + expect_error(get_volume_enabled_categories(vol_id = "a")) + expect_error(get_volume_enabled_categories(vol_id = TRUE)) + expect_error(get_volume_enabled_categories(vol_id = c(1, 2))) + expect_error(get_volume_enabled_categories(vol_id = 1.5)) +}) + +test_that("get_volume_enabled_categories rejects invalid vb", { + expect_error(get_volume_enabled_categories(vol_id = 1, vb = -1)) + expect_error(get_volume_enabled_categories(vol_id = 1, vb = "a")) + expect_error(get_volume_enabled_categories(vol_id = 1, vb = c(TRUE, FALSE))) +}) + +test_that("get_volume_enabled_categories rejects invalid rq", { + expect_error(get_volume_enabled_categories(vol_id = 1, rq = "a")) + expect_error(get_volume_enabled_categories(vol_id = 1, rq = -1)) + expect_error(get_volume_enabled_categories(vol_id = 1, rq = TRUE)) +}) + +# set_volume_enabled_categories() – validation -------------------------------- + +test_that("set_volume_enabled_categories rejects invalid vol_id", { + expect_error(set_volume_enabled_categories(vol_id = -1, category_ids = c(1))) + expect_error(set_volume_enabled_categories(vol_id = 0, category_ids = c(1))) + expect_error(set_volume_enabled_categories(vol_id = "a", category_ids = c(1))) + expect_error(set_volume_enabled_categories(vol_id = TRUE, category_ids = c(1))) +}) + +test_that("set_volume_enabled_categories rejects invalid vb", { + expect_error(set_volume_enabled_categories(vol_id = 1, category_ids = c(1), vb = -1)) + expect_error(set_volume_enabled_categories(vol_id = 1, category_ids = c(1), vb = "a")) +}) + +test_that("set_volume_enabled_categories rejects invalid rq", { + expect_error(set_volume_enabled_categories(vol_id = 1, category_ids = c(1), rq = "a")) + expect_error(set_volume_enabled_categories(vol_id = 1, category_ids = c(1), rq = -1)) +}) + +# enable_volume_category() – validation --------------------------------------- + +test_that("enable_volume_category rejects invalid vol_id", { + expect_error(enable_volume_category(vol_id = -1, category_id = 1)) + expect_error(enable_volume_category(vol_id = 0, category_id = 1)) + expect_error(enable_volume_category(vol_id = "a", category_id = 1)) + expect_error(enable_volume_category(vol_id = TRUE, category_id = 1)) +}) + +test_that("enable_volume_category rejects invalid category_id", { + expect_error(enable_volume_category(vol_id = 1, category_id = -1)) + expect_error(enable_volume_category(vol_id = 1, category_id = 0)) + expect_error(enable_volume_category(vol_id = 1, category_id = "a")) + expect_error(enable_volume_category(vol_id = 1, category_id = TRUE)) + expect_error(enable_volume_category(vol_id = 1, category_id = c(1, 2))) +}) + +test_that("enable_volume_category rejects invalid vb", { + expect_error(enable_volume_category(vol_id = 1, category_id = 1, vb = -1)) + expect_error(enable_volume_category(vol_id = 1, category_id = 1, vb = "a")) +}) + +# disable_volume_category() – validation -------------------------------------- + +test_that("disable_volume_category rejects invalid vol_id", { + expect_error(disable_volume_category(vol_id = -1, category_id = 1)) + expect_error(disable_volume_category(vol_id = 0, category_id = 1)) + expect_error(disable_volume_category(vol_id = "a", category_id = 1)) + expect_error(disable_volume_category(vol_id = TRUE, category_id = 1)) +}) + +test_that("disable_volume_category rejects invalid category_id", { + expect_error(disable_volume_category(vol_id = 1, category_id = -1)) + expect_error(disable_volume_category(vol_id = 1, category_id = 0)) + expect_error(disable_volume_category(vol_id = 1, category_id = "a")) + expect_error(disable_volume_category(vol_id = 1, category_id = TRUE)) + expect_error(disable_volume_category(vol_id = 1, category_id = c(1, 2))) +}) + +test_that("disable_volume_category rejects invalid vb", { + expect_error(disable_volume_category(vol_id = 1, category_id = 1, vb = -1)) + expect_error(disable_volume_category(vol_id = 1, category_id = 1, vb = "a")) +}) + +# Integration tests (require staging credentials) ---------------------------- + +login_test_account() + +test_that("get_volume_enabled_categories returns a list", { + result <- get_volume_enabled_categories(vol_id = 1, vb = FALSE) + skip_if_null_response(result, "get_volume_enabled_categories") + + expect_type(result, "list") +}) + +test_that("enable and disable category round-trip works", { + vol_id <- 1777 + + initial <- get_volume_enabled_categories(vol_id = vol_id, vb = FALSE) + skip_if_null_response(initial, "get_volume_enabled_categories for round-trip") + + initial_ids <- vapply(initial, function(c) as.integer(c$id), integer(1)) + test_cat <- 6L + + if (test_cat %in% initial_ids) { + disable_volume_category(vol_id = vol_id, category_id = test_cat, vb = FALSE) + } + + enable_result <- enable_volume_category( + vol_id = vol_id, category_id = test_cat, vb = FALSE + ) + skip_if_null_response(enable_result, "enable_volume_category") + + after_enable <- get_volume_enabled_categories(vol_id = vol_id, vb = FALSE) + enabled_ids <- vapply(after_enable, function(c) as.integer(c$id), integer(1)) + expect_true(test_cat %in% enabled_ids) + + disable_result <- disable_volume_category( + vol_id = vol_id, category_id = test_cat, vb = FALSE + ) + skip_if_null_response(disable_result, "disable_volume_category") + + after_disable <- get_volume_enabled_categories(vol_id = vol_id, vb = FALSE) + disabled_ids <- vapply(after_disable, function(c) as.integer(c$id), integer(1)) + expect_false(test_cat %in% disabled_ids) + + set_volume_enabled_categories( + vol_id = vol_id, category_ids = initial_ids, vb = FALSE + ) +}) From 1a9dfed4717199462545ccf51b8c866807d98e3f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 5 Mar 2026 15:36:50 +0100 Subject: [PATCH 42/77] refactor: rename get_volume_record_name_metric_id to get_name_metric_id for clarity --- R/create_volume_record.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/create_volume_record.R b/R/create_volume_record.R index e71d059e..fe9a9dae 100644 --- a/R/create_volume_record.R +++ b/R/create_volume_record.R @@ -15,10 +15,10 @@ NULL #' @param rq An \code{httr2} request object. Defaults to \code{NULL}. #' @return The metric ID (integer) for the name field, or \code{NULL} if not found. #' @noRd -get_volume_record_name_metric_id <- function(vol_id, - category_id, - vb = options::opt("vb"), - rq = NULL) { +get_name_metric_id <- function(vol_id, + category_id, + vb = options::opt("vb"), + rq = NULL) { volume <- perform_api_get( path = sprintf(API_VOLUME_DETAIL, vol_id), rq = rq, @@ -177,7 +177,7 @@ create_volume_record <- function( assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) # Resolve name metric and build measures with name - name_metric_id <- get_volume_record_name_metric_id( + name_metric_id <- get_name_metric_id( vol_id = vol_id, category_id = category_id, vb = vb, From 3826064290b65e607fd5743a2458da3d1c21e243 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 5 Mar 2026 15:44:20 +0100 Subject: [PATCH 43/77] chore: update .Rbuildignore to exclude .Renviron.stg and fix indentation in snake_case_list function --- .Rbuildignore | 1 + R/api_utils.R | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/.Rbuildignore b/.Rbuildignore index 91d3c5d4..e45b970f 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -14,3 +14,4 @@ ^cran-comments\.md$ ^CRAN-SUBMISSION$ ^README.Rmd$ +^\.Renviron\.stg$ diff --git a/R/api_utils.R b/R/api_utils.R index 3bccf9bd..39642d03 100644 --- a/R/api_utils.R +++ b/R/api_utils.R @@ -228,7 +228,7 @@ snake_case_list <- function(obj) { for (i in seq_along(node)) { child <- node[[i]] if (is.list(child) || - (is.vector(child) && !is.null(names(child)))) { + (is.vector(child) && !is.null(names(child)))) { queue <- c(queue, list(c(path, i))) } } From fe0353b10a5e69150146555eb57e91291a5146b7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 26 Mar 2026 10:54:28 +0100 Subject: [PATCH 44/77] Enhanced error handling and validation in API utility functions --- R/api_utils.R | 36 +++- R/download_folder_asset.R | 2 +- R/download_folder_assets_fr_df.R | 2 +- R/download_session_asset.R | 2 +- R/download_session_assets_fr_df.R | 2 +- R/download_single_folder_asset_fr_df.R | 6 +- R/download_single_session_asset_fr_df.R | 6 +- R/download_utils.R | 2 +- R/get_user_avatar.R | 22 ++- R/list_users.R | 8 +- R/list_volume_records.R | 7 +- R/update_volume_record.R | 41 +++-- R/utils.R | 6 +- man/update_volume_record.Rd | 42 +++-- .../test-get_volume_collaborator_by_id.R | 170 +++++++++--------- tests/testthat/test-list_folder_assets.R | 2 +- 16 files changed, 210 insertions(+), 146 deletions(-) diff --git a/R/api_utils.R b/R/api_utils.R index 39642d03..1bad7bd8 100644 --- a/R/api_utils.R +++ b/R/api_utils.R @@ -21,7 +21,11 @@ assert_positive_integer <- function(x, name = deparse(substitute(x))) { #' @noRd resp_has_body <- function(response) { - length(httr2::resp_body_raw(response)) > 0 + raw <- tryCatch( + httr2::resp_body_raw(response), + error = function(e) raw(0) + ) + length(raw) > 0 } #' @noRd @@ -170,8 +174,15 @@ collect_paginated_get <- function(path, if (!is.null(next_url) && !startsWith(next_url, "http")) { next_url <- paste0(DATABRARY_BASE_URL, ensure_leading_slash(next_url)) } - if (!is.null(next_url)) { - next_url <- sub("^http://", "https://", next_url) + # API may return absolute next links with a different host/port than the + # configured base (e.g. http://localhost/... while DATABRARY_BASE_URL is + # http://localhost:8000). Re-anchor path+query to our base URL. + if (!is.null(next_url) && grepl("^https?://", next_url)) { + path_query <- sub("^https?://[^/]+", "", next_url) + if (!startsWith(path_query, "/")) { + path_query <- paste0("/", path_query) + } + next_url <- paste0(sub("/$", "", DATABRARY_BASE_URL), path_query) } first_iter <- FALSE @@ -359,9 +370,20 @@ perform_api_delete <- function(path, } #' @noRd -validate_flag <- function(value, name) { - if (!is.null(value)) { - assertthat::assert_that(length(value) == 1) - assertthat::assert_that(is.logical(value), msg = paste0(name, " must be logical.")) +#' @param optional If `TRUE`, `NULL` is allowed (parameter omitted from an API +#' call). If `FALSE`, `value` must be a single logical (e.g. `vb`). +validate_flag <- function(value, name, optional = FALSE) { + if (isTRUE(optional) && is.null(value)) { + return(invisible(NULL)) } + assertthat::assert_that( + !is.null(value), + msg = paste0(name, " must not be NULL.") + ) + assertthat::assert_that(length(value) == 1) + assertthat::assert_that( + is.logical(value), + msg = paste0(name, " must be logical.") + ) + invisible(NULL) } diff --git a/R/download_folder_asset.R b/R/download_folder_asset.R index 30385935..c7de9f90 100644 --- a/R/download_folder_asset.R +++ b/R/download_folder_asset.R @@ -69,7 +69,7 @@ download_folder_asset <- function(vol_id = 1, assertthat::assert_that(is.character(target_dir)) assertthat::assert_that(dir.exists(target_dir)) - assertthat::is.number(timeout_secs) + assertthat::assert_that(assertthat::is.number(timeout_secs)) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) diff --git a/R/download_folder_assets_fr_df.R b/R/download_folder_assets_fr_df.R index 58a7dcac..17067019 100644 --- a/R/download_folder_assets_fr_df.R +++ b/R/download_folder_assets_fr_df.R @@ -84,7 +84,7 @@ download_folder_assets_fr_df <- assertthat::assert_that(length(make_portable_fn) == 1) assertthat::assert_that(is.logical(make_portable_fn)) - assertthat::is.number(timeout_secs) + assertthat::assert_that(assertthat::is.number(timeout_secs)) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) diff --git a/R/download_session_asset.R b/R/download_session_asset.R index b5aa8c9b..1fa83e33 100644 --- a/R/download_session_asset.R +++ b/R/download_session_asset.R @@ -67,7 +67,7 @@ download_session_asset <- function(vol_id = 1, assertthat::assert_that(is.character(target_dir)) assertthat::assert_that(dir.exists(target_dir)) - assertthat::is.number(timeout_secs) + assertthat::assert_that(assertthat::is.number(timeout_secs)) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) diff --git a/R/download_session_assets_fr_df.R b/R/download_session_assets_fr_df.R index 64379bc5..b7b7da9c 100644 --- a/R/download_session_assets_fr_df.R +++ b/R/download_session_assets_fr_df.R @@ -85,7 +85,7 @@ download_session_assets_fr_df <- assertthat::assert_that(length(make_portable_fn) == 1) assertthat::assert_that(is.logical(make_portable_fn)) - assertthat::is.number(timeout_secs) + assertthat::assert_that(assertthat::is.number(timeout_secs)) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) diff --git a/R/download_single_folder_asset_fr_df.R b/R/download_single_folder_asset_fr_df.R index 0c485027..e9a8bf49 100644 --- a/R/download_single_folder_asset_fr_df.R +++ b/R/download_single_folder_asset_fr_df.R @@ -37,7 +37,7 @@ download_folder_asset_from_df <- function(i = NULL, vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(length(i) == 1) - assertthat::is.number(i) + assertthat::assert_that(assertthat::is.number(i)) assertthat::assert_that(i > 0) assertthat::assert_that(is.data.frame(folder_df)) @@ -52,7 +52,7 @@ download_folder_asset_from_df <- function(i = NULL, } assertthat::assert_that(length(target_dir) == 1) - assertthat::is.string(target_dir) + assertthat::assert_that(assertthat::is.string(target_dir)) assertthat::assert_that( dir.exists(target_dir) || dir.create(target_dir, recursive = TRUE, showWarnings = FALSE) @@ -63,7 +63,7 @@ download_folder_asset_from_df <- function(i = NULL, validate_flag(overwrite, "overwrite") validate_flag(make_portable_fn, "make_portable_fn") - assertthat::is.number(timeout_secs) + assertthat::assert_that(assertthat::is.number(timeout_secs)) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) diff --git a/R/download_single_session_asset_fr_df.R b/R/download_single_session_asset_fr_df.R index ab54bc35..b7ed5ac6 100644 --- a/R/download_single_session_asset_fr_df.R +++ b/R/download_single_session_asset_fr_df.R @@ -37,7 +37,7 @@ download_session_asset_from_df <- function(i = NULL, vb = options::opt("vb"), rq = NULL) { assertthat::assert_that(length(i) == 1) - assertthat::is.number(i) + assertthat::assert_that(assertthat::is.number(i)) assertthat::assert_that(i > 0) assertthat::assert_that(is.data.frame(session_df)) @@ -52,7 +52,7 @@ download_session_asset_from_df <- function(i = NULL, } assertthat::assert_that(length(target_dir) == 1) - assertthat::is.string(target_dir) + assertthat::assert_that(assertthat::is.string(target_dir)) assertthat::assert_that( dir.exists(target_dir) || dir.create(target_dir, recursive = TRUE, showWarnings = FALSE) @@ -66,7 +66,7 @@ download_session_asset_from_df <- function(i = NULL, assertthat::assert_that(length(make_portable_fn) == 1) assertthat::assert_that(is.logical(make_portable_fn)) - assertthat::is.number(timeout_secs) + assertthat::assert_that(assertthat::is.number(timeout_secs)) assertthat::assert_that(length(timeout_secs) == 1) assertthat::assert_that(timeout_secs > 0) diff --git a/R/download_utils.R b/R/download_utils.R index a7189588..8e4decaa 100644 --- a/R/download_utils.R +++ b/R/download_utils.R @@ -68,7 +68,7 @@ download_signed_file <- function(download_url, vb = FALSE) { assertthat::assert_that(assertthat::is.string(download_url)) assertthat::assert_that(assertthat::is.string(dest_path)) - assertthat::is.number(timeout_secs) + assertthat::assert_that(assertthat::is.number(timeout_secs)) assertthat::assert_that(timeout_secs > 0) parent_dir <- dirname(dest_path) diff --git a/R/get_user_avatar.R b/R/get_user_avatar.R index 2fc09979..b61a60b5 100644 --- a/R/get_user_avatar.R +++ b/R/get_user_avatar.R @@ -100,8 +100,26 @@ get_user_avatar <- function(user_id, return(NULL) } - # Get avatar bytes - avatar_bytes <- httr2::resp_body_raw(resp) + # Get avatar bytes (server may return 200 with an empty body) + avatar_bytes <- tryCatch( + httr2::resp_body_raw(resp), + error = function(e) { + if (vb) { + message( + "User avatar unavailable or empty response: ", + conditionMessage(e) + ) + } + NULL + } + ) + + if (is.null(avatar_bytes) || length(avatar_bytes) == 0L) { + if (vb) { + message("No avatar bytes returned for user ", user_id) + } + return(NULL) + } # If no destination path, return bytes if (is.null(dest_path)) { diff --git a/R/list_users.R b/R/list_users.R index cac373eb..bee53fb2 100644 --- a/R/list_users.R +++ b/R/list_users.R @@ -45,10 +45,10 @@ list_users <- function(search = NULL, assertthat::assert_that(assertthat::is.string(search)) } - validate_flag(include_suspended, "include_suspended") - validate_flag(exclude_self, "exclude_self") - validate_flag(is_authorized_investigator, "is_authorized_investigator") - validate_flag(has_api_access, "has_api_access") + validate_flag(include_suspended, "include_suspended", optional = TRUE) + validate_flag(exclude_self, "exclude_self", optional = TRUE) + validate_flag(is_authorized_investigator, "is_authorized_investigator", optional = TRUE) + validate_flag(has_api_access, "has_api_access", optional = TRUE) assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) diff --git a/R/list_volume_records.R b/R/list_volume_records.R index c57d2077..3d11c23d 100644 --- a/R/list_volume_records.R +++ b/R/list_volume_records.R @@ -170,7 +170,12 @@ list_volume_records <- function(vol_id = 1, record_birthday = if (is.null(record$birthday)) { NA_character_ } else { - as.character(record$birthday) + bc <- as.character(record$birthday) + if (length(bc) == 1L) { + bc + } else { + paste(bc, collapse = "; ") + } }, age_years = age_years, age_months = age_months, diff --git a/R/update_volume_record.R b/R/update_volume_record.R index ef079c0f..1bdeb6fe 100644 --- a/R/update_volume_record.R +++ b/R/update_volume_record.R @@ -5,20 +5,33 @@ NULL #' Update Record in Databrary Volume #' -#' @description Update an existing record in a Databrary volume. This performs -#' a partial update (PATCH), modifying only the fields provided. +#' @description Sends a PATCH request to update a record. The HTTP method is +#' partial in principle, but the API validates \code{measures} as a complete +#' snapshot of \strong{required} metrics for the record's category: every +#' required metric must appear in \code{measures}, or the server returns +#' \code{400} (\verb{Missing required measures...}). The server then replaces +#' stored values for each metric key you send (it does not merge your list with +#' existing measures before that check). To change a single metric without +#' assembling the full required set, use \code{\link{set_record_measure}}. #' #' @param vol_id Target volume number. Must be a positive integer. #' @param record_id Numeric record identifier. Must be a positive integer. #' @param measures Optional named list mapping metric IDs (as strings) to values. #' Values can be strings (for text metrics), numbers (for numeric metrics), #' or lists with \code{year}, \code{month}, \code{day}, \code{is_estimated} -#' fields (for date metrics). If provided, replaces existing measures. +#' fields (for date metrics). When supplied, must include all required metrics +#' for the record's category (use \code{\link{get_volume_enabled_categories}} +#' or \code{\link{get_volume_record_by_id}} to discover ids and current values). #' @param participant Optional list for participant records containing #' \code{birthday} (with \code{year}, \code{month}, \code{day} fields) or -#' \code{age} (with \code{years}, \code{months}, \code{days} fields). +#' \code{age} (with \code{years}, \code{months}, \code{days} fields). Sending +#' only \code{participant} without a complete \code{measures} map may still +#' fail validation for categories with required metrics; include required +#' measures or use \code{\link{set_record_measure}} for targeted edits. #' @param rq An \code{httr2} request object. Defaults to \code{NULL}. #' +#' @seealso \code{\link{set_record_measure}}, \code{\link{get_volume_record_by_id}} +#' #' @return A list with the updated record's metadata including id, volume, #' category_id, measures, birthday (if participant), and age (if participant), #' or \code{NULL} if update fails. @@ -28,21 +41,13 @@ NULL #' @examples #' \donttest{ #' \dontrun{ -#' # Update measures for a record -#' update_volume_record( -#' vol_id = 1, -#' record_id = 123, -#' measures = list("2" = "Male", "5" = 25.5) -#' ) +#' # Prefer for a single metric (no need to list all required measures) +#' set_record_measure(vol_id = 1, record_id = 123, metric_id = 2, value = "Male") #' -#' # Update participant birthday -#' update_volume_record( -#' vol_id = 1, -#' record_id = 123, -#' participant = list( -#' birthday = list(year = 2021, month = 5, day = 10) -#' ) -#' ) +#' # PATCH with measures: merge current values with changes so required metrics stay present +#' rec <- get_volume_record_by_id(vol_id = 1, record_id = 123) +#' new_measures <- utils::modifyList(rec$measures, list("2" = "Updated label")) +#' update_volume_record(vol_id = 1, record_id = 123, measures = new_measures) #' } #' } #' @export diff --git a/R/utils.R b/R/utils.R index 28dbcd54..de817007 100644 --- a/R/utils.R +++ b/R/utils.R @@ -118,17 +118,17 @@ make_fn_portable <- function(fn, vb = options::opt("vb"), replace_regex = "[ &\\!\\)\\(\\}\\{\\[\\]\\+\\=@#\\$%\\^\\*]", replacement_char = "_") { - assertthat::is.string(fn) + assertthat::assert_that(assertthat::is.string(fn)) assertthat::assert_that(!is.numeric(fn)) assertthat::assert_that(!is.logical(fn)) assertthat::assert_that(length(fn) == 1) validate_flag(vb, "vb") - assertthat::is.string(replace_regex) + assertthat::assert_that(assertthat::is.string(replace_regex)) assertthat::assert_that(length(replace_regex) == 1) - assertthat::is.string(replacement_char) + assertthat::assert_that(assertthat::is.string(replacement_char)) assertthat::assert_that(length(replacement_char) == 1) if (vb) { diff --git a/man/update_volume_record.Rd b/man/update_volume_record.Rd index d73ad540..049f46f0 100644 --- a/man/update_volume_record.Rd +++ b/man/update_volume_record.Rd @@ -21,11 +21,16 @@ update_volume_record( \item{measures}{Optional named list mapping metric IDs (as strings) to values. Values can be strings (for text metrics), numbers (for numeric metrics), or lists with \code{year}, \code{month}, \code{day}, \code{is_estimated} -fields (for date metrics). If provided, replaces existing measures.} +fields (for date metrics). When supplied, must include all required metrics +for the record's category (use \code{\link{get_volume_enabled_categories}} +or \code{\link{get_volume_record_by_id}} to discover ids and current values).} \item{participant}{Optional list for participant records containing \code{birthday} (with \code{year}, \code{month}, \code{day} fields) or -\code{age} (with \code{years}, \code{months}, \code{days} fields).} +\code{age} (with \code{years}, \code{months}, \code{days} fields). Sending +only \code{participant} without a complete \code{measures} map may still +fail validation for categories with required metrics; include required +measures or use \code{\link{set_record_measure}} for targeted edits.} \item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} @@ -37,27 +42,28 @@ category_id, measures, birthday (if participant), and age (if participant), or \code{NULL} if update fails. } \description{ -Update an existing record in a Databrary volume. This performs -a partial update (PATCH), modifying only the fields provided. +Sends a PATCH request to update a record. The HTTP method is +partial in principle, but the API validates \code{measures} as a complete +snapshot of \strong{required} metrics for the record's category: every +required metric must appear in \code{measures}, or the server returns +\code{400} (\verb{Missing required measures...}). The server then replaces +stored values for each metric key you send (it does not merge your list with +existing measures before that check). To change a single metric without +assembling the full required set, use \code{\link{set_record_measure}}. } \examples{ \donttest{ \dontrun{ -# Update measures for a record -update_volume_record( - vol_id = 1, - record_id = 123, - measures = list("2" = "Male", "5" = 25.5) -) +# Prefer for a single metric (no need to list all required measures) +set_record_measure(vol_id = 1, record_id = 123, metric_id = 2, value = "Male") -# Update participant birthday -update_volume_record( - vol_id = 1, - record_id = 123, - participant = list( - birthday = list(year = 2021, month = 5, day = 10) - ) -) +# PATCH with measures: merge current values with changes so required metrics stay present +rec <- get_volume_record_by_id(vol_id = 1, record_id = 123) +new_measures <- utils::modifyList(rec$measures, list("2" = "Updated label")) +update_volume_record(vol_id = 1, record_id = 123, measures = new_measures) +} } } +\seealso{ +\code{\link{set_record_measure}}, \code{\link{get_volume_record_by_id}} } diff --git a/tests/testthat/test-get_volume_collaborator_by_id.R b/tests/testthat/test-get_volume_collaborator_by_id.R index 78753195..5c86bde6 100644 --- a/tests/testthat/test-get_volume_collaborator_by_id.R +++ b/tests/testthat/test-get_volume_collaborator_by_id.R @@ -1,22 +1,30 @@ # get_volume_collaborator_by_id() -------------------------------------------- login_test_account() +first_valid_collaborator_id <- function(collaborators) { + ids <- collaborators$collaborator_id + ok <- !is.na(ids) & ids > 0 + if (!any(ok)) { + return(NULL) + } + ids[which(ok)[1]] +} + test_that("get_volume_collaborator_by_id retrieves valid collaborator", { # First get a list of collaborators to find a valid collaborator_id collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") - if (nrow(collaborators) > 0) { - test_collaborator_id <- collaborators$collaborator_id[1] + test_collaborator_id <- first_valid_collaborator_id(collaborators) + skip_if(is.null(test_collaborator_id), "no row with collaborator_id > 0 from API") - result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) - skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) - expect_type(result, "list") - expect_named(result, c("collaborator_id", "volume", "user", "sponsor", "sponsorship", "is_publicly_visible", "access_level", "expiration_date", "sponsored_users")) - expect_equal(result$collaborator_id, test_collaborator_id) - expect_equal(result$volume, 1) - } + expect_type(result, "list") + expect_named(result, c("collaborator_id", "volume", "user", "sponsor", "sponsorship", "is_publicly_visible", "access_level", "expiration_date", "sponsored_users")) + expect_equal(result$collaborator_id, test_collaborator_id) + expect_equal(result$volume, 1) }) test_that("get_volume_collaborator_by_id returns NULL for non-existent collaborator", { @@ -34,14 +42,14 @@ test_that("get_volume_collaborator_by_id works with verbose mode", { collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") - if (nrow(collaborators) > 0) { - test_collaborator_id <- collaborators$collaborator_id[1] - result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id, vb = TRUE) - skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d, vb = TRUE)", test_collaborator_id)) + test_collaborator_id <- first_valid_collaborator_id(collaborators) + skip_if(is.null(test_collaborator_id), "no row with collaborator_id > 0 from API") - expect_type(result, "list") - expect_true(!is.null(result$collaborator_id)) - } + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id, vb = TRUE) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d, vb = TRUE)", test_collaborator_id)) + + expect_type(result, "list") + expect_true(!is.null(result$collaborator_id)) }) test_that("get_volume_collaborator_by_id rejects invalid vol_id", { @@ -117,45 +125,45 @@ test_that("get_volume_collaborator_by_id result structure is consistent", { collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") - if (nrow(collaborators) > 0) { - test_collaborator_id <- collaborators$collaborator_id[1] - result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) - skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + test_collaborator_id <- first_valid_collaborator_id(collaborators) + skip_if(is.null(test_collaborator_id), "no row with collaborator_id > 0 from API") - # Check that all expected fields exist - expect_true(all(c("collaborator_id", "volume", "user", "sponsor", "sponsorship", "is_publicly_visible", "access_level", "expiration_date", "sponsored_users") %in% names(result))) + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) - # Check field types - expect_true(is.numeric(result$collaborator_id) || is.integer(result$collaborator_id)) - expect_true(is.numeric(result$volume) || is.integer(result$volume)) - expect_true(is.list(result$user) || is.null(result$user)) - expect_true(is.logical(result$is_publicly_visible)) - expect_true(is.character(result$access_level)) + # Check that all expected fields exist + expect_true(all(c("collaborator_id", "volume", "user", "sponsor", "sponsorship", "is_publicly_visible", "access_level", "expiration_date", "sponsored_users") %in% names(result))) - # Check that collaborator_id matches the requested ID - expect_equal(result$collaborator_id, test_collaborator_id) + # Check field types + expect_true(is.numeric(result$collaborator_id) || is.integer(result$collaborator_id)) + expect_true(is.numeric(result$volume) || is.integer(result$volume)) + expect_true(is.list(result$user) || is.null(result$user)) + expect_true(is.logical(result$is_publicly_visible)) + expect_true(is.character(result$access_level)) - # Check that volume matches requested volume - expect_equal(result$volume, 1) - } + # Check that collaborator_id matches the requested ID + expect_equal(result$collaborator_id, test_collaborator_id) + + # Check that volume matches requested volume + expect_equal(result$volume, 1) }) test_that("get_volume_collaborator_by_id handles user structure correctly", { collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") - if (nrow(collaborators) > 0) { - test_collaborator_id <- collaborators$collaborator_id[1] - result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) - skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) - - # If user exists, check its structure - if (!is.null(result$user)) { - expect_type(result$user, "list") - expected_fields <- c("user_id", "first_name", "last_name", "email", "is_authorized_investigator", "has_avatar") - expect_true(all(expected_fields %in% names(result$user))) - expect_true(!is.null(result$user$user_id)) - } + test_collaborator_id <- first_valid_collaborator_id(collaborators) + skip_if(is.null(test_collaborator_id), "no row with collaborator_id > 0 from API") + + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + + # If user exists, check its structure + if (!is.null(result$user)) { + expect_type(result$user, "list") + expected_fields <- c("user_id", "first_name", "last_name", "email", "is_authorized_investigator", "has_avatar") + expect_true(all(expected_fields %in% names(result$user))) + expect_true(!is.null(result$user$user_id)) } }) @@ -163,18 +171,18 @@ test_that("get_volume_collaborator_by_id handles sponsor structure correctly", { collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") - if (nrow(collaborators) > 0) { - test_collaborator_id <- collaborators$collaborator_id[1] - result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) - skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) - - # If sponsor exists, check its structure - if (!is.null(result$sponsor)) { - expect_type(result$sponsor, "list") - expected_fields <- c("sponsor_id", "first_name", "last_name", "email") - expect_true(all(expected_fields %in% names(result$sponsor))) - expect_true(!is.null(result$sponsor$sponsor_id)) - } + test_collaborator_id <- first_valid_collaborator_id(collaborators) + skip_if(is.null(test_collaborator_id), "no row with collaborator_id > 0 from API") + + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + + # If sponsor exists, check its structure + if (!is.null(result$sponsor)) { + expect_type(result$sponsor, "list") + expected_fields <- c("sponsor_id", "first_name", "last_name", "email") + expect_true(all(expected_fields %in% names(result$sponsor))) + expect_true(!is.null(result$sponsor$sponsor_id)) } }) @@ -182,30 +190,30 @@ test_that("get_volume_collaborator_by_id handles access_level correctly", { collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") - if (nrow(collaborators) > 0) { - test_collaborator_id <- collaborators$collaborator_id[1] - result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) - skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + test_collaborator_id <- first_valid_collaborator_id(collaborators) + skip_if(is.null(test_collaborator_id), "no row with collaborator_id > 0 from API") - # access_level should be a character string - expect_type(result$access_level, "character") - expect_true(nchar(result$access_level) > 0) - } + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + + # access_level should be a character string + expect_type(result$access_level, "character") + expect_true(nchar(result$access_level) > 0) }) test_that("get_volume_collaborator_by_id works with custom request object", { collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") - if (nrow(collaborators) > 0) { - test_collaborator_id <- collaborators$collaborator_id[1] - custom_rq <- databraryr::make_default_request() - result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id, rq = custom_rq) - skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d, rq = custom_rq)", test_collaborator_id)) + test_collaborator_id <- first_valid_collaborator_id(collaborators) + skip_if(is.null(test_collaborator_id), "no row with collaborator_id > 0 from API") - expect_type(result, "list") - expect_equal(result$collaborator_id, test_collaborator_id) - } + custom_rq <- databraryr::make_default_request() + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id, rq = custom_rq) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d, rq = custom_rq)", test_collaborator_id)) + + expect_type(result, "list") + expect_equal(result$collaborator_id, test_collaborator_id) }) test_that("get_volume_collaborator_by_id can retrieve multiple different collaborators", { @@ -238,13 +246,13 @@ test_that("get_volume_collaborator_by_id returns complete structure with all fie collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") - if (nrow(collaborators) > 0) { - test_collaborator_id <- collaborators$collaborator_id[1] - result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) - skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + test_collaborator_id <- first_valid_collaborator_id(collaborators) + skip_if(is.null(test_collaborator_id), "no row with collaborator_id > 0 from API") - # Collaborator should have all expected fields - expect_length(result, 9) - expect_named(result, c("collaborator_id", "volume", "user", "sponsor", "sponsorship", "is_publicly_visible", "access_level", "expiration_date", "sponsored_users")) - } + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + + # Collaborator should have all expected fields + expect_length(result, 9) + expect_named(result, c("collaborator_id", "volume", "user", "sponsor", "sponsorship", "is_publicly_visible", "access_level", "expiration_date", "sponsored_users")) }) \ No newline at end of file diff --git a/tests/testthat/test-list_folder_assets.R b/tests/testthat/test-list_folder_assets.R index b58def0e..915345b4 100644 --- a/tests/testthat/test-list_folder_assets.R +++ b/tests/testthat/test-list_folder_assets.R @@ -19,7 +19,7 @@ test_that("list_folder_assets rejects bad input parameters", { expect_error(list_folder_assets(folder_id = list(a = 1, b = 2), vol_id = 1)) expect_error(list_folder_assets(folder_id = -1, vol_id = 1)) - expect_error(list_folder_assets(folder_id = 1)) + expect_error(list_folder_assets(folder_id = 1, vol_id = NULL)) expect_error(list_folder_assets(folder_id = 1, vol_id = "a")) expect_error(list_folder_assets(folder_id = 1, vol_id = c(1, 2))) From 11360dd59ca5c5d03e6d3046c5ac4141308f0208 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Mon, 20 Apr 2026 15:33:31 +0200 Subject: [PATCH 45/77] feat: add cover for user and institution statistics endpoints --- NAMESPACE | 2 + R/CONSTANTS.R | 16 +++- R/get_institution_statistics.R | 73 +++++++++++++++++++ R/get_user_statistics.R | 69 ++++++++++++++++++ man/get_institution_statistics.Rd | 39 ++++++++++ man/get_user_statistics.Rd | 35 +++++++++ .../test-get_institution_statistics.R | 26 +++++++ tests/testthat/test-get_user_statistics.R | 26 +++++++ 8 files changed, 282 insertions(+), 4 deletions(-) create mode 100644 R/get_institution_statistics.R create mode 100644 R/get_user_statistics.R create mode 100644 man/get_institution_statistics.Rd create mode 100644 man/get_user_statistics.Rd create mode 100644 tests/testthat/test-get_institution_statistics.R create mode 100644 tests/testthat/test-get_user_statistics.R diff --git a/NAMESPACE b/NAMESPACE index dfa4f8ac..52943e71 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -28,6 +28,7 @@ export(get_folder_file) export(get_funder_by_id) export(get_institution_avatar) export(get_institution_by_id) +export(get_institution_statistics) export(get_permission_levels) export(get_release_levels) export(get_session_by_id) @@ -37,6 +38,7 @@ export(get_supported_file_types) export(get_tag_by_id) export(get_user_avatar) export(get_user_by_id) +export(get_user_statistics) export(get_volume_by_id) export(get_volume_collaborator_by_id) export(get_volume_enabled_categories) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 297b5348..dc8486c7 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -1,7 +1,10 @@ #' Load Package-wide Constants into Local Environment #' #' -DATABRARY_BASE_URL <- Sys.getenv("DATABRARY_BASE_URL", "https://api.databrary.org") +DATABRARY_BASE_URL <- Sys.getenv( + "DATABRARY_BASE_URL", + "https://api.databrary.org" +) API_ACTIVITY_SUMMARY <- "/statistics/summary/" API_GROUPED_FORMATS <- "/grouped-formats/" @@ -12,10 +15,12 @@ API_USER_SPONSORSHIPS <- "/users/%s/sponsorships/" API_USER_AFFILIATES <- "/users/%s/affiliates/" API_USER_AVATAR <- "/users/%s/avatar/" API_USERS_HISTORY <- "/users/%s/history/" +API_USER_STATISTICS <- "/users/%s/statistics/" API_INSTITUTIONS_LIST <- "/institutions/" API_INSTITUTIONS <- "/institutions/%s/" API_INSTITUTION_AFFILIATES <- "/institutions/%s/affiliates/" API_INSTITUTION_AVATAR <- "/institutions/%s/avatar/" +API_INSTITUTION_STATISTICS <- "/institutions/%s/statistics/" API_VOLUMES <- "/volumes/" API_VOLUME_DETAIL <- "/volumes/%s/" API_VOLUME_TAGS <- "/volumes/%s/tags/" @@ -55,8 +60,8 @@ API_CATEGORY_DETAIL <- "/categories/%s/" API_VOLUME_CATEGORIES <- "/volumes/%s/categories/" RETRY_LIMIT <- 3 -RETRY_WAIT_TIME <- 1 # seconds -RETRY_BACKOFF <- 2 # exponential backoff +RETRY_WAIT_TIME <- 1 # seconds +RETRY_BACKOFF <- 2 # exponential backoff REQUEST_TIMEOUT <- 5 # seconds REQUEST_TIMEOUT_VERY_LONG <- 600 @@ -65,6 +70,9 @@ OAUTH_TOKEN_URL <- sprintf("%s/o/token/", DATABRARY_BASE_URL) OAUTH_TEST_URL <- sprintf("%s/oauth2/test/", DATABRARY_BASE_URL) LOGIN <- sprintf("%s/login/", DATABRARY_BASE_URL) -USER_AGENT <- paste0("databraryr/", as.character(utils::packageVersion("databraryr"))) +USER_AGENT <- paste0( + "databraryr/", + as.character(utils::packageVersion("databraryr")) +) KEYRING_SERVICE <- "org.databrary.databraryr" diff --git a/R/get_institution_statistics.R b/R/get_institution_statistics.R new file mode 100644 index 00000000..0f2d45ae --- /dev/null +++ b/R/get_institution_statistics.R @@ -0,0 +1,73 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get statistics for an institution +#' +#' Retrieve aggregated statistics for an institution including volume count, +#' file count, and data footprints. Returns NULL (204 No Content) when +#' statistics have not been computed yet. +#' +#' @param institution_id Institution identifier. Must be a positive integer. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' @inheritParams options_params +#' +#' @return A list with institution statistics including: +#' - `institution_id`: The institution identifier +#' - `volumes_number`: Number of volumes +#' - `files_number`: Number of files +#' - `uploaded_data_footprint`: Size of uploaded data in bytes +#' - `transcoded_data_footprint`: Size of transcoded data in bytes +#' - `soft_deleted_uploaded_data_footprint`: Size of soft-deleted uploaded data +#' - `soft_deleted_transcoded_data_footprint`: Size of soft-deleted transcoded data +#' - `created_at`: Timestamp when statistics were created +#' - `updated_at`: Timestamp when statistics were last updated +#' Returns NULL when statistics have not been computed or institution is not found. +#' @export +get_institution_statistics <- function( + institution_id = 1, + vb = options::opt("vb"), + rq = NULL +) { + assertthat::assert_that( + is.numeric(institution_id), + length(institution_id) == 1, + institution_id > 0 + ) + + validate_flag(vb, "vb") + + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + stats <- perform_api_get( + path = sprintf(API_INSTITUTION_STATISTICS, institution_id), + rq = rq, + vb = vb + ) + + if (is.null(stats)) { + if (vb) { + message( + "Institution statistics for ", + institution_id, + " not found or not yet computed." + ) + } + return(NULL) + } + + tibble::tibble( + institution_id = stats$institution_id, + volumes_number = stats$volumes_number, + files_number = stats$files_number, + uploaded_data_footprint = stats$uploaded_data_footprint, + transcoded_data_footprint = stats$transcoded_data_footprint, + soft_deleted_uploaded_data_footprint = stats$soft_deleted_uploaded_data_footprint, + soft_deleted_transcoded_data_footprint = stats$soft_deleted_transcoded_data_footprint, + created_at = stats$created_at, + updated_at = stats$updated_at + ) %>% + as.list() +} diff --git a/R/get_user_statistics.R b/R/get_user_statistics.R new file mode 100644 index 00000000..32859b41 --- /dev/null +++ b/R/get_user_statistics.R @@ -0,0 +1,69 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get statistics for a user +#' +#' Retrieve aggregated statistics for a user including volume count, +#' file count, and data footprints. Returns NULL (204 No Content) when +#' statistics have not been computed yet. +#' +#' @param user_id User identifier. Must be a positive integer. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' @inheritParams options_params +#' +#' @return A list with user statistics including: +#' - `user_id`: The user identifier +#' - `volumes_number`: Number of volumes +#' - `files_number`: Number of files +#' - `uploaded_data_footprint`: Size of uploaded data in bytes +#' - `transcoded_data_footprint`: Size of transcoded data in bytes +#' - `soft_deleted_uploaded_data_footprint`: Size of soft-deleted uploaded data +#' - `soft_deleted_transcoded_data_footprint`: Size of soft-deleted transcoded data +#' - `created_at`: Timestamp when statistics were created +#' - `updated_at`: Timestamp when statistics were last updated +#' Returns NULL when statistics have not been computed or user is not found. +#' @export +get_user_statistics <- function(user_id, vb = options::opt("vb"), rq = NULL) { + assertthat::assert_that( + is.numeric(user_id), + length(user_id) == 1, + user_id > 0 + ) + + validate_flag(vb, "vb") + + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + stats <- perform_api_get( + path = sprintf(API_USER_STATISTICS, user_id), + rq = rq, + vb = vb + ) + + if (is.null(stats)) { + if (vb) { + message( + "User statistics for ", + user_id, + " not found or not yet computed." + ) + } + return(NULL) + } + + tibble::tibble( + user_id = stats$user_id, + volumes_number = stats$volumes_number, + files_number = stats$files_number, + uploaded_data_footprint = stats$uploaded_data_footprint, + transcoded_data_footprint = stats$transcoded_data_footprint, + soft_deleted_uploaded_data_footprint = stats$soft_deleted_uploaded_data_footprint, + soft_deleted_transcoded_data_footprint = stats$soft_deleted_transcoded_data_footprint, + created_at = stats$created_at, + updated_at = stats$updated_at + ) %>% + as.list() +} diff --git a/man/get_institution_statistics.Rd b/man/get_institution_statistics.Rd new file mode 100644 index 00000000..3dbc772d --- /dev/null +++ b/man/get_institution_statistics.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_institution_statistics.R +\name{get_institution_statistics} +\alias{get_institution_statistics} +\title{Get statistics for an institution} +\usage{ +get_institution_statistics( + institution_id = 1, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{institution_id}{Institution identifier. Must be a positive integer.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with institution statistics including: +\itemize{ +\item \code{institution_id}: The institution identifier +\item \code{volumes_number}: Number of volumes +\item \code{files_number}: Number of files +\item \code{uploaded_data_footprint}: Size of uploaded data in bytes +\item \code{transcoded_data_footprint}: Size of transcoded data in bytes +\item \code{soft_deleted_uploaded_data_footprint}: Size of soft-deleted uploaded data +\item \code{soft_deleted_transcoded_data_footprint}: Size of soft-deleted transcoded data +\item \code{created_at}: Timestamp when statistics were created +\item \code{updated_at}: Timestamp when statistics were last updated +Returns NULL when statistics have not been computed or institution is not found. +} +} +\description{ +Retrieve aggregated statistics for an institution including volume count, +file count, and data footprints. Returns NULL (204 No Content) when +statistics have not been computed yet. +} diff --git a/man/get_user_statistics.Rd b/man/get_user_statistics.Rd new file mode 100644 index 00000000..930f1b9f --- /dev/null +++ b/man/get_user_statistics.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_user_statistics.R +\name{get_user_statistics} +\alias{get_user_statistics} +\title{Get statistics for a user} +\usage{ +get_user_statistics(user_id, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{user_id}{User identifier. Must be a positive integer.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with user statistics including: +\itemize{ +\item \code{user_id}: The user identifier +\item \code{volumes_number}: Number of volumes +\item \code{files_number}: Number of files +\item \code{uploaded_data_footprint}: Size of uploaded data in bytes +\item \code{transcoded_data_footprint}: Size of transcoded data in bytes +\item \code{soft_deleted_uploaded_data_footprint}: Size of soft-deleted uploaded data +\item \code{soft_deleted_transcoded_data_footprint}: Size of soft-deleted transcoded data +\item \code{created_at}: Timestamp when statistics were created +\item \code{updated_at}: Timestamp when statistics were last updated +Returns NULL when statistics have not been computed or user is not found. +} +} +\description{ +Retrieve aggregated statistics for a user including volume count, +file count, and data footprints. Returns NULL (204 No Content) when +statistics have not been computed yet. +} diff --git a/tests/testthat/test-get_institution_statistics.R b/tests/testthat/test-get_institution_statistics.R new file mode 100644 index 00000000..511f3cff --- /dev/null +++ b/tests/testthat/test-get_institution_statistics.R @@ -0,0 +1,26 @@ +test_that("get_institution_statistics returns statistics for institution with data", { + login_test_account() + result <- get_institution_statistics(1) + skip_if_null_response(result, "get_institution_statistics(1)") + expect_true(is.list(result)) + expect_equal(result$institution_id, 1) + expect_true(is.numeric(result$volumes_number)) + expect_true(is.numeric(result$files_number)) + expect_true(is.numeric(result$uploaded_data_footprint)) + expect_true(is.numeric(result$transcoded_data_footprint)) +}) + +test_that("get_institution_statistics returns NULL for institution without statistics", { + login_test_account() + result <- get_institution_statistics(999) + # Institution 999 may not exist or may have no statistics + expect_true(is.null(result) || is.list(result)) +}) + +test_that("get_institution_statistics with vb = TRUE", { + login_test_account() + result <- get_institution_statistics(1, vb = TRUE) + skip_if_null_response(result, "get_institution_statistics(1, vb = TRUE)") + expect_true(is.list(result)) + expect_equal(result$institution_id, 1) +}) diff --git a/tests/testthat/test-get_user_statistics.R b/tests/testthat/test-get_user_statistics.R new file mode 100644 index 00000000..acb22758 --- /dev/null +++ b/tests/testthat/test-get_user_statistics.R @@ -0,0 +1,26 @@ +test_that("get_user_statistics returns statistics for user with data", { + login_test_account() + result <- get_user_statistics(6) + skip_if_null_response(result, "get_user_statistics(6)") + expect_true(is.list(result)) + expect_equal(result$user_id, 6) + expect_true(is.numeric(result$volumes_number)) + expect_true(is.numeric(result$files_number)) + expect_true(is.numeric(result$uploaded_data_footprint)) + expect_true(is.numeric(result$transcoded_data_footprint)) +}) + +test_that("get_user_statistics returns NULL for user without statistics", { + login_test_account() + result <- get_user_statistics(999) + # User 999 may not exist or may have no statistics + expect_true(is.null(result) || is.list(result)) +}) + +test_that("get_user_statistics with vb = TRUE", { + login_test_account() + result <- get_user_statistics(6, vb = TRUE) + skip_if_null_response(result, "get_user_statistics(6, vb = TRUE)") + expect_true(is.list(result)) + expect_equal(result$user_id, 6) +}) From 5a663499e33e5b5f3ab0f99628f1494c8a589657 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Tue, 21 Apr 2026 09:37:51 +0200 Subject: [PATCH 46/77] fix: lint --- R/CONSTANTS.R | 8 ++-- R/get_institution_statistics.R | 72 +++++++++++++++++----------------- R/get_user_statistics.R | 66 +++++++++++++++---------------- 3 files changed, 73 insertions(+), 73 deletions(-) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index dc8486c7..cc8b497b 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -2,8 +2,8 @@ #' #' DATABRARY_BASE_URL <- Sys.getenv( - "DATABRARY_BASE_URL", - "https://api.databrary.org" + "DATABRARY_BASE_URL", + "https://api.databrary.org" ) API_ACTIVITY_SUMMARY <- "/statistics/summary/" @@ -71,8 +71,8 @@ OAUTH_TEST_URL <- sprintf("%s/oauth2/test/", DATABRARY_BASE_URL) LOGIN <- sprintf("%s/login/", DATABRARY_BASE_URL) USER_AGENT <- paste0( - "databraryr/", - as.character(utils::packageVersion("databraryr")) + "databraryr/", + as.character(utils::packageVersion("databraryr")) ) KEYRING_SERVICE <- "org.databrary.databraryr" diff --git a/R/get_institution_statistics.R b/R/get_institution_statistics.R index 0f2d45ae..a0af227d 100644 --- a/R/get_institution_statistics.R +++ b/R/get_institution_statistics.R @@ -27,47 +27,47 @@ NULL #' Returns NULL when statistics have not been computed or institution is not found. #' @export get_institution_statistics <- function( - institution_id = 1, - vb = options::opt("vb"), - rq = NULL + institution_id = 1, + vb = options::opt("vb"), + rq = NULL ) { - assertthat::assert_that( - is.numeric(institution_id), - length(institution_id) == 1, - institution_id > 0 - ) + assertthat::assert_that( + is.numeric(institution_id), + length(institution_id) == 1, + institution_id > 0 + ) - validate_flag(vb, "vb") + validate_flag(vb, "vb") - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - stats <- perform_api_get( - path = sprintf(API_INSTITUTION_STATISTICS, institution_id), - rq = rq, - vb = vb - ) + stats <- perform_api_get( + path = sprintf(API_INSTITUTION_STATISTICS, institution_id), + rq = rq, + vb = vb + ) - if (is.null(stats)) { - if (vb) { - message( - "Institution statistics for ", - institution_id, - " not found or not yet computed." - ) - } - return(NULL) + if (is.null(stats)) { + if (vb) { + message( + "Institution statistics for ", + institution_id, + " not found or not yet computed." + ) } + return(NULL) + } - tibble::tibble( - institution_id = stats$institution_id, - volumes_number = stats$volumes_number, - files_number = stats$files_number, - uploaded_data_footprint = stats$uploaded_data_footprint, - transcoded_data_footprint = stats$transcoded_data_footprint, - soft_deleted_uploaded_data_footprint = stats$soft_deleted_uploaded_data_footprint, - soft_deleted_transcoded_data_footprint = stats$soft_deleted_transcoded_data_footprint, - created_at = stats$created_at, - updated_at = stats$updated_at - ) %>% - as.list() + tibble::tibble( + institution_id = stats$institution_id, + volumes_number = stats$volumes_number, + files_number = stats$files_number, + uploaded_data_footprint = stats$uploaded_data_footprint, + transcoded_data_footprint = stats$transcoded_data_footprint, + soft_deleted_uploaded_data_footprint = stats$soft_deleted_uploaded_data_footprint, + soft_deleted_transcoded_data_footprint = stats$soft_deleted_transcoded_data_footprint, + created_at = stats$created_at, + updated_at = stats$updated_at + ) |> + as.list() } diff --git a/R/get_user_statistics.R b/R/get_user_statistics.R index 32859b41..9e2ed579 100644 --- a/R/get_user_statistics.R +++ b/R/get_user_statistics.R @@ -27,43 +27,43 @@ NULL #' Returns NULL when statistics have not been computed or user is not found. #' @export get_user_statistics <- function(user_id, vb = options::opt("vb"), rq = NULL) { - assertthat::assert_that( - is.numeric(user_id), - length(user_id) == 1, - user_id > 0 - ) + assertthat::assert_that( + is.numeric(user_id), + length(user_id) == 1, + user_id > 0 + ) - validate_flag(vb, "vb") + validate_flag(vb, "vb") - assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) - stats <- perform_api_get( - path = sprintf(API_USER_STATISTICS, user_id), - rq = rq, - vb = vb - ) + stats <- perform_api_get( + path = sprintf(API_USER_STATISTICS, user_id), + rq = rq, + vb = vb + ) - if (is.null(stats)) { - if (vb) { - message( - "User statistics for ", - user_id, - " not found or not yet computed." - ) - } - return(NULL) + if (is.null(stats)) { + if (vb) { + message( + "User statistics for ", + user_id, + " not found or not yet computed." + ) } + return(NULL) + } - tibble::tibble( - user_id = stats$user_id, - volumes_number = stats$volumes_number, - files_number = stats$files_number, - uploaded_data_footprint = stats$uploaded_data_footprint, - transcoded_data_footprint = stats$transcoded_data_footprint, - soft_deleted_uploaded_data_footprint = stats$soft_deleted_uploaded_data_footprint, - soft_deleted_transcoded_data_footprint = stats$soft_deleted_transcoded_data_footprint, - created_at = stats$created_at, - updated_at = stats$updated_at - ) %>% - as.list() + tibble::tibble( + user_id = stats$user_id, + volumes_number = stats$volumes_number, + files_number = stats$files_number, + uploaded_data_footprint = stats$uploaded_data_footprint, + transcoded_data_footprint = stats$transcoded_data_footprint, + soft_deleted_uploaded_data_footprint = stats$soft_deleted_uploaded_data_footprint, + soft_deleted_transcoded_data_footprint = stats$soft_deleted_transcoded_data_footprint, + created_at = stats$created_at, + updated_at = stats$updated_at + ) |> + as.list() } From e06ddeb37b672285ba112d58609b46a051802963 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Tue, 28 Apr 2026 10:21:09 +0200 Subject: [PATCH 47/77] feat: introduce record_as_client_list function to normalize API record payloads and more --- R/api_utils.R | 47 +++++++++++++++++++ R/create_volume_record.R | 31 ++---------- R/get_volume_record_by_id.R | 33 +++---------- R/list_volume_records.R | 45 +++++++++++++----- R/set_record_measure.R | 4 +- R/update_volume_record.R | 31 ++---------- man/create_volume_record.Rd | 7 ++- man/get_volume_record_by_id.Rd | 9 ++-- man/list_volume_records.Rd | 12 +++-- man/set_record_measure.Rd | 4 +- man/update_volume_record.Rd | 7 ++- tests/testthat/test-create_volume_record.R | 5 +- tests/testthat/test-get_volume_record_by_id.R | 32 +++++++++---- tests/testthat/test-list_volume_records.R | 21 ++++++--- tests/testthat/test-snake_case_list.R | 4 +- tests/testthat/test-update_volume_record.R | 5 +- 16 files changed, 167 insertions(+), 130 deletions(-) diff --git a/R/api_utils.R b/R/api_utils.R index 1bad7bd8..58f780d9 100644 --- a/R/api_utils.R +++ b/R/api_utils.R @@ -369,6 +369,53 @@ perform_api_delete <- function(path, TRUE } +#' Normalize an API record payload (already snake_case) into the package list shape. +#' +#' Mirrors read-only fields from core \verb{RecordSerializer}: \verb{id}, \verb{volume}, +#' \verb{volume_name}, \verb{category_id}, \verb{measures}, \verb{birthday}, \verb{age}, +#' \verb{default_sessions}, \verb{record_source_kind}. +#' +#' @noRd +record_as_client_list <- function(record) { + age <- NULL + if (!is.null(record$age)) { + age <- list( + years = record$age$years, + months = record$age$months, + days = record$age$days, + total_days = record$age$total_days, + formatted_value = record$age$formatted_value, + is_partial = record$age$is_partial, + is_blurred = record$age$is_blurred + ) + } + + ds <- record$default_sessions + if (is.null(ds)) { + ds <- list() + } + + list( + record_id = record$id, + record_volume = record$volume, + record_volume_name = if (is.null(record$volume_name)) { + NA_character_ + } else { + as.character(record$volume_name) + }, + record_category_id = record$category_id, + measures = record$measures, + birthday = record$birthday, + age = age, + default_sessions = ds, + record_source_kind = if (is.null(record$record_source_kind)) { + NA_character_ + } else { + as.character(record$record_source_kind) + } + ) +} + #' @noRd #' @param optional If `TRUE`, `NULL` is allowed (parameter omitted from an API #' call). If `FALSE`, `value` must be a single logical (e.g. `vb`). diff --git a/R/create_volume_record.R b/R/create_volume_record.R index fe9a9dae..029cab60 100644 --- a/R/create_volume_record.R +++ b/R/create_volume_record.R @@ -108,16 +108,15 @@ get_name_metric_id <- function(vol_id, #' @param measures Optional named list mapping additional metric IDs (as strings) #' to values. Values can be strings (for text metrics), numbers (for numeric #' metrics), or lists with \code{year}, \code{month}, \code{day}, -#' \code{is_estimated} fields (for date metrics). +#' optional \code{month} and \code{day} fields (for date metrics). #' @param participant Optional list for participant records containing #' \code{birthday} (with \code{year}, \code{month}, \code{day} fields) or #' \code{age} (with \code{years}, \code{months}, \code{days} fields). Cannot #' provide both \code{birthday} and \code{age}. #' @param rq An \code{httr2} request object. Defaults to \code{NULL}. #' -#' @return A list with the created record's metadata including id, volume, -#' category_id, measures, birthday (if participant), and age (if participant), -#' or \code{NULL} if creation fails. +#' @return Same shape as \code{\link{get_volume_record_by_id}}, or \code{NULL} +#' if creation fails. #' #' @inheritParams options_params #' @@ -219,27 +218,5 @@ create_volume_record <- function( return(NULL) } - # Process age if present - age <- NULL - if (!is.null(record$age)) { - age <- list( - years = record$age$years, - months = record$age$months, - days = record$age$days, - total_days = record$age$total_days, - formatted_value = record$age$formatted_value, - is_estimated = record$age$is_estimated, - is_blurred = record$age$is_blurred - ) - } - - # Return structured list - list( - record_id = record$id, - record_volume = record$volume, - record_category_id = record$category_id, - measures = record$measures, - birthday = record$birthday, - age = age - ) + record_as_client_list(record) } diff --git a/R/get_volume_record_by_id.R b/R/get_volume_record_by_id.R index 5b49e535..0abc88b8 100644 --- a/R/get_volume_record_by_id.R +++ b/R/get_volume_record_by_id.R @@ -15,9 +15,12 @@ NULL #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' -#' @return A list with the record's metadata including id, volume, category_id, -#' measures, birthday, and age information, or `NULL` if the record is not -#' found or inaccessible. +#' @return A list aligned with the API record payload: `record_id`, `record_volume`, +#' `record_volume_name`, `record_category_id`, `measures`, `birthday`, `age`, +#' `default_sessions` (session ids/names where this record is a default), +#' `record_source_kind` (linked-content provenance, e.g. `native`, +#' `source_linked_file`). `record_volume` may differ from `vol_id` for linked +#' records. Returns `NULL` if the record is not found or inaccessible. #' #' @inheritParams options_params #' @@ -77,27 +80,5 @@ get_volume_record_by_id <- function( return(NULL) } - # Process age if present - age <- NULL - if (!is.null(record$age)) { - age <- list( - years = record$age$years, - months = record$age$months, - days = record$age$days, - total_days = record$age$total_days, - formatted_value = record$age$formatted_value, - is_estimated = record$age$is_estimated, - is_blurred = record$age$is_blurred - ) - } - - # Return structured list - list( - record_id = record$id, - record_volume = record$volume, - record_category_id = record$category_id, - measures = record$measures, - birthday = record$birthday, - age = age - ) + record_as_client_list(record) } diff --git a/R/list_volume_records.R b/R/list_volume_records.R index 3d11c23d..48897ccb 100644 --- a/R/list_volume_records.R +++ b/R/list_volume_records.R @@ -8,6 +8,7 @@ empty_volume_records_tibble <- function() { tibble::tibble( record_id = integer(0), record_volume = integer(0), + record_volume_name = character(0), record_category_id = integer(0), record_measures = list(), record_birthday = character(0), @@ -16,8 +17,10 @@ empty_volume_records_tibble <- function() { age_days = integer(0), age_total_days = integer(0), age_formatted = character(0), - age_is_estimated = logical(0), - age_is_blurred = logical(0) + age_is_partial = logical(0), + age_is_blurred = logical(0), + record_default_sessions = vector("list", 0), + record_source_kind = character(0) ) } @@ -33,10 +36,14 @@ empty_volume_records_tibble <- function() { #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to `NULL`. #' -#' @return A tibble containing metadata for each record including id, volume, -#' category_id, measures, birthday, and age information. Returns an empty -#' tibble (with the same columns) when the volume has no records, or `NULL` -#' when the API call fails (e.g. non-existent volume). +#' @return A tibble containing metadata for each record (aligned with core +#' \verb{RecordSerializer}): ids, owning volume (`record_volume`), owning volume +#' name (`record_volume_name`), category, measures, birthday, age columns, +#' default sessions (`record_default_sessions`, list column of \verb{id}/\verb{name}), +#' and linked-content provenance (`record_source_kind`). The `record_volume` +#' column may differ from `vol_id` when the volume lists linked records from +#' other volumes. Returns an empty tibble when the volume has no records, or +#' `NULL` when the API call fails (e.g. non-existent volume). #' #' @inheritParams options_params #' @@ -121,7 +128,7 @@ list_volume_records <- function(vol_id = 1, age_days <- NA_integer_ age_total_days <- NA_integer_ age_formatted <- NA_character_ - age_is_estimated <- NA + age_is_partial <- NA age_is_blurred <- NA if (!is.null(record$age)) { @@ -150,8 +157,8 @@ list_volume_records <- function(vol_id = 1, } else { NA_character_ } - age_is_estimated <- if (!is.null(record$age$is_estimated)) { - record$age$is_estimated + age_is_partial <- if (!is.null(record$age$is_partial)) { + record$age$is_partial } else { NA } @@ -162,9 +169,19 @@ list_volume_records <- function(vol_id = 1, } } + ds_cell <- record$default_sessions + if (is.null(ds_cell)) { + ds_cell <- list() + } + tibble::tibble( record_id = record$id, record_volume = record$volume, + record_volume_name = if (is.null(record$volume_name)) { + NA_character_ + } else { + as.character(record$volume_name) + }, record_category_id = record$category_id, record_measures = list(record$measures), record_birthday = if (is.null(record$birthday)) { @@ -182,8 +199,14 @@ list_volume_records <- function(vol_id = 1, age_days = age_days, age_total_days = age_total_days, age_formatted = age_formatted, - age_is_estimated = age_is_estimated, - age_is_blurred = age_is_blurred + age_is_partial = age_is_partial, + age_is_blurred = age_is_blurred, + record_default_sessions = list(ds_cell), + record_source_kind = if (is.null(record$record_source_kind)) { + NA_character_ + } else { + as.character(record$record_source_kind) + } ) }) } diff --git a/R/set_record_measure.R b/R/set_record_measure.R index 31e42434..b338de8e 100644 --- a/R/set_record_measure.R +++ b/R/set_record_measure.R @@ -14,7 +14,7 @@ NULL #' @param metric_id Numeric metric identifier. Must be a positive integer. #' @param value The measure value. Can be a string (for text metrics), a number #' (for numeric metrics), or a list with \code{year}, \code{month}, \code{day}, -#' \code{is_estimated} fields (for date metrics). +#' optional \code{month} and \code{day} fields (for date metrics). #' @param rq An \code{httr2} request object. Defaults to \code{NULL}. #' #' @return The measure data on success, or \code{NULL} if the operation fails. @@ -45,7 +45,7 @@ NULL #' vol_id = 1, #' record_id = 123, #' metric_id = 4, -#' value = list(year = 2020, month = 3, day = 15, is_estimated = FALSE) +#' value = list(year = 2020, month = 3, day = 15) #' ) #' } #' } diff --git a/R/update_volume_record.R b/R/update_volume_record.R index 1bdeb6fe..5ccef963 100644 --- a/R/update_volume_record.R +++ b/R/update_volume_record.R @@ -18,7 +18,7 @@ NULL #' @param record_id Numeric record identifier. Must be a positive integer. #' @param measures Optional named list mapping metric IDs (as strings) to values. #' Values can be strings (for text metrics), numbers (for numeric metrics), -#' or lists with \code{year}, \code{month}, \code{day}, \code{is_estimated} +#' or lists with \code{year} and optional \code{month}, \code{day} #' fields (for date metrics). When supplied, must include all required metrics #' for the record's category (use \code{\link{get_volume_enabled_categories}} #' or \code{\link{get_volume_record_by_id}} to discover ids and current values). @@ -32,9 +32,8 @@ NULL #' #' @seealso \code{\link{set_record_measure}}, \code{\link{get_volume_record_by_id}} #' -#' @return A list with the updated record's metadata including id, volume, -#' category_id, measures, birthday (if participant), and age (if participant), -#' or \code{NULL} if update fails. +#' @return A list with the updated record's metadata (same shape as +#' \code{\link{get_volume_record_by_id}}), or \code{NULL} if update fails. #' #' @inheritParams options_params #' @@ -104,27 +103,5 @@ update_volume_record <- function( return(NULL) } - # Process age if present - age <- NULL - if (!is.null(record$age)) { - age <- list( - years = record$age$years, - months = record$age$months, - days = record$age$days, - total_days = record$age$total_days, - formatted_value = record$age$formatted_value, - is_estimated = record$age$is_estimated, - is_blurred = record$age$is_blurred - ) - } - - # Return structured list - list( - record_id = record$id, - record_volume = record$volume, - record_category_id = record$category_id, - measures = record$measures, - birthday = record$birthday, - age = age - ) + record_as_client_list(record) } diff --git a/man/create_volume_record.Rd b/man/create_volume_record.Rd index c03ca725..ae752ad4 100644 --- a/man/create_volume_record.Rd +++ b/man/create_volume_record.Rd @@ -26,7 +26,7 @@ Required; resolves to the category's name metric from volume configuration.} \item{measures}{Optional named list mapping additional metric IDs (as strings) to values. Values can be strings (for text metrics), numbers (for numeric metrics), or lists with \code{year}, \code{month}, \code{day}, -\code{is_estimated} fields (for date metrics).} +optional \code{month} and \code{day} fields (for date metrics).} \item{participant}{Optional list for participant records containing \code{birthday} (with \code{year}, \code{month}, \code{day} fields) or @@ -38,9 +38,8 @@ provide both \code{birthday} and \code{age}.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } \value{ -A list with the created record's metadata including id, volume, -category_id, measures, birthday (if participant), and age (if participant), -or \code{NULL} if creation fails. +Same shape as \code{\link{get_volume_record_by_id}}, or \code{NULL} +if creation fails. } \description{ Create a new record in a Databrary volume. Records contain diff --git a/man/get_volume_record_by_id.Rd b/man/get_volume_record_by_id.Rd index 15844a68..63ba2740 100644 --- a/man/get_volume_record_by_id.Rd +++ b/man/get_volume_record_by_id.Rd @@ -21,9 +21,12 @@ get_volume_record_by_id( \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } \value{ -A list with the record's metadata including id, volume, category_id, -measures, birthday, and age information, or \code{NULL} if the record is not -found or inaccessible. +A list aligned with the API record payload: \code{record_id}, \code{record_volume}, +\code{record_volume_name}, \code{record_category_id}, \code{measures}, \code{birthday}, \code{age}, +\code{default_sessions} (session ids/names where this record is a default), +\code{record_source_kind} (linked-content provenance, e.g. \code{native}, +\code{source_linked_file}). \code{record_volume} may differ from \code{vol_id} for linked +records. Returns \code{NULL} if the record is not found or inaccessible. } \description{ Retrieve detailed information about a specific record diff --git a/man/list_volume_records.Rd b/man/list_volume_records.Rd index 9ad422ad..02d8b6d6 100644 --- a/man/list_volume_records.Rd +++ b/man/list_volume_records.Rd @@ -22,10 +22,14 @@ by category type.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } \value{ -A tibble containing metadata for each record including id, volume, -category_id, measures, birthday, and age information. Returns an empty -tibble (with the same columns) when the volume has no records, or \code{NULL} -when the API call fails (e.g. non-existent volume). +A tibble containing metadata for each record (aligned with core +\verb{RecordSerializer}): ids, owning volume (\code{record_volume}), owning volume +name (\code{record_volume_name}), category, measures, birthday, age columns, +default sessions (\code{record_default_sessions}, list column of \verb{id}/\verb{name}), +and linked-content provenance (\code{record_source_kind}). The \code{record_volume} +column may differ from \code{vol_id} when the volume lists linked records from +other volumes. Returns an empty tibble when the volume has no records, or +\code{NULL} when the API call fails (e.g. non-existent volume). } \description{ Retrieve all records (participant data with measures) from a diff --git a/man/set_record_measure.Rd b/man/set_record_measure.Rd index 5d735a6c..f4b67793 100644 --- a/man/set_record_measure.Rd +++ b/man/set_record_measure.Rd @@ -22,7 +22,7 @@ set_record_measure( \item{value}{The measure value. Can be a string (for text metrics), a number (for numeric metrics), or a list with \code{year}, \code{month}, \code{day}, -\code{is_estimated} fields (for date metrics).} +optional \code{month} and \code{day} fields (for date metrics).} \item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} @@ -60,7 +60,7 @@ set_record_measure( vol_id = 1, record_id = 123, metric_id = 4, - value = list(year = 2020, month = 3, day = 15, is_estimated = FALSE) + value = list(year = 2020, month = 3, day = 15) ) } } diff --git a/man/update_volume_record.Rd b/man/update_volume_record.Rd index 049f46f0..a3d3d239 100644 --- a/man/update_volume_record.Rd +++ b/man/update_volume_record.Rd @@ -20,7 +20,7 @@ update_volume_record( \item{measures}{Optional named list mapping metric IDs (as strings) to values. Values can be strings (for text metrics), numbers (for numeric metrics), -or lists with \code{year}, \code{month}, \code{day}, \code{is_estimated} +or lists with \code{year} and optional \code{month}, \code{day} fields (for date metrics). When supplied, must include all required metrics for the record's category (use \code{\link{get_volume_enabled_categories}} or \code{\link{get_volume_record_by_id}} to discover ids and current values).} @@ -37,9 +37,8 @@ measures or use \code{\link{set_record_measure}} for targeted edits.} \item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } \value{ -A list with the updated record's metadata including id, volume, -category_id, measures, birthday (if participant), and age (if participant), -or \code{NULL} if update fails. +A list with the updated record's metadata (same shape as +\code{\link{get_volume_record_by_id}}), or \code{NULL} if update fails. } \description{ Sends a PATCH request to update a record. The HTTP method is diff --git a/tests/testthat/test-create_volume_record.R b/tests/testthat/test-create_volume_record.R index 133ea8e5..b044e29d 100644 --- a/tests/testthat/test-create_volume_record.R +++ b/tests/testthat/test-create_volume_record.R @@ -17,7 +17,10 @@ test_that("create_volume_record creates a record with valid parameters", { } expect_type(result, "list") - expect_named(result, c("record_id", "record_volume", "record_category_id", "measures", "birthday", "age")) + expect_named(result, c( + "record_id", "record_volume", "record_volume_name", "record_category_id", + "measures", "birthday", "age", "default_sessions", "record_source_kind" + )) expect_equal(as.integer(result$record_volume), 1777L) expect_equal(result$record_category_id, 6) expect_true(is.numeric(result$record_id) || is.integer(result$record_id)) diff --git a/tests/testthat/test-get_volume_record_by_id.R b/tests/testthat/test-get_volume_record_by_id.R index bd1669a0..dafde203 100644 --- a/tests/testthat/test-get_volume_record_by_id.R +++ b/tests/testthat/test-get_volume_record_by_id.R @@ -13,9 +13,14 @@ test_that("get_volume_record_by_id retrieves valid record", { skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", test_record_id)) expect_type(result, "list") - expect_named(result, c("record_id", "record_volume", "record_category_id", "measures", "birthday", "age")) + expect_named(result, c( + "record_id", "record_volume", "record_volume_name", "record_category_id", + "measures", "birthday", "age", "default_sessions", "record_source_kind" + )) expect_equal(result$record_id, test_record_id) - expect_equal(result$record_volume, 1777) + # record_volume is the owning volume id; linked records may differ from requested vol_id + row <- match(test_record_id, records$record_id) + expect_equal(result$record_volume, records$record_volume[row]) expect_true(is.numeric(result$record_category_id) || is.integer(result$record_category_id)) } }) @@ -124,19 +129,25 @@ test_that("get_volume_record_by_id result structure is consistent", { skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", test_record_id)) # Check that all expected fields exist - expect_true(all(c("record_id", "record_volume", "record_category_id", "measures", "birthday", "age") %in% names(result))) + expect_true(all(c( + "record_id", "record_volume", "record_volume_name", "record_category_id", + "measures", "birthday", "age", "default_sessions", "record_source_kind" + ) %in% names(result))) # Check field types expect_true(is.numeric(result$record_id) || is.integer(result$record_id)) expect_true(is.numeric(result$record_volume) || is.integer(result$record_volume)) + expect_true(is.character(result$record_volume_name)) expect_true(is.numeric(result$record_category_id) || is.integer(result$record_category_id)) expect_true(is.list(result$measures) || is.null(result$measures)) + expect_true(is.list(result$default_sessions)) # Check that record_id matches the requested ID expect_equal(result$record_id, test_record_id) - # Check that record_volume matches requested volume - expect_equal(result$record_volume, 1777) + # Owning volume may differ from requested vol_id when the list includes linked records + row <- match(test_record_id, records$record_id) + expect_equal(result$record_volume, records$record_volume[row]) } }) @@ -152,7 +163,7 @@ test_that("get_volume_record_by_id handles age structure correctly", { # If age exists, check its structure if (!is.null(result$age)) { expect_type(result$age, "list") - expected_fields <- c("years", "months", "days", "total_days", "formatted_value", "is_estimated", "is_blurred") + expected_fields <- c("years", "months", "days", "total_days", "formatted_value", "is_partial", "is_blurred") expect_true(all(expected_fields %in% names(result$age))) } } @@ -219,8 +230,11 @@ test_that("get_volume_record_by_id returns complete structure with all fields", result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id) skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", test_record_id)) - # Record should have all expected fields - expect_length(result, 6) - expect_named(result, c("record_id", "record_volume", "record_category_id", "measures", "birthday", "age")) + # Record should have all expected fields (parity with RecordSerializer read-only output) + expect_length(result, 9) + expect_named(result, c( + "record_id", "record_volume", "record_volume_name", "record_category_id", + "measures", "birthday", "age", "default_sessions", "record_source_kind" + )) } }) diff --git a/tests/testthat/test-list_volume_records.R b/tests/testthat/test-list_volume_records.R index 50c1e85a..46335fc5 100644 --- a/tests/testthat/test-list_volume_records.R +++ b/tests/testthat/test-list_volume_records.R @@ -7,7 +7,10 @@ test_that("list_volume_records returns tibble given valid vol_id", { expect_s3_class(result, "tbl_df") expect_gt(nrow(result), 0) - expect_true(all(c("record_id", "record_volume", "record_category_id") %in% names(result))) + expect_true(all(c( + "record_id", "record_volume", "record_volume_name", "record_category_id", + "record_measures", "record_default_sessions", "record_source_kind" + ) %in% names(result))) }) test_that("list_volume_records returns valid record structure", { @@ -23,8 +26,10 @@ test_that("list_volume_records returns valid record structure", { # Check that record_ids are positive expect_true(all(result$record_id > 0)) - # Check that record_volume matches requested volume - expect_true(all(result$record_volume == 1777)) + # record_volume_name / linked provenance / default sessions (core RecordSerializer) + expect_true(is.character(result$record_volume_name)) + expect_true(is.list(result$record_default_sessions)) + expect_true(is.character(result$record_source_kind)) }) test_that("list_volume_records returns NULL for non-existent volume", { @@ -118,7 +123,7 @@ test_that("list_volume_records includes age fields", { # Check that age fields exist age_fields <- c("age_years", "age_months", "age_days", "age_total_days", - "age_formatted", "age_is_estimated", "age_is_blurred") + "age_formatted", "age_is_partial", "age_is_blurred") expect_true(all(age_fields %in% names(result))) }) @@ -151,7 +156,9 @@ test_that("list_volume_records returns for different volumes", { expect_s3_class(result1, "tbl_df") expect_s3_class(result2, "tbl_df") - # Records should have different volume IDs - expect_true(all(result1$record_volume == 1777)) - expect_true(all(result2$record_volume == 2)) + # Owning-volume ids may differ from requested vol_id when volumes expose linked records + expect_true(all(is.finite(result1$record_volume))) + expect_true(all(is.finite(result2$record_volume))) + expect_gt(length(unique(result1$record_id)), 0) + expect_gt(length(unique(result2$record_id)), 0) }) diff --git a/tests/testthat/test-snake_case_list.R b/tests/testthat/test-snake_case_list.R index b8fd6948..a8ae083b 100644 --- a/tests/testthat/test-snake_case_list.R +++ b/tests/testthat/test-snake_case_list.R @@ -67,7 +67,7 @@ test_that("snake_case_list handles deeply nested record with age (QA repro)", { days = 1948, totalDays = 1948, formattedValue = "5 years, 4 months", - isEstimated = FALSE, + isPartial = FALSE, isBlurred = FALSE ) ) @@ -76,7 +76,7 @@ test_that("snake_case_list handles deeply nested record with age (QA repro)", { expect_equal(result$category_id, 1) expect_equal(names(result$age), c( "years", "months", "days", "total_days", - "formatted_value", "is_estimated", "is_blurred" + "formatted_value", "is_partial", "is_blurred" )) expect_equal(result$age$total_days, 1948) expect_equal(names(result$birthday), c("metric_id", "value")) diff --git a/tests/testthat/test-update_volume_record.R b/tests/testthat/test-update_volume_record.R index 810ea162..13833172 100644 --- a/tests/testthat/test-update_volume_record.R +++ b/tests/testthat/test-update_volume_record.R @@ -27,7 +27,10 @@ test_that("update_volume_record updates an existing record", { skip_if_null_response(update_result, "update_volume_record") expect_type(update_result, "list") - expect_named(update_result, c("record_id", "record_volume", "record_category_id", "measures", "birthday", "age")) + expect_named(update_result, c( + "record_id", "record_volume", "record_volume_name", "record_category_id", + "measures", "birthday", "age", "default_sessions", "record_source_kind" + )) expect_equal(update_result$record_id, record_id) expect_true(!is.null(update_result$measures)) }) From 0ee6100b74979bdebfeac429cca559e07c9c80df Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Fri, 8 May 2026 14:21:11 +0200 Subject: [PATCH 48/77] feat(api): add session sub-action paths and PUT helper --- R/CONSTANTS.R | 3 +++ R/api_utils.R | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 50 insertions(+) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index cc8b497b..c246f416 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -35,6 +35,9 @@ API_VOLUME_RECORDS <- "/volumes/%s/records/" API_VOLUME_RECORD_DETAIL <- "/volumes/%s/records/%s/" API_RECORD_MEASURES <- "/volumes/%s/records/%s/measures/%s/" API_SESSION_DETAIL <- "/volumes/%s/sessions/%s/" +API_SESSION_ADD_DEFAULT_RECORD <- "/volumes/%s/sessions/%s/add-default-record/" +API_SESSION_REMOVE_DEFAULT_RECORD <- "/volumes/%s/sessions/%s/remove-default-record/" +API_SESSION_CHECK_DUPLICATE_FILES <- "/volumes/%s/sessions/%s/check-duplicate-files/" API_SESSION_FILES <- "/volumes/%s/sessions/%s/files/" API_SESSION_FILE_DETAIL <- "/volumes/%s/sessions/%s/files/%s/" API_SESSION_FILE_ASSIGN <- "/volumes/%s/sessions/%s/files/%s/assign-record/" diff --git a/R/api_utils.R b/R/api_utils.R index 58f780d9..1c86cc0a 100644 --- a/R/api_utils.R +++ b/R/api_utils.R @@ -339,6 +339,53 @@ perform_api_patch <- function(path, payload } +#' @noRd +# TODO: verify behavior against the live API. Mirrors `perform_api_patch`, +# but no existing wrapper currently issues PUT, so this helper is unexercised. +perform_api_put <- function(path, + body = list(), + rq = NULL, + vb = FALSE, + normalize = TRUE) { + request <- rq + if (is.null(request)) { + request <- databraryr::make_default_request() + } + + url <- paste0(DATABRARY_BASE_URL, ensure_leading_slash(path)) + request <- httr2::req_url(request, url) + request <- httr2::req_method(request, "PUT") + + if (!is.null(body) && length(body) > 0) { + request <- httr2::req_body_json(request, body) + } + + response <- tryCatch( + httr2::req_perform(request), + httr2_error = function(cnd) { + if (vb) { + message("PUT request failed for ", url, ": ", conditionMessage(cnd)) + } + NULL + } + ) + + if (is.null(response)) { + return(NULL) + } + + status <- httr2::resp_status(response) + if (status == 204L || !resp_has_body(response)) { + return(TRUE) + } + + payload <- httr2::resp_body_json(response) + if (isTRUE(normalize)) { + payload <- snake_case_list(payload) + } + payload +} + #' @noRd perform_api_delete <- function(path, rq = NULL, From 0fefedfb92bb37303af618a9d62a89e817d119fa Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Fri, 8 May 2026 14:25:00 +0200 Subject: [PATCH 49/77] feat: add delete_session() --- R/delete_session.R | 61 ++++++++++++++++++ tests/testthat/test-delete_session.R | 93 ++++++++++++++++++++++++++++ 2 files changed, 154 insertions(+) create mode 100644 R/delete_session.R create mode 100644 tests/testthat/test-delete_session.R diff --git a/R/delete_session.R b/R/delete_session.R new file mode 100644 index 00000000..5c41bf5e --- /dev/null +++ b/R/delete_session.R @@ -0,0 +1,61 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Delete Session from Databrary Volume +#' +#' @description Delete (soft-delete) a session from a Databrary volume. The +#' session and its associated metadata are marked as deleted but not +#' permanently removed from the database. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} if the session was successfully deleted, \code{FALSE} +#' otherwise. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Delete a session +#' delete_session(vol_id = 1, session_id = 42) +#' +#' # Delete with verbose output +#' delete_session(vol_id = 1, session_id = 42, vb = TRUE) +#' } +#' } +#' @export +delete_session <- function( + vol_id = 1, + session_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + success <- perform_api_delete( + path = sprintf(API_SESSION_DETAIL, vol_id, session_id), + rq = rq, + vb = vb + ) + + if (!success) { + if (vb) { + message( + "Failed to delete session ", + session_id, + " from volume ", + vol_id + ) + } + } + + success +} diff --git a/tests/testthat/test-delete_session.R b/tests/testthat/test-delete_session.R new file mode 100644 index 00000000..6053ba11 --- /dev/null +++ b/tests/testthat/test-delete_session.R @@ -0,0 +1,93 @@ +# delete_session() ------------------------------------------------------------- +login_test_account() + +# Internal helper: create a session directly via the API for roundtrip tests. +# Not using create_session() yet to keep this block self-contained; switch +# once create_session() lands. +create_session_for_test <- function(vol_id = 1777, name = "delete_session test") { + databraryr:::perform_api_post( + path = sprintf(databraryr:::API_VOLUME_SESSIONS, vol_id), + body = list(name = name), + vb = FALSE + ) +} + +test_that("delete_session deletes an existing session", { + created <- create_session_for_test(name = "delete_session happy path") + skip_if_null_response(created, "create session for delete_session happy path") + + session_id <- created$id + result <- delete_session(vol_id = 1777, session_id = session_id, vb = FALSE) + + expect_true(result) + + # Verify it's gone + expect_null(get_session_by_id(vol_id = 1777, session_id = session_id, vb = FALSE)) +}) + +test_that("delete_session returns FALSE for non-existent session", { + expect_false(delete_session(vol_id = 1777, session_id = 999999999, vb = FALSE)) +}) + +test_that("delete_session works with verbose mode", { + created <- create_session_for_test(name = "delete_session vb") + skip_if_null_response(created, "create session for delete_session vb") + + expect_true(delete_session(vol_id = 1777, session_id = created$id, vb = TRUE)) +}) + +test_that("delete_session works with custom request object", { + created <- create_session_for_test(name = "delete_session custom rq") + skip_if_null_response(created, "create session for delete_session custom rq") + + custom_rq <- databraryr::make_default_request() + expect_true( + delete_session( + vol_id = 1777, + session_id = created$id, + rq = custom_rq, + vb = FALSE + ) + ) +}) + +test_that("delete_session rejects invalid vol_id", { + expect_error(delete_session(vol_id = -1, session_id = 1)) + expect_error(delete_session(vol_id = 0, session_id = 1)) + expect_error(delete_session(vol_id = "1", session_id = 1)) + expect_error(delete_session(vol_id = TRUE, session_id = 1)) + expect_error(delete_session(vol_id = list(a = 1), session_id = 1)) + expect_error(delete_session(vol_id = c(1, 2), session_id = 1)) + expect_error(delete_session(vol_id = 1.5, session_id = 1)) + expect_error(delete_session(vol_id = NULL, session_id = 1)) + expect_error(delete_session(vol_id = NA, session_id = 1)) +}) + +test_that("delete_session rejects invalid session_id", { + expect_error(delete_session(vol_id = 1777, session_id = -1)) + expect_error(delete_session(vol_id = 1777, session_id = 0)) + expect_error(delete_session(vol_id = 1777, session_id = "1")) + expect_error(delete_session(vol_id = 1777, session_id = TRUE)) + expect_error(delete_session(vol_id = 1777, session_id = list(a = 1))) + expect_error(delete_session(vol_id = 1777, session_id = c(1, 2))) + expect_error(delete_session(vol_id = 1777, session_id = 1.5)) + expect_error(delete_session(vol_id = 1777, session_id = NULL)) + expect_error(delete_session(vol_id = 1777, session_id = NA)) +}) + +test_that("delete_session rejects invalid vb parameter", { + expect_error(delete_session(vol_id = 1777, session_id = 1, vb = -1)) + expect_error(delete_session(vol_id = 1777, session_id = 1, vb = 3)) + expect_error(delete_session(vol_id = 1777, session_id = 1, vb = "a")) + expect_error(delete_session(vol_id = 1777, session_id = 1, vb = list(a = 1))) + expect_error(delete_session(vol_id = 1777, session_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_session(vol_id = 1777, session_id = 1, vb = NULL)) +}) + +test_that("delete_session rejects invalid rq parameter", { + expect_error(delete_session(vol_id = 1777, session_id = 1, rq = "a")) + expect_error(delete_session(vol_id = 1777, session_id = 1, rq = -1)) + expect_error(delete_session(vol_id = 1777, session_id = 1, rq = c(2, 3))) + expect_error(delete_session(vol_id = 1777, session_id = 1, rq = list(a = 1))) + expect_error(delete_session(vol_id = 1777, session_id = 1, rq = TRUE)) +}) From 612280c5f9eb27db30d5661e042ac61c510841ab Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Fri, 8 May 2026 14:28:23 +0200 Subject: [PATCH 50/77] feat: add create_session() --- R/create_session.R | 177 +++++++++++++++++++++++++++ tests/testthat/test-create_session.R | 171 ++++++++++++++++++++++++++ tests/testthat/test-delete_session.R | 27 ++-- 3 files changed, 358 insertions(+), 17 deletions(-) create mode 100644 R/create_session.R create mode 100644 tests/testthat/test-create_session.R diff --git a/R/create_session.R b/R/create_session.R new file mode 100644 index 00000000..4b7e9687 --- /dev/null +++ b/R/create_session.R @@ -0,0 +1,177 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Coerce a date-like argument to an ISO "YYYY-MM-DD" string. +#' +#' Accepts a `Date` object or a length-1 character already in ISO form. +#' +#' @noRd +coerce_iso_date <- function(value, name) { + if (inherits(value, "Date")) { + assertthat::assert_that( + length(value) == 1, + msg = paste(name, "must have length 1") + ) + return(format(value, "%Y-%m-%d")) + } + assertthat::assert_that( + is.character(value), + length(value) == 1, + nzchar(trimws(value)), + msg = paste(name, "must be a Date or non-empty 'YYYY-MM-DD' string") + ) + parsed <- tryCatch(as.Date(value), error = function(e) NA) + assertthat::assert_that( + !is.na(parsed), + msg = paste(name, "must parse as a date (e.g. '2024-03-15')") + ) + format(parsed, "%Y-%m-%d") +} + +#' Create Session in Databrary Volume +#' +#' @description Create a new session in a Databrary volume. A session (a.k.a. +#' "slot") groups files and metadata for a single recording or testing event. +#' \code{name} is required and must be non-empty. Provide either a flat +#' \code{source_date} or a structured \code{date} list (with optional +#' \code{date_precision}) to record when the session occurred -- not both. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param name Display name for the session. Required, non-empty after trim. +#' @param release_level Optional release level for the session +#' (e.g. \code{"PRIVATE"}, \code{"SHARED"}, \code{"EXCERPTS"}, +#' \code{"PUBLIC"}). The server validates the choice. +#' @param source_date Optional session date. A length-1 \code{Date} object or +#' ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}. +#' @param date Optional structured date list with named fields \code{year}, +#' \code{month}, \code{day}, and optional \code{is_estimated} (logical). +#' Mutually exclusive with \code{source_date}. +#' @param date_precision Optional precision for \code{date}: e.g. +#' \code{"FULL"}, \code{"YEAR"}. Server validates the choice. +#' @param default_records Optional integer vector of record IDs to set as +#' default records on the new session. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the created session's metadata (same shape as +#' \code{\link{get_session_by_id}}), or \code{NULL} if creation fails. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Minimal session +#' create_session(vol_id = 1, name = "Pilot 01") +#' +#' # Session with a flat date +#' create_session( +#' vol_id = 1, +#' name = "Pilot 02", +#' source_date = as.Date("2024-03-15") +#' ) +#' +#' # Session with a structured date and default records +#' create_session( +#' vol_id = 1, +#' name = "Pilot 03", +#' date = list(year = 2024, month = 3, day = 15, is_estimated = FALSE), +#' date_precision = "FULL", +#' default_records = c(101, 102) +#' ) +#' } +#' } +#' @export +create_session <- function( + vol_id = 1, + name, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + default_records = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + + assertthat::assert_that(is.character(name), length(name) == 1) + assertthat::assert_that(nzchar(trimws(name)), msg = "name must not be empty") + + if (!is.null(release_level)) { + assertthat::assert_that( + is.character(release_level), + length(release_level) == 1, + nzchar(trimws(release_level)) + ) + } + + assertthat::assert_that( + is.null(source_date) || is.null(date), + msg = "Provide either source_date or date, not both." + ) + + if (!is.null(date)) { + assertthat::assert_that( + is.list(date), + !is.null(names(date)), + msg = "date must be a named list (e.g. list(year=, month=, day=))" + ) + } + + if (!is.null(date_precision)) { + assertthat::assert_that( + is.character(date_precision), + length(date_precision) == 1, + nzchar(trimws(date_precision)) + ) + } + + if (!is.null(default_records)) { + assertthat::assert_that( + is.numeric(default_records), + length(default_records) >= 1, + all(default_records >= 1), + all(default_records == floor(default_records)), + msg = "default_records must be a vector of positive integers" + ) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list(name = name) + + if (!is.null(release_level)) { + body$release_level <- release_level + } + if (!is.null(source_date)) { + body$source_date <- coerce_iso_date(source_date, "source_date") + } + if (!is.null(date)) { + body$date <- date + } + if (!is.null(date_precision)) { + body$date_precision <- date_precision + } + if (!is.null(default_records)) { + body$default_records <- as.list(as.integer(default_records)) + } + + session <- perform_api_post( + path = sprintf(API_VOLUME_SESSIONS, vol_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(session)) { + if (vb) { + message("Failed to create session in volume ", vol_id) + } + return(NULL) + } + + session +} diff --git a/tests/testthat/test-create_session.R b/tests/testthat/test-create_session.R new file mode 100644 index 00000000..0c5a0149 --- /dev/null +++ b/tests/testthat/test-create_session.R @@ -0,0 +1,171 @@ +# create_session() ------------------------------------------------------------- +login_test_account() + +test_that("create_session creates a session with name only", { + result <- create_session(vol_id = 1777, name = "Test session", vb = FALSE) + skip_if_null_response(result, "create_session(vol_id = 1777, name = 'Test session')") + + if (!is.null(result$id)) { + delete_session(vol_id = 1777, session_id = result$id, vb = FALSE) + } + + expect_type(result, "list") + expect_true(!is.null(result$id)) + expect_true(is.numeric(result$id) || is.integer(result$id)) + expect_true(result$id > 0) + expect_equal(as.integer(result$volume), 1777L) + expect_equal(result$name, "Test session") +}) + +test_that("create_session accepts a Date source_date", { + result <- create_session( + vol_id = 1777, + name = "Test session with Date", + source_date = as.Date("2024-03-15"), + vb = FALSE + ) + skip_if_null_response(result, "create_session with Date source_date") + + if (!is.null(result$id)) { + delete_session(vol_id = 1777, session_id = result$id, vb = FALSE) + } + + expect_type(result, "list") + expect_true(!is.null(result$id)) +}) + +test_that("create_session accepts an ISO string source_date", { + result <- create_session( + vol_id = 1777, + name = "Test session with ISO date", + source_date = "2024-03-15", + vb = FALSE + ) + skip_if_null_response(result, "create_session with ISO source_date") + + if (!is.null(result$id)) { + delete_session(vol_id = 1777, session_id = result$id, vb = FALSE) + } + + expect_type(result, "list") +}) + +test_that("create_session works with verbose mode", { + result <- create_session( + vol_id = 1777, + name = "Test session vb", + vb = TRUE + ) + skip_if_null_response(result, "create_session with vb = TRUE") + + if (!is.null(result$id)) { + delete_session(vol_id = 1777, session_id = result$id, vb = FALSE) + } + + expect_type(result, "list") +}) + +test_that("create_session works with custom request object", { + custom_rq <- databraryr::make_default_request() + result <- create_session( + vol_id = 1777, + name = "Test session custom rq", + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "create_session with custom_rq") + + if (!is.null(result$id)) { + delete_session(vol_id = 1777, session_id = result$id, vb = FALSE) + } + + expect_type(result, "list") +}) + +test_that("create_session returns NULL for non-existent volume", { + expect_null(create_session(vol_id = 999999999, name = "Test", vb = FALSE)) +}) + +test_that("create_session rejects invalid name", { + expect_error(create_session(vol_id = 1777, name = "")) + expect_error(create_session(vol_id = 1777, name = " ")) + expect_error(create_session(vol_id = 1777, name = 123)) + expect_error(create_session(vol_id = 1777, name = c("A", "B"))) + expect_error(create_session(vol_id = 1777, name = NULL)) + expect_error(create_session(vol_id = 1777, name = NA)) +}) + +test_that("create_session rejects providing both source_date and date", { + expect_error( + create_session( + vol_id = 1777, + name = "Test", + source_date = "2024-03-15", + date = list(year = 2024, month = 3, day = 15) + ) + ) +}) + +test_that("create_session rejects malformed source_date", { + expect_error(create_session(vol_id = 1777, name = "Test", source_date = "not-a-date")) + expect_error(create_session(vol_id = 1777, name = "Test", source_date = "")) + expect_error(create_session(vol_id = 1777, name = "Test", source_date = 123)) + expect_error( + create_session( + vol_id = 1777, + name = "Test", + source_date = as.Date(c("2024-01-01", "2024-02-01")) + ) + ) +}) + +test_that("create_session rejects malformed date list", { + expect_error(create_session(vol_id = 1777, name = "Test", date = "2024-03-15")) + expect_error(create_session(vol_id = 1777, name = "Test", date = list(2024, 3, 15))) +}) + +test_that("create_session rejects invalid release_level", { + expect_error(create_session(vol_id = 1777, name = "Test", release_level = "")) + expect_error(create_session(vol_id = 1777, name = "Test", release_level = 1)) + expect_error(create_session(vol_id = 1777, name = "Test", release_level = c("A", "B"))) +}) + +test_that("create_session rejects invalid date_precision", { + expect_error(create_session(vol_id = 1777, name = "Test", date_precision = "")) + expect_error(create_session(vol_id = 1777, name = "Test", date_precision = 1)) + expect_error(create_session(vol_id = 1777, name = "Test", date_precision = c("FULL", "YEAR"))) +}) + +test_that("create_session rejects invalid default_records", { + expect_error(create_session(vol_id = 1777, name = "Test", default_records = "1")) + expect_error(create_session(vol_id = 1777, name = "Test", default_records = c(1, -2))) + expect_error(create_session(vol_id = 1777, name = "Test", default_records = c(1, 0))) + expect_error(create_session(vol_id = 1777, name = "Test", default_records = c(1.5, 2))) + expect_error(create_session(vol_id = 1777, name = "Test", default_records = integer(0))) +}) + +test_that("create_session rejects invalid vol_id", { + expect_error(create_session(vol_id = -1, name = "Test")) + expect_error(create_session(vol_id = 0, name = "Test")) + expect_error(create_session(vol_id = "1", name = "Test")) + expect_error(create_session(vol_id = TRUE, name = "Test")) + expect_error(create_session(vol_id = list(a = 1), name = "Test")) + expect_error(create_session(vol_id = c(1, 2), name = "Test")) + expect_error(create_session(vol_id = 1.5, name = "Test")) +}) + +test_that("create_session rejects invalid vb parameter", { + expect_error(create_session(vol_id = 1777, name = "Test", vb = -1)) + expect_error(create_session(vol_id = 1777, name = "Test", vb = "a")) + expect_error(create_session(vol_id = 1777, name = "Test", vb = list(a = 1))) + expect_error(create_session(vol_id = 1777, name = "Test", vb = c(TRUE, FALSE))) + expect_error(create_session(vol_id = 1777, name = "Test", vb = NULL)) +}) + +test_that("create_session rejects invalid rq parameter", { + expect_error(create_session(vol_id = 1777, name = "Test", rq = "a")) + expect_error(create_session(vol_id = 1777, name = "Test", rq = -1)) + expect_error(create_session(vol_id = 1777, name = "Test", rq = c(2, 3))) + expect_error(create_session(vol_id = 1777, name = "Test", rq = list(a = 1))) + expect_error(create_session(vol_id = 1777, name = "Test", rq = TRUE)) +}) diff --git a/tests/testthat/test-delete_session.R b/tests/testthat/test-delete_session.R index 6053ba11..ab53d058 100644 --- a/tests/testthat/test-delete_session.R +++ b/tests/testthat/test-delete_session.R @@ -1,20 +1,9 @@ # delete_session() ------------------------------------------------------------- login_test_account() -# Internal helper: create a session directly via the API for roundtrip tests. -# Not using create_session() yet to keep this block self-contained; switch -# once create_session() lands. -create_session_for_test <- function(vol_id = 1777, name = "delete_session test") { - databraryr:::perform_api_post( - path = sprintf(databraryr:::API_VOLUME_SESSIONS, vol_id), - body = list(name = name), - vb = FALSE - ) -} - test_that("delete_session deletes an existing session", { - created <- create_session_for_test(name = "delete_session happy path") - skip_if_null_response(created, "create session for delete_session happy path") + created <- create_session(vol_id = 1777, name = "delete_session happy path", vb = FALSE) + skip_if_null_response(created, "create_session for delete_session happy path") session_id <- created$id result <- delete_session(vol_id = 1777, session_id = session_id, vb = FALSE) @@ -30,15 +19,19 @@ test_that("delete_session returns FALSE for non-existent session", { }) test_that("delete_session works with verbose mode", { - created <- create_session_for_test(name = "delete_session vb") - skip_if_null_response(created, "create session for delete_session vb") + created <- create_session(vol_id = 1777, name = "delete_session vb", vb = FALSE) + skip_if_null_response(created, "create_session for delete_session vb") expect_true(delete_session(vol_id = 1777, session_id = created$id, vb = TRUE)) }) test_that("delete_session works with custom request object", { - created <- create_session_for_test(name = "delete_session custom rq") - skip_if_null_response(created, "create session for delete_session custom rq") + created <- create_session( + vol_id = 1777, + name = "delete_session custom rq", + vb = FALSE + ) + skip_if_null_response(created, "create_session for delete_session custom rq") custom_rq <- databraryr::make_default_request() expect_true( From 744d09b50dbf9730cd5e9d3ad2b5612b80dd0162 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Fri, 8 May 2026 14:32:39 +0200 Subject: [PATCH 51/77] feat: add patch_session() --- R/patch_session.R | 159 ++++++++++++++++++++++++++ tests/testthat/test-patch_session.R | 169 ++++++++++++++++++++++++++++ 2 files changed, 328 insertions(+) create mode 100644 R/patch_session.R create mode 100644 tests/testthat/test-patch_session.R diff --git a/R/patch_session.R b/R/patch_session.R new file mode 100644 index 00000000..76915d2a --- /dev/null +++ b/R/patch_session.R @@ -0,0 +1,159 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Partially Update a Session in Databrary Volume +#' +#' @description Sends a PATCH request to update selected fields of an existing +#' session. Only provided arguments are sent; omitted fields are left +#' unchanged on the server. Note that \code{default_records} is a full +#' replacement on the server -- supplying it overwrites the entire current set +#' of defaults; omit it to keep them. To change just one default record use +#' \code{\link{add_default_record_to_session}} or +#' \code{\link{remove_default_record_from_session}}. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param name Optional new session name. If provided, must be a non-empty +#' length-1 string. +#' @param release_level Optional release level (e.g. \code{"PRIVATE"}, +#' \code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). Server validates +#' the choice. +#' @param source_date Optional session date. A length-1 \code{Date} object or +#' ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}. +#' @param date Optional structured date list with named fields \code{year}, +#' \code{month}, \code{day}, and optional \code{is_estimated} (logical). +#' Mutually exclusive with \code{source_date}. +#' @param date_precision Optional precision for \code{date}: e.g. +#' \code{"FULL"}, \code{"YEAR"}. +#' @param default_records Optional integer vector of record IDs. The server +#' replaces the session's current default records with this set. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the updated session's metadata (same shape as +#' \code{\link{get_session_by_id}}), or \code{NULL} if the update fails or +#' no fields were provided. +#' +#' @seealso \code{\link{update_session}}, \code{\link{create_session}}, +#' \code{\link{add_default_record_to_session}}, +#' \code{\link{remove_default_record_from_session}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Rename a session +#' patch_session(vol_id = 1, session_id = 42, name = "Renamed session") +#' +#' # Update the date and precision +#' patch_session( +#' vol_id = 1, +#' session_id = 42, +#' date = list(year = 2024, month = 3, day = 15), +#' date_precision = "FULL" +#' ) +#' } +#' } +#' @export +patch_session <- function( + vol_id = 1, + session_id, + name = NULL, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + default_records = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + + if (!is.null(name)) { + assertthat::assert_that(is.character(name), length(name) == 1) + assertthat::assert_that( + nzchar(trimws(name)), + msg = "name must not be empty" + ) + } + + if (!is.null(release_level)) { + assertthat::assert_that( + is.character(release_level), + length(release_level) == 1, + nzchar(trimws(release_level)) + ) + } + + assertthat::assert_that( + is.null(source_date) || is.null(date), + msg = "Provide either source_date or date, not both." + ) + + if (!is.null(date)) { + assertthat::assert_that( + is.list(date), + !is.null(names(date)), + msg = "date must be a named list (e.g. list(year=, month=, day=))" + ) + } + + if (!is.null(date_precision)) { + assertthat::assert_that( + is.character(date_precision), + length(date_precision) == 1, + nzchar(trimws(date_precision)) + ) + } + + if (!is.null(default_records)) { + assertthat::assert_that( + is.numeric(default_records), + length(default_records) >= 1, + all(default_records >= 1), + all(default_records == floor(default_records)), + msg = "default_records must be a vector of positive integers" + ) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list() + if (!is.null(name)) body$name <- name + if (!is.null(release_level)) body$release_level <- release_level + if (!is.null(source_date)) body$source_date <- coerce_iso_date(source_date, "source_date") + if (!is.null(date)) body$date <- date + if (!is.null(date_precision)) body$date_precision <- date_precision + if (!is.null(default_records)) { + body$default_records <- as.list(as.integer(default_records)) + } + + if (length(body) == 0) { + if (vb) { + message("No fields provided to update for session ", session_id) + } + return(NULL) + } + + session <- perform_api_patch( + path = sprintf(API_SESSION_DETAIL, vol_id, session_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(session)) { + if (vb) { + message( + "Failed to update session ", session_id, " in volume ", vol_id + ) + } + return(NULL) + } + + session +} diff --git a/tests/testthat/test-patch_session.R b/tests/testthat/test-patch_session.R new file mode 100644 index 00000000..19305531 --- /dev/null +++ b/tests/testthat/test-patch_session.R @@ -0,0 +1,169 @@ +# patch_session() -------------------------------------------------------------- +login_test_account() + +# Roundtrip helper: create a fresh session for each test, return its id. +new_session_id <- function(name = "patch_session test") { + created <- create_session(vol_id = 1777, name = name, vb = FALSE) + if (is.null(created)) { + return(NULL) + } + created$id +} + +test_that("patch_session updates name", { + sid <- new_session_id("patch_session original") + skip_if_null_response(sid, "create_session for patch_session name test") + on.exit(delete_session(vol_id = 1777, session_id = sid, vb = FALSE), add = TRUE) + + result <- patch_session( + vol_id = 1777, + session_id = sid, + name = "patch_session renamed", + vb = FALSE + ) + skip_if_null_response(result, "patch_session(name=...)") + + expect_type(result, "list") + expect_equal(result$name, "patch_session renamed") + expect_equal(as.integer(result$id), as.integer(sid)) +}) + +test_that("patch_session updates source_date with a Date object", { + sid <- new_session_id("patch_session source_date Date") + skip_if_null_response(sid, "create_session for patch_session source_date Date") + on.exit(delete_session(vol_id = 1777, session_id = sid, vb = FALSE), add = TRUE) + + result <- patch_session( + vol_id = 1777, + session_id = sid, + source_date = as.Date("2024-03-15"), + vb = FALSE + ) + skip_if_null_response(result, "patch_session(source_date=Date)") + expect_type(result, "list") +}) + +test_that("patch_session returns NULL when no fields provided", { + expect_null(patch_session(vol_id = 1777, session_id = 1, vb = FALSE)) +}) + +test_that("patch_session returns NULL for non-existent session", { + result <- patch_session( + vol_id = 1777, + session_id = 999999999, + name = "nope", + vb = FALSE + ) + expect_null(result) +}) + +test_that("patch_session works with verbose mode", { + sid <- new_session_id("patch_session vb") + skip_if_null_response(sid, "create_session for patch_session vb") + on.exit(delete_session(vol_id = 1777, session_id = sid, vb = FALSE), add = TRUE) + + result <- patch_session( + vol_id = 1777, + session_id = sid, + name = "patch_session vb renamed", + vb = TRUE + ) + skip_if_null_response(result, "patch_session vb") + expect_type(result, "list") +}) + +test_that("patch_session works with custom request object", { + sid <- new_session_id("patch_session custom rq") + skip_if_null_response(sid, "create_session for patch_session custom rq") + on.exit(delete_session(vol_id = 1777, session_id = sid, vb = FALSE), add = TRUE) + + custom_rq <- databraryr::make_default_request() + result <- patch_session( + vol_id = 1777, + session_id = sid, + name = "patch_session custom rq renamed", + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "patch_session custom rq") + expect_type(result, "list") +}) + +test_that("patch_session rejects invalid name", { + expect_error(patch_session(vol_id = 1777, session_id = 1, name = "")) + expect_error(patch_session(vol_id = 1777, session_id = 1, name = " ")) + expect_error(patch_session(vol_id = 1777, session_id = 1, name = 123)) + expect_error(patch_session(vol_id = 1777, session_id = 1, name = c("A", "B"))) +}) + +test_that("patch_session rejects providing both source_date and date", { + expect_error( + patch_session( + vol_id = 1777, + session_id = 1, + source_date = "2024-03-15", + date = list(year = 2024, month = 3, day = 15) + ) + ) +}) + +test_that("patch_session rejects malformed source_date", { + expect_error(patch_session(vol_id = 1777, session_id = 1, source_date = "not-a-date")) + expect_error(patch_session(vol_id = 1777, session_id = 1, source_date = "")) + expect_error(patch_session(vol_id = 1777, session_id = 1, source_date = 123)) +}) + +test_that("patch_session rejects malformed date", { + expect_error(patch_session(vol_id = 1777, session_id = 1, date = "2024-03-15")) + expect_error(patch_session(vol_id = 1777, session_id = 1, date = list(2024, 3, 15))) +}) + +test_that("patch_session rejects invalid release_level", { + expect_error(patch_session(vol_id = 1777, session_id = 1, release_level = "")) + expect_error(patch_session(vol_id = 1777, session_id = 1, release_level = 1)) + expect_error(patch_session(vol_id = 1777, session_id = 1, release_level = c("A", "B"))) +}) + +test_that("patch_session rejects invalid date_precision", { + expect_error(patch_session(vol_id = 1777, session_id = 1, date_precision = "")) + expect_error(patch_session(vol_id = 1777, session_id = 1, date_precision = 1)) +}) + +test_that("patch_session rejects invalid default_records", { + expect_error(patch_session(vol_id = 1777, session_id = 1, default_records = "1")) + expect_error(patch_session(vol_id = 1777, session_id = 1, default_records = c(1, -2))) + expect_error(patch_session(vol_id = 1777, session_id = 1, default_records = c(1, 0))) + expect_error(patch_session(vol_id = 1777, session_id = 1, default_records = c(1.5, 2))) + expect_error(patch_session(vol_id = 1777, session_id = 1, default_records = integer(0))) +}) + +test_that("patch_session rejects invalid vol_id", { + expect_error(patch_session(vol_id = -1, session_id = 1, name = "x")) + expect_error(patch_session(vol_id = 0, session_id = 1, name = "x")) + expect_error(patch_session(vol_id = "1", session_id = 1, name = "x")) + expect_error(patch_session(vol_id = TRUE, session_id = 1, name = "x")) + expect_error(patch_session(vol_id = c(1, 2), session_id = 1, name = "x")) + expect_error(patch_session(vol_id = 1.5, session_id = 1, name = "x")) +}) + +test_that("patch_session rejects invalid session_id", { + expect_error(patch_session(vol_id = 1777, session_id = -1, name = "x")) + expect_error(patch_session(vol_id = 1777, session_id = 0, name = "x")) + expect_error(patch_session(vol_id = 1777, session_id = "1", name = "x")) + expect_error(patch_session(vol_id = 1777, session_id = TRUE, name = "x")) + expect_error(patch_session(vol_id = 1777, session_id = c(1, 2), name = "x")) + expect_error(patch_session(vol_id = 1777, session_id = 1.5, name = "x")) +}) + +test_that("patch_session rejects invalid vb parameter", { + expect_error(patch_session(vol_id = 1777, session_id = 1, name = "x", vb = -1)) + expect_error(patch_session(vol_id = 1777, session_id = 1, name = "x", vb = "a")) + expect_error(patch_session(vol_id = 1777, session_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(patch_session(vol_id = 1777, session_id = 1, name = "x", vb = NULL)) +}) + +test_that("patch_session rejects invalid rq parameter", { + expect_error(patch_session(vol_id = 1777, session_id = 1, name = "x", rq = "a")) + expect_error(patch_session(vol_id = 1777, session_id = 1, name = "x", rq = -1)) + expect_error(patch_session(vol_id = 1777, session_id = 1, name = "x", rq = TRUE)) +}) From f95cea7f607baeed37a2c6013725cb65cbe5afac Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Fri, 8 May 2026 14:34:33 +0200 Subject: [PATCH 52/77] feat: add update_session() --- R/update_session.R | 132 +++++++++++++++++++++ tests/testthat/test-update_session.R | 168 +++++++++++++++++++++++++++ 2 files changed, 300 insertions(+) create mode 100644 R/update_session.R create mode 100644 tests/testthat/test-update_session.R diff --git a/R/update_session.R b/R/update_session.R new file mode 100644 index 00000000..c5461dc9 --- /dev/null +++ b/R/update_session.R @@ -0,0 +1,132 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Replace a Session in Databrary Volume (PUT) +#' +#' @description Sends a PUT request to fully replace a session's writable +#' fields. \code{name} is required (non-empty); other fields are optional and +#' default to server-side values when omitted (the underlying serializer +#' marks them \code{required=FALSE}). Use \code{\link{patch_session}} for +#' partial updates when you don't want full-replacement semantics. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param name New session name. Required, non-empty after trim. +#' @param release_level Optional release level (e.g. \code{"PRIVATE"}, +#' \code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). +#' @param source_date Optional session date. A length-1 \code{Date} object or +#' ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}. +#' @param date Optional structured date list with named fields \code{year}, +#' \code{month}, \code{day}, and optional \code{is_estimated} (logical). +#' Mutually exclusive with \code{source_date}. +#' @param date_precision Optional precision for \code{date}: e.g. +#' \code{"FULL"}, \code{"YEAR"}. +#' @param default_records Optional integer vector of record IDs. The server +#' replaces the session's current default records with this set; omit to +#' leave them unchanged. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the updated session's metadata (same shape as +#' \code{\link{get_session_by_id}}), or \code{NULL} if the update fails. +#' +#' @seealso \code{\link{patch_session}}, \code{\link{create_session}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Rename a session via PUT +#' update_session(vol_id = 1, session_id = 42, name = "Replacement name") +#' } +#' } +#' @export +update_session <- function( + vol_id = 1, + session_id, + name, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + default_records = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + + assertthat::assert_that(is.character(name), length(name) == 1) + assertthat::assert_that(nzchar(trimws(name)), msg = "name must not be empty") + + if (!is.null(release_level)) { + assertthat::assert_that( + is.character(release_level), + length(release_level) == 1, + nzchar(trimws(release_level)) + ) + } + + assertthat::assert_that( + is.null(source_date) || is.null(date), + msg = "Provide either source_date or date, not both." + ) + + if (!is.null(date)) { + assertthat::assert_that( + is.list(date), + !is.null(names(date)), + msg = "date must be a named list (e.g. list(year=, month=, day=))" + ) + } + + if (!is.null(date_precision)) { + assertthat::assert_that( + is.character(date_precision), + length(date_precision) == 1, + nzchar(trimws(date_precision)) + ) + } + + if (!is.null(default_records)) { + assertthat::assert_that( + is.numeric(default_records), + length(default_records) >= 1, + all(default_records >= 1), + all(default_records == floor(default_records)), + msg = "default_records must be a vector of positive integers" + ) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list(name = name) + if (!is.null(release_level)) body$release_level <- release_level + if (!is.null(source_date)) body$source_date <- coerce_iso_date(source_date, "source_date") + if (!is.null(date)) body$date <- date + if (!is.null(date_precision)) body$date_precision <- date_precision + if (!is.null(default_records)) { + body$default_records <- as.list(as.integer(default_records)) + } + + session <- perform_api_put( + path = sprintf(API_SESSION_DETAIL, vol_id, session_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(session)) { + if (vb) { + message( + "Failed to replace session ", session_id, " in volume ", vol_id + ) + } + return(NULL) + } + + session +} diff --git a/tests/testthat/test-update_session.R b/tests/testthat/test-update_session.R new file mode 100644 index 00000000..7b255933 --- /dev/null +++ b/tests/testthat/test-update_session.R @@ -0,0 +1,168 @@ +# update_session() ------------------------------------------------------------- +login_test_account() + +new_session_id <- function(name = "update_session test") { + created <- create_session(vol_id = 1777, name = name, vb = FALSE) + if (is.null(created)) { + return(NULL) + } + created$id +} + +test_that("update_session replaces name via PUT", { + sid <- new_session_id("update_session original") + skip_if_null_response(sid, "create_session for update_session name test") + on.exit(delete_session(vol_id = 1777, session_id = sid, vb = FALSE), add = TRUE) + + result <- update_session( + vol_id = 1777, + session_id = sid, + name = "update_session replaced", + vb = FALSE + ) + skip_if_null_response(result, "update_session(name=...)") + + expect_type(result, "list") + expect_equal(result$name, "update_session replaced") + expect_equal(as.integer(result$id), as.integer(sid)) +}) + +test_that("update_session replaces source_date with a Date object", { + sid <- new_session_id("update_session source_date Date") + skip_if_null_response(sid, "create_session for update_session source_date Date") + on.exit(delete_session(vol_id = 1777, session_id = sid, vb = FALSE), add = TRUE) + + result <- update_session( + vol_id = 1777, + session_id = sid, + name = "update_session source_date Date", + source_date = as.Date("2024-03-15"), + vb = FALSE + ) + skip_if_null_response(result, "update_session(source_date=Date)") + expect_type(result, "list") +}) + +test_that("update_session returns NULL for non-existent session", { + result <- update_session( + vol_id = 1777, + session_id = 999999999, + name = "nope", + vb = FALSE + ) + expect_null(result) +}) + +test_that("update_session works with verbose mode", { + sid <- new_session_id("update_session vb") + skip_if_null_response(sid, "create_session for update_session vb") + on.exit(delete_session(vol_id = 1777, session_id = sid, vb = FALSE), add = TRUE) + + result <- update_session( + vol_id = 1777, + session_id = sid, + name = "update_session vb replaced", + vb = TRUE + ) + skip_if_null_response(result, "update_session vb") + expect_type(result, "list") +}) + +test_that("update_session works with custom request object", { + sid <- new_session_id("update_session custom rq") + skip_if_null_response(sid, "create_session for update_session custom rq") + on.exit(delete_session(vol_id = 1777, session_id = sid, vb = FALSE), add = TRUE) + + custom_rq <- databraryr::make_default_request() + result <- update_session( + vol_id = 1777, + session_id = sid, + name = "update_session custom rq replaced", + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "update_session custom rq") + expect_type(result, "list") +}) + +test_that("update_session rejects missing/invalid name", { + expect_error(update_session(vol_id = 1777, session_id = 1)) + expect_error(update_session(vol_id = 1777, session_id = 1, name = "")) + expect_error(update_session(vol_id = 1777, session_id = 1, name = " ")) + expect_error(update_session(vol_id = 1777, session_id = 1, name = 123)) + expect_error(update_session(vol_id = 1777, session_id = 1, name = c("A", "B"))) + expect_error(update_session(vol_id = 1777, session_id = 1, name = NULL)) + expect_error(update_session(vol_id = 1777, session_id = 1, name = NA)) +}) + +test_that("update_session rejects providing both source_date and date", { + expect_error( + update_session( + vol_id = 1777, + session_id = 1, + name = "x", + source_date = "2024-03-15", + date = list(year = 2024, month = 3, day = 15) + ) + ) +}) + +test_that("update_session rejects malformed source_date", { + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", source_date = "not-a-date")) + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", source_date = "")) + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", source_date = 123)) +}) + +test_that("update_session rejects malformed date", { + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", date = "2024-03-15")) + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", date = list(2024, 3, 15))) +}) + +test_that("update_session rejects invalid release_level", { + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", release_level = "")) + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", release_level = 1)) +}) + +test_that("update_session rejects invalid date_precision", { + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", date_precision = "")) + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", date_precision = 1)) +}) + +test_that("update_session rejects invalid default_records", { + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", default_records = "1")) + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", default_records = c(1, -2))) + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", default_records = c(1, 0))) + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", default_records = c(1.5, 2))) + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", default_records = integer(0))) +}) + +test_that("update_session rejects invalid vol_id", { + expect_error(update_session(vol_id = -1, session_id = 1, name = "x")) + expect_error(update_session(vol_id = 0, session_id = 1, name = "x")) + expect_error(update_session(vol_id = "1", session_id = 1, name = "x")) + expect_error(update_session(vol_id = TRUE, session_id = 1, name = "x")) + expect_error(update_session(vol_id = c(1, 2), session_id = 1, name = "x")) + expect_error(update_session(vol_id = 1.5, session_id = 1, name = "x")) +}) + +test_that("update_session rejects invalid session_id", { + expect_error(update_session(vol_id = 1777, session_id = -1, name = "x")) + expect_error(update_session(vol_id = 1777, session_id = 0, name = "x")) + expect_error(update_session(vol_id = 1777, session_id = "1", name = "x")) + expect_error(update_session(vol_id = 1777, session_id = TRUE, name = "x")) + expect_error(update_session(vol_id = 1777, session_id = c(1, 2), name = "x")) + expect_error(update_session(vol_id = 1777, session_id = 1.5, name = "x")) +}) + +test_that("update_session rejects invalid vb parameter", { + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", vb = -1)) + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", vb = "a")) + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", vb = NULL)) +}) + +test_that("update_session rejects invalid rq parameter", { + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", rq = "a")) + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", rq = -1)) + expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", rq = TRUE)) +}) From b40c616174c3c63207ff02d15dcf362eaf16d9ce Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Fri, 8 May 2026 14:38:59 +0200 Subject: [PATCH 53/77] feat: add add_default_record_to_session() --- R/add_default_record_to_session.R | 63 ++++++ .../test-add_default_record_to_session.R | 180 ++++++++++++++++++ 2 files changed, 243 insertions(+) create mode 100644 R/add_default_record_to_session.R create mode 100644 tests/testthat/test-add_default_record_to_session.R diff --git a/R/add_default_record_to_session.R b/R/add_default_record_to_session.R new file mode 100644 index 00000000..97b87eaf --- /dev/null +++ b/R/add_default_record_to_session.R @@ -0,0 +1,63 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Add a Default Record to a Session +#' +#' @description Attach a record to a session as a default record. Default +#' records apply to all files in the session unless overridden. The record +#' must either belong to the destination volume or be accessible to it via a +#' linked volume; the server enforces this and returns \code{403} otherwise. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} if the record was successfully added, \code{FALSE} +#' otherwise. +#' +#' @seealso \code{\link{remove_default_record_from_session}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' add_default_record_to_session(vol_id = 1, session_id = 42, record_id = 101) +#' } +#' } +#' @export +add_default_record_to_session <- function( + vol_id = 1, + session_id, + record_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer(record_id, "record_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + result <- perform_api_post( + path = sprintf(API_SESSION_ADD_DEFAULT_RECORD, vol_id, session_id), + body = list(record_id = record_id), + rq = rq, + vb = vb + ) + + if (is.null(result)) { + if (vb) { + message( + "Failed to add default record ", record_id, + " to session ", session_id, " in volume ", vol_id + ) + } + return(FALSE) + } + + TRUE +} diff --git a/tests/testthat/test-add_default_record_to_session.R b/tests/testthat/test-add_default_record_to_session.R new file mode 100644 index 00000000..c74930ac --- /dev/null +++ b/tests/testthat/test-add_default_record_to_session.R @@ -0,0 +1,180 @@ +# add_default_record_to_session() ---------------------------------------------- +login_test_account() + +# Sandbox volume 1777, category 6 ("task") is used elsewhere for record tests. +TEST_VOL <- 1777 +TEST_CATEGORY <- 6 + +new_session_id <- function(name = "add_default_record test") { + created <- create_session(vol_id = TEST_VOL, name = name, vb = FALSE) + if (is.null(created)) { + return(NULL) + } + created$id +} + +new_record_id <- function(name = "add_default_record test record") { + created <- create_volume_record( + vol_id = TEST_VOL, + category_id = TEST_CATEGORY, + name = name, + vb = FALSE + ) + if (is.null(created)) { + return(NULL) + } + created$record_id +} + +test_that("add_default_record_to_session attaches a record", { + sid <- new_session_id("add_default_record happy path") + skip_if_null_response(sid, "create_session for add_default_record happy path") + on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) + + rid <- new_record_id("add_default_record happy path record") + skip_if_null_response(rid, "create_volume_record for add_default_record happy path") + on.exit( + delete_volume_record(vol_id = TEST_VOL, record_id = rid, vb = FALSE), + add = TRUE + ) + + result <- add_default_record_to_session( + vol_id = TEST_VOL, + session_id = sid, + record_id = rid, + vb = FALSE + ) + expect_true(result) + + # Verify it shows up among the session's default_records + session <- get_session_by_id( + vol_id = TEST_VOL, + session_id = sid, + vb = FALSE + ) + default_ids <- vapply( + session$default_records, + function(r) as.integer(r$id), + integer(1) + ) + expect_true(as.integer(rid) %in% default_ids) +}) + +test_that("add_default_record_to_session returns FALSE for non-existent record", { + sid <- new_session_id("add_default_record non-existent record") + skip_if_null_response(sid, "create_session for non-existent record test") + on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) + + expect_false( + add_default_record_to_session( + vol_id = TEST_VOL, + session_id = sid, + record_id = 999999999, + vb = FALSE + ) + ) +}) + +test_that("add_default_record_to_session returns FALSE for non-existent session", { + rid <- new_record_id("add_default_record non-existent session record") + skip_if_null_response(rid, "create_volume_record for non-existent session test") + on.exit( + delete_volume_record(vol_id = TEST_VOL, record_id = rid, vb = FALSE), + add = TRUE + ) + + expect_false( + add_default_record_to_session( + vol_id = TEST_VOL, + session_id = 999999999, + record_id = rid, + vb = FALSE + ) + ) +}) + +test_that("add_default_record_to_session works with verbose mode", { + sid <- new_session_id("add_default_record vb") + skip_if_null_response(sid, "create_session for add_default_record vb") + on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) + + rid <- new_record_id("add_default_record vb record") + skip_if_null_response(rid, "create_volume_record for add_default_record vb") + on.exit( + delete_volume_record(vol_id = TEST_VOL, record_id = rid, vb = FALSE), + add = TRUE + ) + + expect_true( + add_default_record_to_session( + vol_id = TEST_VOL, + session_id = sid, + record_id = rid, + vb = TRUE + ) + ) +}) + +test_that("add_default_record_to_session works with custom request object", { + sid <- new_session_id("add_default_record custom rq") + skip_if_null_response(sid, "create_session for add_default_record custom rq") + on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) + + rid <- new_record_id("add_default_record custom rq record") + skip_if_null_response(rid, "create_volume_record for add_default_record custom rq") + on.exit( + delete_volume_record(vol_id = TEST_VOL, record_id = rid, vb = FALSE), + add = TRUE + ) + + custom_rq <- databraryr::make_default_request() + expect_true( + add_default_record_to_session( + vol_id = TEST_VOL, + session_id = sid, + record_id = rid, + rq = custom_rq, + vb = FALSE + ) + ) +}) + +test_that("add_default_record_to_session rejects invalid vol_id", { + expect_error(add_default_record_to_session(vol_id = -1, session_id = 1, record_id = 1)) + expect_error(add_default_record_to_session(vol_id = 0, session_id = 1, record_id = 1)) + expect_error(add_default_record_to_session(vol_id = "1", session_id = 1, record_id = 1)) + expect_error(add_default_record_to_session(vol_id = TRUE, session_id = 1, record_id = 1)) + expect_error(add_default_record_to_session(vol_id = c(1, 2), session_id = 1, record_id = 1)) + expect_error(add_default_record_to_session(vol_id = 1.5, session_id = 1, record_id = 1)) +}) + +test_that("add_default_record_to_session rejects invalid session_id", { + expect_error(add_default_record_to_session(vol_id = 1, session_id = -1, record_id = 1)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 0, record_id = 1)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = "1", record_id = 1)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = TRUE, record_id = 1)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = c(1, 2), record_id = 1)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1.5, record_id = 1)) +}) + +test_that("add_default_record_to_session rejects invalid record_id", { + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = -1)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 0)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = "1")) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = TRUE)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = c(1, 2))) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 1.5)) +}) + +test_that("add_default_record_to_session rejects invalid vb parameter", { + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 1, vb = -1)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 1, vb = "a")) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 1, vb = NULL)) +}) + +test_that("add_default_record_to_session rejects invalid rq parameter", { + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 1, rq = "a")) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 1, rq = -1)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 1, rq = TRUE)) +}) From 032f45ed9df9055e990caba242c8f67caa4e86ca Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Fri, 8 May 2026 14:46:44 +0200 Subject: [PATCH 54/77] feat: add remove_default_record_from_session() --- R/remove_default_record_from_session.R | 62 +++++ .../test-remove_default_record_from_session.R | 221 ++++++++++++++++++ 2 files changed, 283 insertions(+) create mode 100644 R/remove_default_record_from_session.R create mode 100644 tests/testthat/test-remove_default_record_from_session.R diff --git a/R/remove_default_record_from_session.R b/R/remove_default_record_from_session.R new file mode 100644 index 00000000..64290c48 --- /dev/null +++ b/R/remove_default_record_from_session.R @@ -0,0 +1,62 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Remove a Default Record from a Session +#' +#' @description Detach a record from a session's default records. The record +#' must currently be a default record on the session, otherwise the server +#' returns \code{404}. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} if the record was successfully removed, \code{FALSE} +#' otherwise. +#' +#' @seealso \code{\link{add_default_record_to_session}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' remove_default_record_from_session(vol_id = 1, session_id = 42, record_id = 101) +#' } +#' } +#' @export +remove_default_record_from_session <- function( + vol_id = 1, + session_id, + record_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer(record_id, "record_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + result <- perform_api_post( + path = sprintf(API_SESSION_REMOVE_DEFAULT_RECORD, vol_id, session_id), + body = list(record_id = record_id), + rq = rq, + vb = vb + ) + + if (is.null(result)) { + if (vb) { + message( + "Failed to remove default record ", record_id, + " from session ", session_id, " in volume ", vol_id + ) + } + return(FALSE) + } + + TRUE +} diff --git a/tests/testthat/test-remove_default_record_from_session.R b/tests/testthat/test-remove_default_record_from_session.R new file mode 100644 index 00000000..46db8e1e --- /dev/null +++ b/tests/testthat/test-remove_default_record_from_session.R @@ -0,0 +1,221 @@ +# remove_default_record_from_session() ----------------------------------------- +login_test_account() + +TEST_VOL <- 1777 +TEST_CATEGORY <- 6 + +new_session_id <- function(name = "remove_default_record test") { + created <- create_session(vol_id = TEST_VOL, name = name, vb = FALSE) + if (is.null(created)) { + return(NULL) + } + created$id +} + +new_record_id <- function(name = "remove_default_record test record") { + created <- create_volume_record( + vol_id = TEST_VOL, + category_id = TEST_CATEGORY, + name = name, + vb = FALSE + ) + if (is.null(created)) { + return(NULL) + } + created$record_id +} + +# Setup helper: create session + record + attach the record as a default. +setup_attached <- function(name) { + sid <- new_session_id(paste0(name, " session")) + if (is.null(sid)) return(NULL) + rid <- new_record_id(paste0(name, " record")) + if (is.null(rid)) { + delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE) + return(NULL) + } + attached <- add_default_record_to_session( + vol_id = TEST_VOL, + session_id = sid, + record_id = rid, + vb = FALSE + ) + if (!isTRUE(attached)) { + delete_volume_record(vol_id = TEST_VOL, record_id = rid, vb = FALSE) + delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE) + return(NULL) + } + list(session_id = sid, record_id = rid) +} + +test_that("remove_default_record_from_session detaches a record", { + setup <- setup_attached("remove_default_record happy path") + skip_if_null_response(setup, "setup for remove_default_record happy path") + on.exit( + { + delete_volume_record(vol_id = TEST_VOL, record_id = setup$record_id, vb = FALSE) + delete_session(vol_id = TEST_VOL, session_id = setup$session_id, vb = FALSE) + }, + add = TRUE + ) + + result <- remove_default_record_from_session( + vol_id = TEST_VOL, + session_id = setup$session_id, + record_id = setup$record_id, + vb = FALSE + ) + expect_true(result) + + # Verify the record is no longer among default_records + session <- get_session_by_id( + vol_id = TEST_VOL, + session_id = setup$session_id, + vb = FALSE + ) + default_ids <- vapply( + session$default_records, + function(r) as.integer(r$id), + integer(1) + ) + expect_false(as.integer(setup$record_id) %in% default_ids) +}) + +test_that("remove_default_record_from_session returns FALSE for unattached record", { + sid <- new_session_id("remove_default_record unattached") + skip_if_null_response(sid, "create_session for unattached test") + on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) + + rid <- new_record_id("remove_default_record unattached record") + skip_if_null_response(rid, "create_volume_record for unattached test") + on.exit( + delete_volume_record(vol_id = TEST_VOL, record_id = rid, vb = FALSE), + add = TRUE + ) + + expect_false( + remove_default_record_from_session( + vol_id = TEST_VOL, + session_id = sid, + record_id = rid, + vb = FALSE + ) + ) +}) + +test_that("remove_default_record_from_session returns FALSE for non-existent record", { + sid <- new_session_id("remove_default_record non-existent record") + skip_if_null_response(sid, "create_session for non-existent record test") + on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) + + expect_false( + remove_default_record_from_session( + vol_id = TEST_VOL, + session_id = sid, + record_id = 999999999, + vb = FALSE + ) + ) +}) + +test_that("remove_default_record_from_session returns FALSE for non-existent session", { + rid <- new_record_id("remove_default_record non-existent session record") + skip_if_null_response(rid, "create_volume_record for non-existent session test") + on.exit( + delete_volume_record(vol_id = TEST_VOL, record_id = rid, vb = FALSE), + add = TRUE + ) + + expect_false( + remove_default_record_from_session( + vol_id = TEST_VOL, + session_id = 999999999, + record_id = rid, + vb = FALSE + ) + ) +}) + +test_that("remove_default_record_from_session works with verbose mode", { + setup <- setup_attached("remove_default_record vb") + skip_if_null_response(setup, "setup for remove_default_record vb") + on.exit( + { + delete_volume_record(vol_id = TEST_VOL, record_id = setup$record_id, vb = FALSE) + delete_session(vol_id = TEST_VOL, session_id = setup$session_id, vb = FALSE) + }, + add = TRUE + ) + + expect_true( + remove_default_record_from_session( + vol_id = TEST_VOL, + session_id = setup$session_id, + record_id = setup$record_id, + vb = TRUE + ) + ) +}) + +test_that("remove_default_record_from_session works with custom request object", { + setup <- setup_attached("remove_default_record custom rq") + skip_if_null_response(setup, "setup for remove_default_record custom rq") + on.exit( + { + delete_volume_record(vol_id = TEST_VOL, record_id = setup$record_id, vb = FALSE) + delete_session(vol_id = TEST_VOL, session_id = setup$session_id, vb = FALSE) + }, + add = TRUE + ) + + custom_rq <- databraryr::make_default_request() + expect_true( + remove_default_record_from_session( + vol_id = TEST_VOL, + session_id = setup$session_id, + record_id = setup$record_id, + rq = custom_rq, + vb = FALSE + ) + ) +}) + +test_that("remove_default_record_from_session rejects invalid vol_id", { + expect_error(remove_default_record_from_session(vol_id = -1, session_id = 1, record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = 0, session_id = 1, record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = "1", session_id = 1, record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = TRUE, session_id = 1, record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = c(1, 2), session_id = 1, record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = 1.5, session_id = 1, record_id = 1)) +}) + +test_that("remove_default_record_from_session rejects invalid session_id", { + expect_error(remove_default_record_from_session(vol_id = 1, session_id = -1, record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 0, record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = "1", record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = TRUE, record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = c(1, 2), record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1.5, record_id = 1)) +}) + +test_that("remove_default_record_from_session rejects invalid record_id", { + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = -1)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 0)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = "1")) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = TRUE)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = c(1, 2))) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 1.5)) +}) + +test_that("remove_default_record_from_session rejects invalid vb parameter", { + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 1, vb = -1)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 1, vb = "a")) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 1, vb = NULL)) +}) + +test_that("remove_default_record_from_session rejects invalid rq parameter", { + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 1, rq = "a")) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 1, rq = -1)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 1, rq = TRUE)) +}) From 14917b90e13fa6de9f905279d7a70e450da4e2b0 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Fri, 8 May 2026 14:48:43 +0200 Subject: [PATCH 55/77] feat: add check_duplicate_files_in_session() --- R/check_duplicate_files_in_session.R | 85 ++++++++++ .../test-check_duplicate_files_in_session.R | 153 ++++++++++++++++++ 2 files changed, 238 insertions(+) create mode 100644 R/check_duplicate_files_in_session.R create mode 100644 tests/testthat/test-check_duplicate_files_in_session.R diff --git a/R/check_duplicate_files_in_session.R b/R/check_duplicate_files_in_session.R new file mode 100644 index 00000000..2874f7f2 --- /dev/null +++ b/R/check_duplicate_files_in_session.R @@ -0,0 +1,85 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Check Whether Filenames Already Exist in a Session +#' +#' @description Ask the server which of the supplied filenames already +#' exist as files in the given session. Useful before bulk uploads to detect +#' name collisions in advance. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param filenames Character vector of filenames to check. Length must be +#' at least 1; each element must be a non-empty string. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A \code{tibble} with columns \code{filename} (character) and +#' \code{exists} (logical), one row per input filename and in the same +#' order. Returns \code{NULL} if the request fails. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' check_duplicate_files_in_session( +#' vol_id = 1, +#' session_id = 42, +#' filenames = c("clip_001.mp4", "clip_002.mp4") +#' ) +#' } +#' } +#' @export +check_duplicate_files_in_session <- function( + vol_id = 1, + session_id, + filenames, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + + assertthat::assert_that( + is.character(filenames), + length(filenames) >= 1, + msg = "filenames must be a non-empty character vector" + ) + assertthat::assert_that( + !any(is.na(filenames)), + all(nzchar(trimws(filenames))), + msg = "filenames must not contain NA or empty strings" + ) + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # `as.list()` on a length-1 character would still serialize to a JSON array + # via httr2, but be explicit so the contract matches the server's expected + # `[...]` shape regardless of length. + body <- list(filenames = as.list(filenames)) + + result <- perform_api_post( + path = sprintf(API_SESSION_CHECK_DUPLICATE_FILES, vol_id, session_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(result) || isTRUE(result)) { + if (vb) { + message( + "Failed to check duplicate filenames in session ", + session_id, " of volume ", vol_id + ) + } + return(NULL) + } + + tibble::tibble( + filename = vapply(result, function(r) as.character(r$filename), character(1)), + exists = vapply(result, function(r) isTRUE(r$exists), logical(1)) + ) +} diff --git a/tests/testthat/test-check_duplicate_files_in_session.R b/tests/testthat/test-check_duplicate_files_in_session.R new file mode 100644 index 00000000..d8170227 --- /dev/null +++ b/tests/testthat/test-check_duplicate_files_in_session.R @@ -0,0 +1,153 @@ +# check_duplicate_files_in_session() ------------------------------------------- +login_test_account() + +TEST_VOL <- 1777 + +new_session_id <- function(name = "check_duplicate_files test") { + created <- create_session(vol_id = TEST_VOL, name = name, vb = FALSE) + if (is.null(created)) { + return(NULL) + } + created$id +} + +test_that("check_duplicate_files_in_session returns a tibble for an empty session", { + sid <- new_session_id("check_duplicate_files happy path") + skip_if_null_response(sid, "create_session for check_duplicate_files happy path") + on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) + + filenames <- c("nonexistent_a.mp4", "nonexistent_b.mp4") + result <- check_duplicate_files_in_session( + vol_id = TEST_VOL, + session_id = sid, + filenames = filenames, + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_session(empty session)") + + expect_s3_class(result, "tbl_df") + expect_named(result, c("filename", "exists")) + expect_equal(nrow(result), length(filenames)) + expect_equal(result$filename, filenames) + expect_type(result$exists, "logical") + expect_true(all(!result$exists)) +}) + +test_that("check_duplicate_files_in_session preserves input order", { + sid <- new_session_id("check_duplicate_files order") + skip_if_null_response(sid, "create_session for order test") + on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) + + filenames <- c("z.mp4", "a.mp4", "m.mp4") + result <- check_duplicate_files_in_session( + vol_id = TEST_VOL, + session_id = sid, + filenames = filenames, + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_session(order)") + + expect_equal(result$filename, filenames) +}) + +test_that("check_duplicate_files_in_session works with a single filename", { + sid <- new_session_id("check_duplicate_files single") + skip_if_null_response(sid, "create_session for single filename test") + on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) + + result <- check_duplicate_files_in_session( + vol_id = TEST_VOL, + session_id = sid, + filenames = "only.mp4", + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_session(single)") + + expect_equal(nrow(result), 1L) + expect_equal(result$filename, "only.mp4") + expect_false(result$exists) +}) + +test_that("check_duplicate_files_in_session returns NULL for non-existent session", { + result <- check_duplicate_files_in_session( + vol_id = TEST_VOL, + session_id = 999999999, + filenames = c("a.mp4"), + vb = FALSE + ) + expect_null(result) +}) + +test_that("check_duplicate_files_in_session works with verbose mode", { + sid <- new_session_id("check_duplicate_files vb") + skip_if_null_response(sid, "create_session for check_duplicate_files vb") + on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) + + result <- check_duplicate_files_in_session( + vol_id = TEST_VOL, + session_id = sid, + filenames = c("vb.mp4"), + vb = TRUE + ) + skip_if_null_response(result, "check_duplicate_files_in_session vb") + expect_s3_class(result, "tbl_df") +}) + +test_that("check_duplicate_files_in_session works with custom request object", { + sid <- new_session_id("check_duplicate_files custom rq") + skip_if_null_response(sid, "create_session for check_duplicate_files custom rq") + on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) + + custom_rq <- databraryr::make_default_request() + result <- check_duplicate_files_in_session( + vol_id = TEST_VOL, + session_id = sid, + filenames = c("custom.mp4"), + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_session custom rq") + expect_s3_class(result, "tbl_df") +}) + +test_that("check_duplicate_files_in_session rejects invalid filenames", { + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = character(0))) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = NULL)) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = 123)) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = list("a"))) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = TRUE)) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = c("a", NA))) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = c("a", ""))) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = c("a", " "))) +}) + +test_that("check_duplicate_files_in_session rejects invalid vol_id", { + expect_error(check_duplicate_files_in_session(vol_id = -1, session_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 0, session_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = "1", session_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = TRUE, session_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = c(1, 2), session_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 1.5, session_id = 1, filenames = "a")) +}) + +test_that("check_duplicate_files_in_session rejects invalid session_id", { + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = -1, filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 0, filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = "1", filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = TRUE, filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = c(1, 2), filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1.5, filenames = "a")) +}) + +test_that("check_duplicate_files_in_session rejects invalid vb parameter", { + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = "a", vb = -1)) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = "a", vb = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = "a", vb = c(TRUE, FALSE))) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = "a", vb = NULL)) +}) + +test_that("check_duplicate_files_in_session rejects invalid rq parameter", { + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = "a", rq = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = "a", rq = -1)) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = "a", rq = TRUE)) +}) From 9bffb37ecd6d4ca61bd556bbaf6a1d75b7d3ae47 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Mon, 11 May 2026 07:56:56 +0200 Subject: [PATCH 56/77] doc: regenerate man directory and update NAMESPACE --- NAMESPACE | 7 ++ man/add_default_record_to_session.Rd | 45 ++++++++++++ man/check_duplicate_files_in_session.Rd | 47 +++++++++++++ man/create_session.Rd | 79 +++++++++++++++++++++ man/delete_session.Rd | 37 ++++++++++ man/patch_session.Rd | 83 +++++++++++++++++++++++ man/remove_default_record_from_session.Rd | 44 ++++++++++++ man/update_session.Rd | 69 +++++++++++++++++++ 8 files changed, 411 insertions(+) create mode 100644 man/add_default_record_to_session.Rd create mode 100644 man/check_duplicate_files_in_session.Rd create mode 100644 man/create_session.Rd create mode 100644 man/delete_session.Rd create mode 100644 man/patch_session.Rd create mode 100644 man/remove_default_record_from_session.Rd create mode 100644 man/update_session.Rd diff --git a/NAMESPACE b/NAMESPACE index 52943e71..1df58ce2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,11 +2,15 @@ export("%>%") export(HHMMSSmmm_to_ms) +export(add_default_record_to_session) export(assign_constants) export(assign_record_to_file) +export(check_duplicate_files_in_session) export(check_ssl_certs) +export(create_session) export(create_volume_record) export(delete_record_measure) +export(delete_session) export(delete_volume_record) export(disable_volume_category) export(download_folder_asset) @@ -72,6 +76,8 @@ export(login_db) export(logout_db) export(make_default_request) export(make_login_client) +export(patch_session) +export(remove_default_record_from_session) export(search_for_funder) export(search_for_tags) export(search_institutions) @@ -80,6 +86,7 @@ export(search_volumes) export(set_record_measure) export(set_volume_enabled_categories) export(unassign_record_from_file) +export(update_session) export(update_volume_record) export(whoami) importFrom(lifecycle,deprecated) diff --git a/man/add_default_record_to_session.Rd b/man/add_default_record_to_session.Rd new file mode 100644 index 00000000..49184f5c --- /dev/null +++ b/man/add_default_record_to_session.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/add_default_record_to_session.R +\name{add_default_record_to_session} +\alias{add_default_record_to_session} +\title{Add a Default Record to a Session} +\usage{ +add_default_record_to_session( + vol_id = 1, + session_id, + record_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} if the record was successfully added, \code{FALSE} +otherwise. +} +\description{ +Attach a record to a session as a default record. Default +records apply to all files in the session unless overridden. The record +must either belong to the destination volume or be accessible to it via a +linked volume; the server enforces this and returns \code{403} otherwise. +} +\examples{ +\donttest{ +\dontrun{ +add_default_record_to_session(vol_id = 1, session_id = 42, record_id = 101) +} +} +} +\seealso{ +\code{\link{remove_default_record_from_session}} +} diff --git a/man/check_duplicate_files_in_session.Rd b/man/check_duplicate_files_in_session.Rd new file mode 100644 index 00000000..693a45bf --- /dev/null +++ b/man/check_duplicate_files_in_session.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/check_duplicate_files_in_session.R +\name{check_duplicate_files_in_session} +\alias{check_duplicate_files_in_session} +\title{Check Whether Filenames Already Exist in a Session} +\usage{ +check_duplicate_files_in_session( + vol_id = 1, + session_id, + filenames, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{filenames}{Character vector of filenames to check. Length must be +at least 1; each element must be a non-empty string.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A \code{tibble} with columns \code{filename} (character) and +\code{exists} (logical), one row per input filename and in the same +order. Returns \code{NULL} if the request fails. +} +\description{ +Ask the server which of the supplied filenames already +exist as files in the given session. Useful before bulk uploads to detect +name collisions in advance. +} +\examples{ +\donttest{ +\dontrun{ +check_duplicate_files_in_session( + vol_id = 1, + session_id = 42, + filenames = c("clip_001.mp4", "clip_002.mp4") +) +} +} +} diff --git a/man/create_session.Rd b/man/create_session.Rd new file mode 100644 index 00000000..7760b25e --- /dev/null +++ b/man/create_session.Rd @@ -0,0 +1,79 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/create_session.R +\name{create_session} +\alias{create_session} +\title{Create Session in Databrary Volume} +\usage{ +create_session( + vol_id = 1, + name, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + default_records = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{name}{Display name for the session. Required, non-empty after trim.} + +\item{release_level}{Optional release level for the session +(e.g. \code{"PRIVATE"}, \code{"SHARED"}, \code{"EXCERPTS"}, +\code{"PUBLIC"}). The server validates the choice.} + +\item{source_date}{Optional session date. A length-1 \code{Date} object or +ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}.} + +\item{date}{Optional structured date list with named fields \code{year}, +\code{month}, \code{day}, and optional \code{is_estimated} (logical). +Mutually exclusive with \code{source_date}.} + +\item{date_precision}{Optional precision for \code{date}: e.g. +\code{"FULL"}, \code{"YEAR"}. Server validates the choice.} + +\item{default_records}{Optional integer vector of record IDs to set as +default records on the new session.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the created session's metadata (same shape as +\code{\link{get_session_by_id}}), or \code{NULL} if creation fails. +} +\description{ +Create a new session in a Databrary volume. A session (a.k.a. +"slot") groups files and metadata for a single recording or testing event. +\code{name} is required and must be non-empty. Provide either a flat +\code{source_date} or a structured \code{date} list (with optional +\code{date_precision}) to record when the session occurred -- not both. +} +\examples{ +\donttest{ +\dontrun{ +# Minimal session +create_session(vol_id = 1, name = "Pilot 01") + +# Session with a flat date +create_session( + vol_id = 1, + name = "Pilot 02", + source_date = as.Date("2024-03-15") +) + +# Session with a structured date and default records +create_session( + vol_id = 1, + name = "Pilot 03", + date = list(year = 2024, month = 3, day = 15, is_estimated = FALSE), + date_precision = "FULL", + default_records = c(101, 102) +) +} +} +} diff --git a/man/delete_session.Rd b/man/delete_session.Rd new file mode 100644 index 00000000..9c073b2f --- /dev/null +++ b/man/delete_session.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/delete_session.R +\name{delete_session} +\alias{delete_session} +\title{Delete Session from Databrary Volume} +\usage{ +delete_session(vol_id = 1, session_id, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} if the session was successfully deleted, \code{FALSE} +otherwise. +} +\description{ +Delete (soft-delete) a session from a Databrary volume. The +session and its associated metadata are marked as deleted but not +permanently removed from the database. +} +\examples{ +\donttest{ +\dontrun{ +# Delete a session +delete_session(vol_id = 1, session_id = 42) + +# Delete with verbose output +delete_session(vol_id = 1, session_id = 42, vb = TRUE) +} +} +} diff --git a/man/patch_session.Rd b/man/patch_session.Rd new file mode 100644 index 00000000..fd925297 --- /dev/null +++ b/man/patch_session.Rd @@ -0,0 +1,83 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/patch_session.R +\name{patch_session} +\alias{patch_session} +\title{Partially Update a Session in Databrary Volume} +\usage{ +patch_session( + vol_id = 1, + session_id, + name = NULL, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + default_records = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{name}{Optional new session name. If provided, must be a non-empty +length-1 string.} + +\item{release_level}{Optional release level (e.g. \code{"PRIVATE"}, +\code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). Server validates +the choice.} + +\item{source_date}{Optional session date. A length-1 \code{Date} object or +ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}.} + +\item{date}{Optional structured date list with named fields \code{year}, +\code{month}, \code{day}, and optional \code{is_estimated} (logical). +Mutually exclusive with \code{source_date}.} + +\item{date_precision}{Optional precision for \code{date}: e.g. +\code{"FULL"}, \code{"YEAR"}.} + +\item{default_records}{Optional integer vector of record IDs. The server +replaces the session's current default records with this set.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the updated session's metadata (same shape as +\code{\link{get_session_by_id}}), or \code{NULL} if the update fails or +no fields were provided. +} +\description{ +Sends a PATCH request to update selected fields of an existing +session. Only provided arguments are sent; omitted fields are left +unchanged on the server. Note that \code{default_records} is a full +replacement on the server -- supplying it overwrites the entire current set +of defaults; omit it to keep them. To change just one default record use +\code{\link{add_default_record_to_session}} or +\code{\link{remove_default_record_from_session}}. +} +\examples{ +\donttest{ +\dontrun{ +# Rename a session +patch_session(vol_id = 1, session_id = 42, name = "Renamed session") + +# Update the date and precision +patch_session( + vol_id = 1, + session_id = 42, + date = list(year = 2024, month = 3, day = 15), + date_precision = "FULL" +) +} +} +} +\seealso{ +\code{\link{update_session}}, \code{\link{create_session}}, +\code{\link{add_default_record_to_session}}, +\code{\link{remove_default_record_from_session}} +} diff --git a/man/remove_default_record_from_session.Rd b/man/remove_default_record_from_session.Rd new file mode 100644 index 00000000..02340bd8 --- /dev/null +++ b/man/remove_default_record_from_session.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/remove_default_record_from_session.R +\name{remove_default_record_from_session} +\alias{remove_default_record_from_session} +\title{Remove a Default Record from a Session} +\usage{ +remove_default_record_from_session( + vol_id = 1, + session_id, + record_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} if the record was successfully removed, \code{FALSE} +otherwise. +} +\description{ +Detach a record from a session's default records. The record +must currently be a default record on the session, otherwise the server +returns \code{404}. +} +\examples{ +\donttest{ +\dontrun{ +remove_default_record_from_session(vol_id = 1, session_id = 42, record_id = 101) +} +} +} +\seealso{ +\code{\link{add_default_record_to_session}} +} diff --git a/man/update_session.Rd b/man/update_session.Rd new file mode 100644 index 00000000..c11a032c --- /dev/null +++ b/man/update_session.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/update_session.R +\name{update_session} +\alias{update_session} +\title{Replace a Session in Databrary Volume (PUT)} +\usage{ +update_session( + vol_id = 1, + session_id, + name, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + default_records = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{name}{New session name. Required, non-empty after trim.} + +\item{release_level}{Optional release level (e.g. \code{"PRIVATE"}, +\code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}).} + +\item{source_date}{Optional session date. A length-1 \code{Date} object or +ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}.} + +\item{date}{Optional structured date list with named fields \code{year}, +\code{month}, \code{day}, and optional \code{is_estimated} (logical). +Mutually exclusive with \code{source_date}.} + +\item{date_precision}{Optional precision for \code{date}: e.g. +\code{"FULL"}, \code{"YEAR"}.} + +\item{default_records}{Optional integer vector of record IDs. The server +replaces the session's current default records with this set; omit to +leave them unchanged.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the updated session's metadata (same shape as +\code{\link{get_session_by_id}}), or \code{NULL} if the update fails. +} +\description{ +Sends a PUT request to fully replace a session's writable +fields. \code{name} is required (non-empty); other fields are optional and +default to server-side values when omitted (the underlying serializer +marks them \code{required=FALSE}). Use \code{\link{patch_session}} for +partial updates when you don't want full-replacement semantics. +} +\examples{ +\donttest{ +\dontrun{ +# Rename a session via PUT +update_session(vol_id = 1, session_id = 42, name = "Replacement name") +} +} +} +\seealso{ +\code{\link{patch_session}}, \code{\link{create_session}} +} From f0d177f57fa98c6267f301a147c743d20cf4ec81 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Mon, 11 May 2026 11:05:56 +0200 Subject: [PATCH 57/77] chore: exclude from linting --- .lintr | 2 +- R/check_duplicate_files_in_session.R | 2 +- R/remove_default_record_from_session.R | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.lintr b/.lintr index bb8d5899..652b2173 100644 --- a/.lintr +++ b/.lintr @@ -1,2 +1,2 @@ linters: linters_with_defaults(line_length_linter = line_length_linter(120)) -exclusions: list("_wip", "tests/testthat", "vignettes", "R/CONSTANTS.R" = list(object_name_linter = Inf), "R/aaa.R" = list(object_name_linter = Inf), "R/auth_utils.R" = list(object_name_linter = Inf), "R/utils.R" = list(object_name_linter = Inf)) +exclusions: list("_wip", "tests/testthat", "vignettes", "R/CONSTANTS.R" = list(object_name_linter = Inf, object_length_linter = Inf), "R/aaa.R" = list(object_name_linter = Inf), "R/auth_utils.R" = list(object_name_linter = Inf), "R/utils.R" = list(object_name_linter = Inf)) diff --git a/R/check_duplicate_files_in_session.R b/R/check_duplicate_files_in_session.R index 2874f7f2..6e02c72a 100644 --- a/R/check_duplicate_files_in_session.R +++ b/R/check_duplicate_files_in_session.R @@ -32,7 +32,7 @@ NULL #' } #' } #' @export -check_duplicate_files_in_session <- function( +check_duplicate_files_in_session <- function( # nolint: object_length_linter. vol_id = 1, session_id, filenames, diff --git a/R/remove_default_record_from_session.R b/R/remove_default_record_from_session.R index 64290c48..2a83377f 100644 --- a/R/remove_default_record_from_session.R +++ b/R/remove_default_record_from_session.R @@ -28,7 +28,7 @@ NULL #' } #' } #' @export -remove_default_record_from_session <- function( +remove_default_record_from_session <- function( # nolint: object_length_linter. vol_id = 1, session_id, record_id, From 266b96151e81c02d30773425e86efc2cbdfccedf Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Mon, 11 May 2026 10:35:46 +0200 Subject: [PATCH 58/77] feat: add file upload pipeline (initiate, status, complete, upload_file) --- NAMESPACE | 4 + R/CONSTANTS.R | 4 + R/complete_upload.R | 104 ++++++++++++ R/get_upload_status.R | 103 ++++++++++++ R/initiate_upload.R | 152 +++++++++++++++++ R/upload_file.R | 206 ++++++++++++++++++++++++ R/upload_utils.R | 94 +++++++++++ man/complete_upload.Rd | 59 +++++++ man/get_upload_status.Rd | 56 +++++++ man/initiate_upload.Rd | 83 ++++++++++ man/upload_file.Rd | 69 ++++++++ tests/testthat/test-complete_upload.R | 55 +++++++ tests/testthat/test-get_upload_status.R | 55 +++++++ tests/testthat/test-initiate_upload.R | 114 +++++++++++++ tests/testthat/test-upload_file.R | 124 ++++++++++++++ 15 files changed, 1282 insertions(+) create mode 100644 R/complete_upload.R create mode 100644 R/get_upload_status.R create mode 100644 R/initiate_upload.R create mode 100644 R/upload_file.R create mode 100644 R/upload_utils.R create mode 100644 man/complete_upload.Rd create mode 100644 man/get_upload_status.Rd create mode 100644 man/initiate_upload.Rd create mode 100644 man/upload_file.Rd create mode 100644 tests/testthat/test-complete_upload.R create mode 100644 tests/testthat/test-get_upload_status.R create mode 100644 tests/testthat/test-initiate_upload.R create mode 100644 tests/testthat/test-upload_file.R diff --git a/NAMESPACE b/NAMESPACE index 1df58ce2..3ca8dda8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,6 +7,7 @@ export(assign_constants) export(assign_record_to_file) export(check_duplicate_files_in_session) export(check_ssl_certs) +export(complete_upload) export(create_session) export(create_volume_record) export(delete_record_measure) @@ -40,6 +41,7 @@ export(get_session_by_name) export(get_session_file) export(get_supported_file_types) export(get_tag_by_id) +export(get_upload_status) export(get_user_avatar) export(get_user_by_id) export(get_user_statistics) @@ -47,6 +49,7 @@ export(get_volume_by_id) export(get_volume_collaborator_by_id) export(get_volume_enabled_categories) export(get_volume_record_by_id) +export(initiate_upload) export(list_asset_formats) export(list_authorized_investigators) export(list_categories) @@ -88,6 +91,7 @@ export(set_volume_enabled_categories) export(unassign_record_from_file) export(update_session) export(update_volume_record) +export(upload_file) export(whoami) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index c246f416..8c5fda56 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -61,6 +61,10 @@ API_TAG_DETAIL <- "/tags/%s/" API_CATEGORIES <- "/categories/" API_CATEGORY_DETAIL <- "/categories/%s/" API_VOLUME_CATEGORIES <- "/volumes/%s/categories/" +API_UPLOADS_INITIATE <- "/uploads/initiate/" +API_UPLOADS_STATUS <- "/uploads/%s/status/" +API_UPLOADS_COMPLETE_MULTIPART <- "/uploads/complete-multipart/" +API_UPLOADS_ABORT_MULTIPART <- "/uploads/abort-multipart/" RETRY_LIMIT <- 3 RETRY_WAIT_TIME <- 1 # seconds diff --git a/R/complete_upload.R b/R/complete_upload.R new file mode 100644 index 00000000..487bdacf --- /dev/null +++ b/R/complete_upload.R @@ -0,0 +1,104 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Complete a Multipart Upload +#' +#' @description Tell the Databrary API that all parts of a multipart upload +#' have been PUT to S3 and the object can be assembled. The server forwards +#' the part list to S3's \code{CompleteMultipartUpload}, transitioning the +#' upload into the post-upload pipeline (virus scan, format probe). +#' +#' Only needed when \code{initiate_upload()} returned +#' \code{upload_type == "multipart"}. Single-PUT uploads complete implicitly +#' once the object lands in storage. +#' +#' @param upload_guid Character GUID returned in \code{initiate_upload()$upload_guid}. +#' @param s3_upload_id Character S3 upload ID returned in +#' \code{initiate_upload()$s3_upload_id}. +#' @param parts A list of one entry per part, each a list with +#' \code{part_number} (positive integer) and \code{etag} (character, +#' from the \code{ETag} response header of the part PUT). Order is not +#' significant -- the server sorts by \code{part_number}. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} on success, \code{NULL} on failure. +#' +#' @inheritParams options_params +#' +#' @seealso \code{\link{initiate_upload}}, \code{\link{upload_file}} +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' complete_upload( +#' upload_guid = "abc...", +#' s3_upload_id = "xyz...", +#' parts = list( +#' list(part_number = 1L, etag = "etag-of-part-1"), +#' list(part_number = 2L, etag = "etag-of-part-2") +#' ) +#' ) +#' } +#' } +#' @export +complete_upload <- function( + upload_guid, + s3_upload_id, + parts, + vb = options::opt("vb"), + rq = NULL +) { + assertthat::assert_that( + is.character(upload_guid), length(upload_guid) == 1, nzchar(upload_guid) + ) + assertthat::assert_that( + is.character(s3_upload_id), length(s3_upload_id) == 1, nzchar(s3_upload_id) + ) + assertthat::assert_that( + is.list(parts), length(parts) >= 1, + msg = "parts must be a non-empty list" + ) + + # Coerce each entry to the wire shape and validate. Mutates only the local + # copy. + parts <- lapply(parts, function(p) { + assertthat::assert_that( + is.list(p), !is.null(p$part_number), !is.null(p$etag), + msg = "each parts entry must be a list with part_number and etag" + ) + pn <- p$part_number + assertthat::assert_that( + is.numeric(pn), length(pn) == 1, pn >= 1, pn == floor(pn), + msg = "part_number must be a positive integer" + ) + assertthat::assert_that( + is.character(p$etag), length(p$etag) == 1, nzchar(p$etag), + msg = "etag must be a non-empty string" + ) + list(part_number = as.integer(pn), etag = unquote_etag(p$etag)) + }) + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + result <- perform_api_post( + path = API_UPLOADS_COMPLETE_MULTIPART, + body = list( + upload_guid = upload_guid, + s3_upload_id = s3_upload_id, + parts = parts + ), + rq = rq, + vb = vb + ) + + if (is.null(result)) { + if (vb) { + message("Failed to complete multipart upload ", upload_guid) + } + return(NULL) + } + TRUE +} diff --git a/R/get_upload_status.R b/R/get_upload_status.R new file mode 100644 index 00000000..5c447aad --- /dev/null +++ b/R/get_upload_status.R @@ -0,0 +1,103 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get the Current Status of an Upload +#' +#' @description Poll the Databrary API for the lifecycle state of an upload +#' started with \code{\link{initiate_upload}}. The returned status reflects +#' both the storage-side transfer and the post-upload server pipeline +#' (e.g. virus scan, format probe). +#' +#' Accepts either the absolute \code{status_url} returned by +#' \code{initiate_upload()} (preferred -- avoids a second URL build) or +#' the upload's \code{upload_guid}. +#' +#' @param status_url Absolute URL returned by \code{initiate_upload()} under +#' \code{status_url}. Mutually exclusive with \code{upload_guid}. +#' @param upload_guid Character upload GUID. Mutually exclusive with +#' \code{status_url}. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A length-1 character string with the status (e.g. +#' \code{"scanning"}, \code{"completed"}, \code{"infected"}, +#' \code{"upload_failed"}, \code{"processing_failed"} on the AWS +#' deployment; raw \code{Upload.status} on the core deployment). Returns +#' \code{NULL} if the request fails. +#' +#' @inheritParams options_params +#' +#' @seealso \code{\link{initiate_upload}}, \code{\link{upload_file}} +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' init <- initiate_upload( +#' filename = "clip.mp4", +#' destination_type = "session", +#' object_id = 42 +#' ) +#' get_upload_status(status_url = init$status_url) +#' } +#' } +#' @export +get_upload_status <- function( + status_url = NULL, + upload_guid = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assertthat::assert_that( + xor(is.null(status_url), is.null(upload_guid)), + msg = "Provide exactly one of status_url or upload_guid" + ) + + if (!is.null(status_url)) { + assertthat::assert_that( + is.character(status_url), length(status_url) == 1, nzchar(status_url) + ) + path <- status_url + absolute <- grepl("^https?://", status_url) + } else { + assertthat::assert_that( + is.character(upload_guid), length(upload_guid) == 1, nzchar(upload_guid) + ) + path <- sprintf(API_UPLOADS_STATUS, upload_guid) + absolute <- FALSE + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # perform_api_get prepends DATABRARY_BASE_URL via ensure_leading_slash, so + # for absolute URLs we override the URL on the request after construction. + if (absolute) { + request <- rq + if (is.null(request)) { + request <- databraryr::make_default_request() + } + request <- httr2::req_url(request, path) + + response <- tryCatch( + httr2::req_perform(request), + httr2_error = function(cnd) { + if (vb) { + message("Status request failed for ", path, ": ", conditionMessage(cnd)) + } + NULL + } + ) + if (is.null(response)) { + return(NULL) + } + body <- httr2::resp_body_json(response) + } else { + body <- perform_api_get(path = path, rq = rq, vb = vb) + } + + if (is.null(body) || is.null(body$status)) { + return(NULL) + } + as.character(body$status) +} diff --git a/R/initiate_upload.R b/R/initiate_upload.R new file mode 100644 index 00000000..83bd7068 --- /dev/null +++ b/R/initiate_upload.R @@ -0,0 +1,152 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Initiate a File Upload +#' +#' @description Ask the Databrary API to register a pending upload and return +#' the signed URL(s) needed to PUT file bytes directly to object storage. The +#' server decides whether to issue a single-PUT or a multipart upload based on +#' \code{file_size} and the deployment's storage backend (S3 multipart on the +#' AI/AWS deployment, single PUT on the on-prem core deployment). +#' +#' This is the first step of the upload pipeline; pass the returned object to +#' \code{\link{upload_file}} (high level) or use the returned URLs directly +#' with \code{httr2::req_perform()} for fine-grained control. +#' +#' @param filename Display filename. Required, non-empty. +#' @param destination_type Where the upload will live. One of +#' \code{"session"}, \code{"folder"}, \code{"linked_volume_session"}, +#' \code{"linked_volume_folder"} (server validates). Required. +#' @param object_id Positive integer ID of the destination object (session +#' or folder, depending on \code{destination_type}). Required. +#' @param file_size File size in bytes. Optional but strongly recommended: +#' the AWS deployment uses this to decide multipart vs single PUT. +#' @param content_type MIME type of the file (e.g. \code{"video/mp4"}). +#' Optional but recommended; some storage backends require it. +#' @param source_session_id Required when +#' \code{destination_type == "linked_volume_session"}; positive integer. +#' @param source_folder_id Required when +#' \code{destination_type == "linked_volume_folder"}; positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A named list describing the upload. Always contains +#' \code{status_url}. For a single PUT (the on-prem core deployment, or +#' any AWS upload smaller than the multipart threshold), contains +#' \code{signed_upload_url} and \code{required_headers} (may be empty). +#' For a multipart upload, contains \code{upload_type = "multipart"}, +#' \code{upload_guid}, \code{s3_upload_id}, \code{part_urls} (a list of +#' \code{list(part_number, url)}), and \code{part_size}. Returns +#' \code{NULL} if the request fails. +#' +#' @inheritParams options_params +#' +#' @seealso \code{\link{upload_file}}, \code{\link{get_upload_status}}, +#' \code{\link{complete_upload}} +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Initiate a small upload to a session +#' init <- initiate_upload( +#' filename = "clip_001.mp4", +#' destination_type = "session", +#' object_id = 42, +#' file_size = 1024L * 1024L, +#' content_type = "video/mp4" +#' ) +#' } +#' } +#' @export +initiate_upload <- function( + filename, + destination_type, + object_id, + file_size = NULL, + content_type = NULL, + source_session_id = NULL, + source_folder_id = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assertthat::assert_that( + is.character(filename), length(filename) == 1, nzchar(trimws(filename)), + msg = "filename must be a non-empty string" + ) + assertthat::assert_that( + is.character(destination_type), length(destination_type) == 1, + nzchar(trimws(destination_type)), + msg = "destination_type must be a non-empty string" + ) + assert_positive_integer(object_id, "object_id") + + if (!is.null(file_size)) { + assert_positive_integer(file_size, "file_size") + } + if (!is.null(content_type)) { + assertthat::assert_that( + is.character(content_type), length(content_type) == 1, + nzchar(trimws(content_type)) + ) + } + if (!is.null(source_session_id)) { + assert_positive_integer(source_session_id, "source_session_id") + } + if (!is.null(source_folder_id)) { + assert_positive_integer(source_folder_id, "source_folder_id") + } + + # Server enforces the linked-volume requirements, but fail fast client-side + # so users get a useful message before the round-trip. + if (identical(destination_type, "linked_volume_session")) { + assertthat::assert_that( + !is.null(source_session_id), + msg = "source_session_id required when destination_type == 'linked_volume_session'" + ) + } + if (identical(destination_type, "linked_volume_folder")) { + assertthat::assert_that( + !is.null(source_folder_id), + msg = "source_folder_id required when destination_type == 'linked_volume_folder'" + ) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list( + filename = filename, + destination_type = destination_type, + object_id = as.integer(object_id) + ) + if (!is.null(file_size)) body$file_size <- as.integer(file_size) + if (!is.null(content_type)) body$content_type <- content_type + if (!is.null(source_session_id)) { + body$source_session_id <- as.integer(source_session_id) + } + if (!is.null(source_folder_id)) { + body$source_folder_id <- as.integer(source_folder_id) + } + + result <- perform_api_post( + path = API_UPLOADS_INITIATE, + body = body, + rq = rq, + vb = vb + ) + + if (is.null(result) || isTRUE(result)) { + if (vb) { + message("Failed to initiate upload for filename ", filename) + } + return(NULL) + } + + # The on-prem core deployment omits `upload_type`; default it so callers + # can branch on a single field without checking presence. + if (is.null(result$upload_type)) { + result$upload_type <- "single" + } + result +} diff --git a/R/upload_file.R b/R/upload_file.R new file mode 100644 index 00000000..23ed2661 --- /dev/null +++ b/R/upload_file.R @@ -0,0 +1,206 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Guess the MIME type of a local file from its extension. +#' @noRd +guess_content_type <- function(path) { + ext <- tolower(tools::file_ext(path)) + if (!nzchar(ext)) { + return("application/octet-stream") + } + mimes <- list( + mp4 = "video/mp4", mov = "video/quicktime", avi = "video/x-msvideo", + mkv = "video/x-matroska", webm = "video/webm", + mp3 = "audio/mpeg", wav = "audio/wav", m4a = "audio/mp4", + jpg = "image/jpeg", jpeg = "image/jpeg", png = "image/png", + gif = "image/gif", tiff = "image/tiff", + pdf = "application/pdf", csv = "text/csv", + txt = "text/plain", json = "application/json", + zip = "application/zip" + ) + mt <- mimes[[ext]] + if (is.null(mt)) "application/octet-stream" else mt +} + +#' PUT each part of a multipart upload and collect ETags. +#' @noRd +put_multipart_parts <- function(path, part_urls, part_size, file_size, vb) { + parts_meta <- normalize_part_urls(part_urls) + results <- vector("list", length(parts_meta)) + + for (i in seq_along(parts_meta)) { + pn <- as.integer(parts_meta[[i]]$part_number) + url <- parts_meta[[i]]$url + offset <- (pn - 1L) * as.numeric(part_size) + remaining <- file_size - offset + n <- min(as.numeric(part_size), remaining) + + if (vb) { + message(sprintf( + "Uploading part %d/%d (%.2f MB)", + pn, length(parts_meta), n / 1024 / 1024 + )) + } + + bytes <- read_file_chunk(path, offset = offset, n = n) + resp <- put_signed_url(url, bytes, vb = vb) + if (is.null(resp)) { + if (vb) message("Aborting: part ", pn, " failed to upload.") + return(NULL) + } + + etag <- httr2::resp_header(resp, "ETag") + if (is.null(etag) || !nzchar(etag)) { + if (vb) message("Aborting: part ", pn, " returned no ETag.") + return(NULL) + } + results[[i]] <- list(part_number = pn, etag = unquote_etag(etag)) + } + + results +} + +#' Upload a Local File to Databrary +#' +#' @description High-level wrapper around the upload pipeline: +#' \code{\link{initiate_upload}} -> PUT bytes to the signed URL(s) -> +#' \code{\link{complete_upload}} (multipart only). Returns the metadata +#' needed to poll progress with \code{\link{get_upload_status}}. +#' +#' Picks the upload mode the server returned: single PUT on the on-prem +#' core deployment or for small files on AWS, S3 multipart for large files +#' on AWS. +#' +#' @param path Path to the local file. Must exist and be readable. +#' @param destination_type See \code{\link{initiate_upload}}. +#' @param object_id See \code{\link{initiate_upload}}. +#' @param filename Optional display filename; defaults to \code{basename(path)}. +#' @param content_type Optional MIME type; auto-detected from the file +#' extension when not supplied. +#' @param source_session_id See \code{\link{initiate_upload}}. +#' @param source_folder_id See \code{\link{initiate_upload}}. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A named list with \code{upload_guid} (when known), +#' \code{status_url}, and \code{upload_type}. Returns \code{NULL} if any +#' step fails. +#' +#' @inheritParams options_params +#' +#' @seealso \code{\link{initiate_upload}}, \code{\link{get_upload_status}}, +#' \code{\link{complete_upload}} +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' info <- upload_file( +#' path = "/tmp/clip.mp4", +#' destination_type = "session", +#' object_id = 42 +#' ) +#' get_upload_status(status_url = info$status_url) +#' } +#' } +#' @export +upload_file <- function( + path, + destination_type, + object_id, + filename = NULL, + content_type = NULL, + source_session_id = NULL, + source_folder_id = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assertthat::assert_that( + is.character(path), length(path) == 1, nzchar(path), + file.exists(path), + msg = "path must point to an existing local file" + ) + if (is.null(filename)) { + filename <- basename(path) + } + if (is.null(content_type)) { + content_type <- guess_content_type(path) + } + file_size <- file.info(path)$size + assertthat::assert_that( + !is.na(file_size), file_size > 0, + msg = paste("file is empty or unreadable:", path) + ) + + init <- initiate_upload( + filename = filename, + destination_type = destination_type, + object_id = object_id, + file_size = file_size, + content_type = content_type, + source_session_id = source_session_id, + source_folder_id = source_folder_id, + vb = vb, + rq = rq + ) + if (is.null(init)) { + return(NULL) + } + + if (identical(init$upload_type, "multipart")) { + parts <- put_multipart_parts( + path = path, + part_urls = init$part_urls, + part_size = init$part_size, + file_size = file_size, + vb = vb + ) + if (is.null(parts)) { + return(NULL) + } + + ok <- complete_upload( + upload_guid = init$upload_guid, + s3_upload_id = init$s3_upload_id, + parts = parts, + vb = vb, + rq = rq + ) + if (is.null(ok)) { + return(NULL) + } + + return(list( + upload_guid = init$upload_guid, + status_url = init$status_url, + upload_type = "multipart" + )) + } + + # Single PUT path -- AWS deployment returns required_headers (e.g. KMS + # SSE headers); on-prem core returns no header map. + headers <- init$required_headers + if (is.null(headers)) headers <- list() + # required_headers may arrive as a named list; httr2::req_headers wants a + # named character vector or `...` so coerce. + if (is.list(headers) && length(headers) > 0) { + headers <- vapply(headers, as.character, character(1)) + } + + bytes <- readBin(path, what = "raw", n = file_size) + resp <- put_signed_url( + url = init$signed_upload_url, + body = bytes, + headers = headers, + vb = vb + ) + if (is.null(resp)) { + return(NULL) + } + + list( + upload_guid = init$upload_guid, + status_url = init$status_url, + upload_type = "single" + ) +} diff --git a/R/upload_utils.R b/R/upload_utils.R new file mode 100644 index 00000000..43f64379 --- /dev/null +++ b/R/upload_utils.R @@ -0,0 +1,94 @@ +# Internal helpers for the file upload pipeline (initiate / PUT / complete). + +#' Read a byte range from a file as a raw vector. +#' +#' Used to slice a part for multipart upload. Reads at most `n` bytes +#' starting at `offset`; the last part may return fewer bytes than `n`. +#' @noRd +read_file_chunk <- function(path, offset, n) { + assertthat::assert_that( + assertthat::is.string(path), + file.exists(path) + ) + assertthat::assert_that( + is.numeric(offset), length(offset) == 1, offset >= 0 + ) + assertthat::assert_that( + is.numeric(n), length(n) == 1, n >= 0 + ) + + con <- file(path, "rb") + on.exit(close(con), add = TRUE) + if (offset > 0) { + seek(con, where = offset, origin = "start") + } + readBin(con, what = "raw", n = n) +} + +#' Strip surrounding quotes from an S3 ETag header value. +#' +#' S3 returns the ETag wrapped in double quotes (e.g. `"abc123"`); the +#' completion endpoint accepts either form, but stripping keeps the value +#' tidy and matches the boto example in the service layer. +#' @noRd +unquote_etag <- function(etag) { + if (is.null(etag) || !nzchar(etag)) { + return(etag) + } + gsub('^"|"$', "", etag) +} + +#' PUT a raw byte payload to a signed URL. +#' +#' Builds a *fresh* httr2 request (no Databrary auth headers) because the +#' presigned URL embeds its own signature; sending extra Authorization +#' headers would invalidate it on both S3 and GCS. +#' +#' @param url Signed upload URL. +#' @param body Raw vector to upload. +#' @param headers Optional named character vector of headers (e.g. the +#' `required_headers` returned by `initiate_upload()` for single PUTs). +#' @param vb Verbose logging flag. +#' @return The httr2 response object on success, `NULL` on failure. +#' @noRd +put_signed_url <- function(url, body, headers = NULL, vb = FALSE) { + assertthat::assert_that(assertthat::is.string(url)) + assertthat::assert_that(is.raw(body)) + + request <- httr2::request(url) + request <- httr2::req_method(request, "PUT") + request <- httr2::req_body_raw(request, body) + if (!is.null(headers) && length(headers) > 0) { + request <- do.call(httr2::req_headers, c(list(request), as.list(headers))) + } + request <- httr2::req_timeout(request, REQUEST_TIMEOUT_VERY_LONG) + request <- httr2::req_retry( + request, + max_tries = RETRY_LIMIT, + backoff = function(i) RETRY_WAIT_TIME * RETRY_BACKOFF^(i - 1) + ) + + tryCatch( + httr2::req_perform(request), + httr2_error = function(cnd) { + if (vb) { + message("PUT failed for signed URL: ", conditionMessage(cnd)) + } + NULL + } + ) +} + +#' Normalize the `part_urls` element returned by `initiate_upload()`. +#' +#' Each entry is `list(part_number = int, url = string)`. We sort by +#' part_number to be defensive against server ordering. +#' @noRd +normalize_part_urls <- function(part_urls) { + assertthat::assert_that( + is.list(part_urls), length(part_urls) >= 1, + msg = "part_urls must be a non-empty list" + ) + numbers <- vapply(part_urls, function(p) as.integer(p$part_number), integer(1)) + part_urls[order(numbers)] +} diff --git a/man/complete_upload.Rd b/man/complete_upload.Rd new file mode 100644 index 00000000..a52623ad --- /dev/null +++ b/man/complete_upload.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/complete_upload.R +\name{complete_upload} +\alias{complete_upload} +\title{Complete a Multipart Upload} +\usage{ +complete_upload( + upload_guid, + s3_upload_id, + parts, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{upload_guid}{Character GUID returned in \code{initiate_upload()$upload_guid}.} + +\item{s3_upload_id}{Character S3 upload ID returned in +\code{initiate_upload()$s3_upload_id}.} + +\item{parts}{A list of one entry per part, each a list with +\code{part_number} (positive integer) and \code{etag} (character, +from the \code{ETag} response header of the part PUT). Order is not +significant -- the server sorts by \code{part_number}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} on success, \code{NULL} on failure. +} +\description{ +Tell the Databrary API that all parts of a multipart upload +have been PUT to S3 and the object can be assembled. The server forwards +the part list to S3's \code{CompleteMultipartUpload}, transitioning the +upload into the post-upload pipeline (virus scan, format probe). + +Only needed when \code{initiate_upload()} returned +\code{upload_type == "multipart"}. Single-PUT uploads complete implicitly +once the object lands in storage. +} +\examples{ +\donttest{ +\dontrun{ +complete_upload( + upload_guid = "abc...", + s3_upload_id = "xyz...", + parts = list( + list(part_number = 1L, etag = "etag-of-part-1"), + list(part_number = 2L, etag = "etag-of-part-2") + ) +) +} +} +} +\seealso{ +\code{\link{initiate_upload}}, \code{\link{upload_file}} +} diff --git a/man/get_upload_status.Rd b/man/get_upload_status.Rd new file mode 100644 index 00000000..c1ed07bb --- /dev/null +++ b/man/get_upload_status.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_upload_status.R +\name{get_upload_status} +\alias{get_upload_status} +\title{Get the Current Status of an Upload} +\usage{ +get_upload_status( + status_url = NULL, + upload_guid = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{status_url}{Absolute URL returned by \code{initiate_upload()} under +\code{status_url}. Mutually exclusive with \code{upload_guid}.} + +\item{upload_guid}{Character upload GUID. Mutually exclusive with +\code{status_url}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A length-1 character string with the status (e.g. +\code{"scanning"}, \code{"completed"}, \code{"infected"}, +\code{"upload_failed"}, \code{"processing_failed"} on the AWS +deployment; raw \code{Upload.status} on the core deployment). Returns +\code{NULL} if the request fails. +} +\description{ +Poll the Databrary API for the lifecycle state of an upload +started with \code{\link{initiate_upload}}. The returned status reflects +both the storage-side transfer and the post-upload server pipeline +(e.g. virus scan, format probe). + +Accepts either the absolute \code{status_url} returned by +\code{initiate_upload()} (preferred -- avoids a second URL build) or +the upload's \code{upload_guid}. +} +\examples{ +\donttest{ +\dontrun{ +init <- initiate_upload( + filename = "clip.mp4", + destination_type = "session", + object_id = 42 +) +get_upload_status(status_url = init$status_url) +} +} +} +\seealso{ +\code{\link{initiate_upload}}, \code{\link{upload_file}} +} diff --git a/man/initiate_upload.Rd b/man/initiate_upload.Rd new file mode 100644 index 00000000..03e27b33 --- /dev/null +++ b/man/initiate_upload.Rd @@ -0,0 +1,83 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/initiate_upload.R +\name{initiate_upload} +\alias{initiate_upload} +\title{Initiate a File Upload} +\usage{ +initiate_upload( + filename, + destination_type, + object_id, + file_size = NULL, + content_type = NULL, + source_session_id = NULL, + source_folder_id = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{filename}{Display filename. Required, non-empty.} + +\item{destination_type}{Where the upload will live. One of +\code{"session"}, \code{"folder"}, \code{"linked_volume_session"}, +\code{"linked_volume_folder"} (server validates). Required.} + +\item{object_id}{Positive integer ID of the destination object (session +or folder, depending on \code{destination_type}). Required.} + +\item{file_size}{File size in bytes. Optional but strongly recommended: +the AWS deployment uses this to decide multipart vs single PUT.} + +\item{content_type}{MIME type of the file (e.g. \code{"video/mp4"}). +Optional but recommended; some storage backends require it.} + +\item{source_session_id}{Required when +\code{destination_type == "linked_volume_session"}; positive integer.} + +\item{source_folder_id}{Required when +\code{destination_type == "linked_volume_folder"}; positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A named list describing the upload. Always contains +\code{status_url}. For a single PUT (the on-prem core deployment, or +any AWS upload smaller than the multipart threshold), contains +\code{signed_upload_url} and \code{required_headers} (may be empty). +For a multipart upload, contains \code{upload_type = "multipart"}, +\code{upload_guid}, \code{s3_upload_id}, \code{part_urls} (a list of +\code{list(part_number, url)}), and \code{part_size}. Returns +\code{NULL} if the request fails. +} +\description{ +Ask the Databrary API to register a pending upload and return +the signed URL(s) needed to PUT file bytes directly to object storage. The +server decides whether to issue a single-PUT or a multipart upload based on +\code{file_size} and the deployment's storage backend (S3 multipart on the +AI/AWS deployment, single PUT on the on-prem core deployment). + +This is the first step of the upload pipeline; pass the returned object to +\code{\link{upload_file}} (high level) or use the returned URLs directly +with \code{httr2::req_perform()} for fine-grained control. +} +\examples{ +\donttest{ +\dontrun{ +# Initiate a small upload to a session +init <- initiate_upload( + filename = "clip_001.mp4", + destination_type = "session", + object_id = 42, + file_size = 1024L * 1024L, + content_type = "video/mp4" +) +} +} +} +\seealso{ +\code{\link{upload_file}}, \code{\link{get_upload_status}}, +\code{\link{complete_upload}} +} diff --git a/man/upload_file.Rd b/man/upload_file.Rd new file mode 100644 index 00000000..be2f373c --- /dev/null +++ b/man/upload_file.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/upload_file.R +\name{upload_file} +\alias{upload_file} +\title{Upload a Local File to Databrary} +\usage{ +upload_file( + path, + destination_type, + object_id, + filename = NULL, + content_type = NULL, + source_session_id = NULL, + source_folder_id = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{path}{Path to the local file. Must exist and be readable.} + +\item{destination_type}{See \code{\link{initiate_upload}}.} + +\item{object_id}{See \code{\link{initiate_upload}}.} + +\item{filename}{Optional display filename; defaults to \code{basename(path)}.} + +\item{content_type}{Optional MIME type; auto-detected from the file +extension when not supplied.} + +\item{source_session_id}{See \code{\link{initiate_upload}}.} + +\item{source_folder_id}{See \code{\link{initiate_upload}}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A named list with \code{upload_guid} (when known), +\code{status_url}, and \code{upload_type}. Returns \code{NULL} if any +step fails. +} +\description{ +High-level wrapper around the upload pipeline: +\code{\link{initiate_upload}} -> PUT bytes to the signed URL(s) -> +\code{\link{complete_upload}} (multipart only). Returns the metadata +needed to poll progress with \code{\link{get_upload_status}}. + +Picks the upload mode the server returned: single PUT on the on-prem +core deployment or for small files on AWS, S3 multipart for large files +on AWS. +} +\examples{ +\donttest{ +\dontrun{ +info <- upload_file( + path = "/tmp/clip.mp4", + destination_type = "session", + object_id = 42 +) +get_upload_status(status_url = info$status_url) +} +} +} +\seealso{ +\code{\link{initiate_upload}}, \code{\link{get_upload_status}}, +\code{\link{complete_upload}} +} diff --git a/tests/testthat/test-complete_upload.R b/tests/testthat/test-complete_upload.R new file mode 100644 index 00000000..4b162f9f --- /dev/null +++ b/tests/testthat/test-complete_upload.R @@ -0,0 +1,55 @@ +# complete_upload() ------------------------------------------------------------ +login_test_account() + +test_that("complete_upload validates required args", { + expect_error(complete_upload( + upload_guid = "", s3_upload_id = "x", + parts = list(list(part_number = 1L, etag = "e")) + )) + expect_error(complete_upload( + upload_guid = "g", s3_upload_id = "", + parts = list(list(part_number = 1L, etag = "e")) + )) + expect_error(complete_upload( + upload_guid = "g", s3_upload_id = "x", parts = list() + )) + expect_error(complete_upload( + upload_guid = "g", s3_upload_id = "x", + parts = list(list(part_number = 0L, etag = "e")) + )) + expect_error(complete_upload( + upload_guid = "g", s3_upload_id = "x", + parts = list(list(part_number = 1L, etag = "")) + )) + expect_error(complete_upload( + upload_guid = "g", s3_upload_id = "x", + parts = list(list(part_number = 1L)) + )) + expect_error(complete_upload( + upload_guid = "g", s3_upload_id = "x", + parts = list(list(etag = "e")) + )) +}) + +test_that("complete_upload returns NULL for unknown upload_guid", { + res <- complete_upload( + upload_guid = "00000000-0000-0000-0000-000000000000", + s3_upload_id = "not-a-real-upload-id", + parts = list(list(part_number = 1L, etag = "deadbeef")), + vb = FALSE + ) + expect_null(res) +}) + +test_that("complete_upload rejects invalid vb / rq", { + expect_error(complete_upload( + upload_guid = "g", s3_upload_id = "x", + parts = list(list(part_number = 1L, etag = "e")), + vb = "yes" + )) + expect_error(complete_upload( + upload_guid = "g", s3_upload_id = "x", + parts = list(list(part_number = 1L, etag = "e")), + rq = "not-a-request" + )) +}) diff --git a/tests/testthat/test-get_upload_status.R b/tests/testthat/test-get_upload_status.R new file mode 100644 index 00000000..bc66fa39 --- /dev/null +++ b/tests/testthat/test-get_upload_status.R @@ -0,0 +1,55 @@ +# get_upload_status() ---------------------------------------------------------- +login_test_account() + +TEST_VOL <- 1777 + +test_that("get_upload_status requires exactly one identifier", { + expect_error(get_upload_status()) + expect_error(get_upload_status( + status_url = "https://x/y", upload_guid = "abc" + )) +}) + +test_that("get_upload_status validates identifier shape", { + expect_error(get_upload_status(status_url = "")) + expect_error(get_upload_status(status_url = c("a", "b"))) + expect_error(get_upload_status(upload_guid = "")) + expect_error(get_upload_status(upload_guid = 123)) +}) + +test_that("get_upload_status returns NULL for unknown guid", { + # A well-formed but non-existent GUID should fail cleanly. + res <- get_upload_status( + upload_guid = "00000000-0000-0000-0000-000000000000", + vb = FALSE + ) + expect_null(res) +}) + +test_that("get_upload_status returns a status string for a real upload", { + session <- create_session( + vol_id = TEST_VOL, name = "get_upload_status test", vb = FALSE + ) + skip_if_null_response(session, "create_session for get_upload_status") + on.exit( + delete_session(vol_id = TEST_VOL, session_id = session$id, vb = FALSE), + add = TRUE + ) + + init <- initiate_upload( + filename = "status_probe.mp4", + destination_type = "session", + object_id = session$id, + file_size = 1024L, + content_type = "video/mp4", + vb = FALSE + ) + skip_if_null_response(init, "initiate_upload for get_upload_status") + + status <- get_upload_status(status_url = init$status_url, vb = FALSE) + skip_if_null_response(status, "get_upload_status by URL") + + expect_type(status, "character") + expect_length(status, 1) + expect_true(nzchar(status)) +}) diff --git a/tests/testthat/test-initiate_upload.R b/tests/testthat/test-initiate_upload.R new file mode 100644 index 00000000..fab64d64 --- /dev/null +++ b/tests/testthat/test-initiate_upload.R @@ -0,0 +1,114 @@ +# initiate_upload() ------------------------------------------------------------ +login_test_account() + +TEST_VOL <- 1777 + +new_session_id <- function(name = "initiate_upload test") { + created <- create_session(vol_id = TEST_VOL, name = name, vb = FALSE) + skip_if_null_response(created, "create_session for initiate_upload test") + created$id +} + +test_that("initiate_upload validates required args", { + expect_error(initiate_upload( + filename = "", destination_type = "session", object_id = 1 + )) + expect_error(initiate_upload( + filename = NULL, destination_type = "session", object_id = 1 + )) + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "", object_id = 1 + )) + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = 0 + )) + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = "1" + )) + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = 1.5 + )) +}) + +test_that("initiate_upload rejects optional args of wrong shape", { + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = 1, + file_size = -1 + )) + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = 1, + file_size = "100" + )) + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = 1, + content_type = "" + )) + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = 1, + content_type = c("video/mp4", "video/quicktime") + )) +}) + +test_that("initiate_upload requires source_session_id for linked_volume_session", { + expect_error(initiate_upload( + filename = "a.mp4", + destination_type = "linked_volume_session", + object_id = 1 + )) +}) + +test_that("initiate_upload requires source_folder_id for linked_volume_folder", { + expect_error(initiate_upload( + filename = "a.mp4", + destination_type = "linked_volume_folder", + object_id = 1 + )) +}) + +test_that("initiate_upload rejects invalid vb / rq", { + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = 1, + vb = "yes" + )) + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = 1, + rq = "not-a-request" + )) +}) + +test_that("initiate_upload returns signed url and status_url for a session", { + sid <- new_session_id("initiate_upload happy path") + on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) + + result <- initiate_upload( + filename = "test_clip.mp4", + destination_type = "session", + object_id = sid, + file_size = 1024L, + content_type = "video/mp4", + vb = FALSE + ) + skip_if_null_response(result, "initiate_upload happy path") + + expect_type(result, "list") + expect_true(!is.null(result$status_url)) + expect_true(!is.null(result$upload_type)) + # Either a single PUT with signed_upload_url, or multipart with part_urls + if (identical(result$upload_type, "multipart")) { + expect_true(!is.null(result$part_urls)) + expect_true(!is.null(result$s3_upload_id)) + expect_true(!is.null(result$upload_guid)) + } else { + expect_true(!is.null(result$signed_upload_url)) + } +}) + +test_that("initiate_upload returns NULL for nonexistent destination", { + expect_null(initiate_upload( + filename = "test.mp4", + destination_type = "session", + object_id = 999999999, + file_size = 1024L, + vb = FALSE + )) +}) diff --git a/tests/testthat/test-upload_file.R b/tests/testthat/test-upload_file.R new file mode 100644 index 00000000..0b21958c --- /dev/null +++ b/tests/testthat/test-upload_file.R @@ -0,0 +1,124 @@ +# upload_file() ---------------------------------------------------------------- +login_test_account() + +TEST_VOL <- 1777 + +test_that("upload_file rejects missing or empty path", { + expect_error(upload_file( + path = "/nope/does/not/exist", destination_type = "session", object_id = 1 + )) + expect_error(upload_file( + path = "", destination_type = "session", object_id = 1 + )) +}) + +test_that("upload_file rejects empty file", { + empty <- tempfile() + file.create(empty) + on.exit(unlink(empty), add = TRUE) + expect_error(upload_file( + path = empty, destination_type = "session", object_id = 1 + )) +}) + +test_that("upload_file uploads a small file end-to-end", { + session <- create_session( + vol_id = TEST_VOL, name = "upload_file test", vb = FALSE + ) + skip_if_null_response(session, "create_session for upload_file") + on.exit( + delete_session(vol_id = TEST_VOL, session_id = session$id, vb = FALSE), + add = TRUE + ) + + tmp <- tempfile(fileext = ".bin") + on.exit(unlink(tmp), add = TRUE) + writeBin(as.raw(seq_len(1024L) %% 256L), tmp) + + result <- upload_file( + path = tmp, + destination_type = "session", + object_id = session$id, + content_type = "application/octet-stream", + vb = FALSE + ) + skip_if_null_response(result, "upload_file end-to-end") + + expect_type(result, "list") + expect_true(!is.null(result$status_url)) + expect_true(result$upload_type %in% c("single", "multipart")) +}) + +test_that("upload_file infers filename and content_type", { + session <- create_session( + vol_id = TEST_VOL, name = "upload_file inference test", vb = FALSE + ) + skip_if_null_response(session, "create_session for upload_file inference") + on.exit( + delete_session(vol_id = TEST_VOL, session_id = session$id, vb = FALSE), + add = TRUE + ) + + tmp <- tempfile(fileext = ".mp4") + on.exit(unlink(tmp), add = TRUE) + writeBin(as.raw(seq_len(1024L) %% 256L), tmp) + + result <- upload_file( + path = tmp, + destination_type = "session", + object_id = session$id, + vb = FALSE + ) + skip_if_null_response(result, "upload_file inference") + + expect_type(result, "list") +}) + +# Internal helpers ------------------------------------------------------------- + +test_that("read_file_chunk reads a byte range", { + tmp <- withr::local_tempfile() + writeBin(as.raw(0:255), tmp) + + expect_equal(databraryr:::read_file_chunk(tmp, 0, 4), as.raw(0:3)) + expect_equal(databraryr:::read_file_chunk(tmp, 10, 3), as.raw(10:12)) + # Past EOF returns whatever remains. + expect_equal( + length(databraryr:::read_file_chunk(tmp, 250, 100)), + 6L + ) +}) + +test_that("unquote_etag strips surrounding quotes", { + expect_equal(databraryr:::unquote_etag('"abc123"'), "abc123") + expect_equal(databraryr:::unquote_etag("abc123"), "abc123") + expect_equal(databraryr:::unquote_etag(""), "") + expect_null(databraryr:::unquote_etag(NULL)) +}) + +test_that("normalize_part_urls sorts by part_number", { + shuffled <- list( + list(part_number = 3L, url = "c"), + list(part_number = 1L, url = "a"), + list(part_number = 2L, url = "b") + ) + sorted <- databraryr:::normalize_part_urls(shuffled) + expect_equal( + vapply(sorted, function(p) p$url, character(1)), + c("a", "b", "c") + ) +}) + +test_that("guess_content_type maps common extensions", { + expect_equal(databraryr:::guess_content_type("a.mp4"), "video/mp4") + expect_equal(databraryr:::guess_content_type("a.MP4"), "video/mp4") + expect_equal(databraryr:::guess_content_type("a.csv"), "text/csv") + expect_equal( + databraryr:::guess_content_type("a.unknown"), + "application/octet-stream" + ) + expect_equal( + databraryr:::guess_content_type("noext"), + "application/octet-stream" + ) +}) From 8a25c760fa309a3adb40e98c11ca0b89673a0428 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Tue, 12 May 2026 09:29:52 +0200 Subject: [PATCH 59/77] chore: fix checks --- .Rbuildignore | 3 +++ tests/testthat/test-upload_file.R | 3 ++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/.Rbuildignore b/.Rbuildignore index e45b970f..b511a8ce 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -15,3 +15,6 @@ ^CRAN-SUBMISSION$ ^README.Rmd$ ^\.Renviron\.stg$ +^\.Renviron$ +^\.vscode$ +^\.Rprofile$ diff --git a/tests/testthat/test-upload_file.R b/tests/testthat/test-upload_file.R index 0b21958c..59d7a781 100644 --- a/tests/testthat/test-upload_file.R +++ b/tests/testthat/test-upload_file.R @@ -77,7 +77,8 @@ test_that("upload_file infers filename and content_type", { # Internal helpers ------------------------------------------------------------- test_that("read_file_chunk reads a byte range", { - tmp <- withr::local_tempfile() + tmp <- tempfile() + on.exit(unlink(tmp), add = TRUE) writeBin(as.raw(0:255), tmp) expect_equal(databraryr:::read_file_chunk(tmp, 0, 4), as.raw(0:3)) From 2ee0a7b20bb88c04fdfa58eacd5c7607a4aaad53 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Tue, 12 May 2026 12:40:44 +0200 Subject: [PATCH 60/77] feat: add update/patch/delete_session_file() for file metadata management --- NAMESPACE | 3 + R/delete_session_file.R | 62 +++++++++ R/patch_session_file.R | 159 ++++++++++++++++++++++ R/update_session_file.R | 136 ++++++++++++++++++ man/delete_session_file.Rd | 45 ++++++ man/patch_session_file.Rd | 84 ++++++++++++ man/update_session_file.Rd | 77 +++++++++++ tests/testthat/test-delete_session_file.R | 66 +++++++++ tests/testthat/test-patch_session_file.R | 111 +++++++++++++++ tests/testthat/test-update_session_file.R | 103 ++++++++++++++ 10 files changed, 846 insertions(+) create mode 100644 R/delete_session_file.R create mode 100644 R/patch_session_file.R create mode 100644 R/update_session_file.R create mode 100644 man/delete_session_file.Rd create mode 100644 man/patch_session_file.Rd create mode 100644 man/update_session_file.Rd create mode 100644 tests/testthat/test-delete_session_file.R create mode 100644 tests/testthat/test-patch_session_file.R create mode 100644 tests/testthat/test-update_session_file.R diff --git a/NAMESPACE b/NAMESPACE index 3ca8dda8..be282854 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,6 +12,7 @@ export(create_session) export(create_volume_record) export(delete_record_measure) export(delete_session) +export(delete_session_file) export(delete_volume_record) export(disable_volume_category) export(download_folder_asset) @@ -80,6 +81,7 @@ export(logout_db) export(make_default_request) export(make_login_client) export(patch_session) +export(patch_session_file) export(remove_default_record_from_session) export(search_for_funder) export(search_for_tags) @@ -90,6 +92,7 @@ export(set_record_measure) export(set_volume_enabled_categories) export(unassign_record_from_file) export(update_session) +export(update_session_file) export(update_volume_record) export(upload_file) export(whoami) diff --git a/R/delete_session_file.R b/R/delete_session_file.R new file mode 100644 index 00000000..d4330c69 --- /dev/null +++ b/R/delete_session_file.R @@ -0,0 +1,62 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Delete a Session File from a Databrary Volume +#' +#' @description Delete (soft-delete) a file from a Databrary session. The file +#' is marked as deleted on the server but not permanently removed. A second +#' delete on the same file returns \code{FALSE}, not an error. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param file_id Numeric file identifier. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} if the file was successfully deleted, \code{FALSE} +#' otherwise. +#' +#' @seealso \code{\link{update_session_file}}, \code{\link{patch_session_file}}, +#' \code{\link{get_session_file}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' delete_session_file(vol_id = 1, session_id = 42, file_id = 99) +#' } +#' } +#' @export +delete_session_file <- function( + vol_id = 1, + session_id, + file_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer(file_id, "file_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + success <- perform_api_delete( + path = sprintf(API_SESSION_FILE_DETAIL, vol_id, session_id, file_id), + rq = rq, + vb = vb + ) + + if (!success) { + if (vb) { + message( + "Failed to delete file ", file_id, + " from session ", session_id, + " in volume ", vol_id + ) + } + } + + success +} diff --git a/R/patch_session_file.R b/R/patch_session_file.R new file mode 100644 index 00000000..f4815423 --- /dev/null +++ b/R/patch_session_file.R @@ -0,0 +1,159 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Partially Update a Session File's Metadata +#' +#' @description Sends a PATCH request to update selected metadata fields of an +#' existing session file. Only provided arguments are sent; omitted fields are +#' left unchanged on the server. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param file_id Numeric file identifier. Must be a positive integer. +#' @param name Optional new file name. If provided, must be a non-empty +#' length-1 string. +#' @param release_level Optional release level (e.g. \code{"PRIVATE"}, +#' \code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). Server validates +#' the choice. +#' @param source_date Optional file date. A length-1 \code{Date} object or +#' ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}. +#' @param date Optional structured date list with named fields \code{year}, +#' \code{month}, \code{day}, and optional \code{is_estimated} (logical). +#' Mutually exclusive with \code{source_date}. +#' @param date_precision Optional precision for \code{date}: e.g. +#' \code{"FULL"}, \code{"YEAR"}. +#' @param is_estimated Optional logical flag indicating whether the date is +#' estimated. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the updated file's metadata (same shape as +#' \code{\link{get_session_file}}), or \code{NULL} if the update fails or +#' no fields were provided. +#' +#' @seealso \code{\link{update_session_file}}, \code{\link{delete_session_file}}, +#' \code{\link{get_session_file}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Rename a file +#' patch_session_file( +#' vol_id = 1, session_id = 42, file_id = 99, name = "Renamed.mp4" +#' ) +#' +#' # Update the date and precision +#' patch_session_file( +#' vol_id = 1, +#' session_id = 42, +#' file_id = 99, +#' date = list(year = 2024, month = 3, day = 15), +#' date_precision = "FULL" +#' ) +#' } +#' } +#' @export +patch_session_file <- function( + vol_id = 1, + session_id, + file_id, + name = NULL, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + is_estimated = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer(file_id, "file_id") + + if (!is.null(name)) { + assertthat::assert_that(is.character(name), length(name) == 1) + assertthat::assert_that( + nzchar(trimws(name)), + msg = "name must not be empty" + ) + } + + if (!is.null(release_level)) { + assertthat::assert_that( + is.character(release_level), + length(release_level) == 1, + nzchar(trimws(release_level)) + ) + } + + assertthat::assert_that( + is.null(source_date) || is.null(date), + msg = "Provide either source_date or date, not both." + ) + + if (!is.null(date)) { + assertthat::assert_that( + is.list(date), + !is.null(names(date)), + msg = "date must be a named list (e.g. list(year=, month=, day=))" + ) + } + + if (!is.null(date_precision)) { + assertthat::assert_that( + is.character(date_precision), + length(date_precision) == 1, + nzchar(trimws(date_precision)) + ) + } + + if (!is.null(is_estimated)) { + assertthat::assert_that(is.logical(is_estimated), length(is_estimated) == 1) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list() + if (!is.null(name)) body$name <- name + if (!is.null(release_level)) body$release_level <- release_level + if (!is.null(source_date)) { + body$source_date <- coerce_iso_date(source_date, "source_date") + } + if (!is.null(date)) body$date <- date + if (!is.null(date_precision)) body$date_precision <- date_precision + if (!is.null(is_estimated)) body$is_estimated <- is_estimated + + if (length(body) == 0) { + if (vb) { + message( + "No fields provided to update for file ", file_id, + " in session ", session_id + ) + } + return(NULL) + } + + file <- perform_api_patch( + path = sprintf(API_SESSION_FILE_DETAIL, vol_id, session_id, file_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(file)) { + if (vb) { + message( + "Failed to update file ", file_id, + " in session ", session_id, + " of volume ", vol_id + ) + } + return(NULL) + } + + file +} diff --git a/R/update_session_file.R b/R/update_session_file.R new file mode 100644 index 00000000..77a530b5 --- /dev/null +++ b/R/update_session_file.R @@ -0,0 +1,136 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Replace a Session File's Metadata (PUT) +#' +#' @description Sends a PUT request to fully replace a session file's writable +#' metadata fields. \code{name} is required (non-empty); other fields are +#' optional and default to server-side values when omitted. Use +#' \code{\link{patch_session_file}} for partial updates when you don't want +#' full-replacement semantics. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param file_id Numeric file identifier. Must be a positive integer. +#' @param name New file name. Required, non-empty after trim. +#' @param release_level Optional release level (e.g. \code{"PRIVATE"}, +#' \code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). +#' @param source_date Optional file date. A length-1 \code{Date} object or +#' ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}. +#' @param date Optional structured date list with named fields \code{year}, +#' \code{month}, \code{day}, and optional \code{is_estimated} (logical). +#' Mutually exclusive with \code{source_date}. +#' @param date_precision Optional precision for \code{date}: e.g. +#' \code{"FULL"}, \code{"YEAR"}. +#' @param is_estimated Optional logical flag indicating whether the date is +#' estimated. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the updated file's metadata (same shape as +#' \code{\link{get_session_file}}), or \code{NULL} if the update fails. +#' +#' @seealso \code{\link{patch_session_file}}, \code{\link{delete_session_file}}, +#' \code{\link{get_session_file}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Rename a file via PUT +#' update_session_file( +#' vol_id = 1, +#' session_id = 42, +#' file_id = 99, +#' name = "Replacement name.mp4" +#' ) +#' } +#' } +#' @export +update_session_file <- function( + vol_id = 1, + session_id, + file_id, + name, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + is_estimated = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer(file_id, "file_id") + + assertthat::assert_that(is.character(name), length(name) == 1) + assertthat::assert_that(nzchar(trimws(name)), msg = "name must not be empty") + + if (!is.null(release_level)) { + assertthat::assert_that( + is.character(release_level), + length(release_level) == 1, + nzchar(trimws(release_level)) + ) + } + + assertthat::assert_that( + is.null(source_date) || is.null(date), + msg = "Provide either source_date or date, not both." + ) + + if (!is.null(date)) { + assertthat::assert_that( + is.list(date), + !is.null(names(date)), + msg = "date must be a named list (e.g. list(year=, month=, day=))" + ) + } + + if (!is.null(date_precision)) { + assertthat::assert_that( + is.character(date_precision), + length(date_precision) == 1, + nzchar(trimws(date_precision)) + ) + } + + if (!is.null(is_estimated)) { + assertthat::assert_that(is.logical(is_estimated), length(is_estimated) == 1) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list(name = name) + if (!is.null(release_level)) body$release_level <- release_level + if (!is.null(source_date)) { + body$source_date <- coerce_iso_date(source_date, "source_date") + } + if (!is.null(date)) body$date <- date + if (!is.null(date_precision)) body$date_precision <- date_precision + if (!is.null(is_estimated)) body$is_estimated <- is_estimated + + file <- perform_api_put( + path = sprintf(API_SESSION_FILE_DETAIL, vol_id, session_id, file_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(file)) { + if (vb) { + message( + "Failed to replace file ", file_id, + " in session ", session_id, + " of volume ", vol_id + ) + } + return(NULL) + } + + file +} diff --git a/man/delete_session_file.Rd b/man/delete_session_file.Rd new file mode 100644 index 00000000..8f62616d --- /dev/null +++ b/man/delete_session_file.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/delete_session_file.R +\name{delete_session_file} +\alias{delete_session_file} +\title{Delete a Session File from a Databrary Volume} +\usage{ +delete_session_file( + vol_id = 1, + session_id, + file_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{file_id}{Numeric file identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} if the file was successfully deleted, \code{FALSE} +otherwise. +} +\description{ +Delete (soft-delete) a file from a Databrary session. The file +is marked as deleted on the server but not permanently removed. A second +delete on the same file returns \code{FALSE}, not an error. +} +\examples{ +\donttest{ +\dontrun{ +delete_session_file(vol_id = 1, session_id = 42, file_id = 99) +} +} +} +\seealso{ +\code{\link{update_session_file}}, \code{\link{patch_session_file}}, +\code{\link{get_session_file}} +} diff --git a/man/patch_session_file.Rd b/man/patch_session_file.Rd new file mode 100644 index 00000000..5866b20f --- /dev/null +++ b/man/patch_session_file.Rd @@ -0,0 +1,84 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/patch_session_file.R +\name{patch_session_file} +\alias{patch_session_file} +\title{Partially Update a Session File's Metadata} +\usage{ +patch_session_file( + vol_id = 1, + session_id, + file_id, + name = NULL, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + is_estimated = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{file_id}{Numeric file identifier. Must be a positive integer.} + +\item{name}{Optional new file name. If provided, must be a non-empty +length-1 string.} + +\item{release_level}{Optional release level (e.g. \code{"PRIVATE"}, +\code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). Server validates +the choice.} + +\item{source_date}{Optional file date. A length-1 \code{Date} object or +ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}.} + +\item{date}{Optional structured date list with named fields \code{year}, +\code{month}, \code{day}, and optional \code{is_estimated} (logical). +Mutually exclusive with \code{source_date}.} + +\item{date_precision}{Optional precision for \code{date}: e.g. +\code{"FULL"}, \code{"YEAR"}.} + +\item{is_estimated}{Optional logical flag indicating whether the date is +estimated.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the updated file's metadata (same shape as +\code{\link{get_session_file}}), or \code{NULL} if the update fails or +no fields were provided. +} +\description{ +Sends a PATCH request to update selected metadata fields of an +existing session file. Only provided arguments are sent; omitted fields are +left unchanged on the server. +} +\examples{ +\donttest{ +\dontrun{ +# Rename a file +patch_session_file( + vol_id = 1, session_id = 42, file_id = 99, name = "Renamed.mp4" +) + +# Update the date and precision +patch_session_file( + vol_id = 1, + session_id = 42, + file_id = 99, + date = list(year = 2024, month = 3, day = 15), + date_precision = "FULL" +) +} +} +} +\seealso{ +\code{\link{update_session_file}}, \code{\link{delete_session_file}}, +\code{\link{get_session_file}} +} diff --git a/man/update_session_file.Rd b/man/update_session_file.Rd new file mode 100644 index 00000000..3e574c48 --- /dev/null +++ b/man/update_session_file.Rd @@ -0,0 +1,77 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/update_session_file.R +\name{update_session_file} +\alias{update_session_file} +\title{Replace a Session File's Metadata (PUT)} +\usage{ +update_session_file( + vol_id = 1, + session_id, + file_id, + name, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + is_estimated = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{file_id}{Numeric file identifier. Must be a positive integer.} + +\item{name}{New file name. Required, non-empty after trim.} + +\item{release_level}{Optional release level (e.g. \code{"PRIVATE"}, +\code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}).} + +\item{source_date}{Optional file date. A length-1 \code{Date} object or +ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}.} + +\item{date}{Optional structured date list with named fields \code{year}, +\code{month}, \code{day}, and optional \code{is_estimated} (logical). +Mutually exclusive with \code{source_date}.} + +\item{date_precision}{Optional precision for \code{date}: e.g. +\code{"FULL"}, \code{"YEAR"}.} + +\item{is_estimated}{Optional logical flag indicating whether the date is +estimated.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the updated file's metadata (same shape as +\code{\link{get_session_file}}), or \code{NULL} if the update fails. +} +\description{ +Sends a PUT request to fully replace a session file's writable +metadata fields. \code{name} is required (non-empty); other fields are +optional and default to server-side values when omitted. Use +\code{\link{patch_session_file}} for partial updates when you don't want +full-replacement semantics. +} +\examples{ +\donttest{ +\dontrun{ +# Rename a file via PUT +update_session_file( + vol_id = 1, + session_id = 42, + file_id = 99, + name = "Replacement name.mp4" +) +} +} +} +\seealso{ +\code{\link{patch_session_file}}, \code{\link{delete_session_file}}, +\code{\link{get_session_file}} +} diff --git a/tests/testthat/test-delete_session_file.R b/tests/testthat/test-delete_session_file.R new file mode 100644 index 00000000..06ace953 --- /dev/null +++ b/tests/testthat/test-delete_session_file.R @@ -0,0 +1,66 @@ +# delete_session_file() -------------------------------------------------------- +login_test_account() + +test_that("delete_session_file returns FALSE for non-existent file", { + expect_false( + delete_session_file( + vol_id = 1777, + session_id = 999999999, + file_id = 999999999, + vb = FALSE + ) + ) +}) + +test_that("delete_session_file rejects invalid vol_id", { + expect_error(delete_session_file(vol_id = -1, session_id = 1, file_id = 1)) + expect_error(delete_session_file(vol_id = 0, session_id = 1, file_id = 1)) + expect_error(delete_session_file(vol_id = "1", session_id = 1, file_id = 1)) + expect_error(delete_session_file(vol_id = TRUE, session_id = 1, file_id = 1)) + expect_error(delete_session_file(vol_id = list(a = 1), session_id = 1, file_id = 1)) + expect_error(delete_session_file(vol_id = c(1, 2), session_id = 1, file_id = 1)) + expect_error(delete_session_file(vol_id = 1.5, session_id = 1, file_id = 1)) + expect_error(delete_session_file(vol_id = NULL, session_id = 1, file_id = 1)) + expect_error(delete_session_file(vol_id = NA, session_id = 1, file_id = 1)) +}) + +test_that("delete_session_file rejects invalid session_id", { + expect_error(delete_session_file(vol_id = 1777, session_id = -1, file_id = 1)) + expect_error(delete_session_file(vol_id = 1777, session_id = 0, file_id = 1)) + expect_error(delete_session_file(vol_id = 1777, session_id = "1", file_id = 1)) + expect_error(delete_session_file(vol_id = 1777, session_id = TRUE, file_id = 1)) + expect_error(delete_session_file(vol_id = 1777, session_id = list(a = 1), file_id = 1)) + expect_error(delete_session_file(vol_id = 1777, session_id = c(1, 2), file_id = 1)) + expect_error(delete_session_file(vol_id = 1777, session_id = 1.5, file_id = 1)) + expect_error(delete_session_file(vol_id = 1777, session_id = NULL, file_id = 1)) + expect_error(delete_session_file(vol_id = 1777, session_id = NA, file_id = 1)) +}) + +test_that("delete_session_file rejects invalid file_id", { + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = -1)) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 0)) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = "1")) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = TRUE)) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = list(a = 1))) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = c(1, 2))) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1.5)) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = NULL)) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = NA)) +}) + +test_that("delete_session_file rejects invalid vb parameter", { + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, vb = -1)) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, vb = 3)) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, vb = "a")) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, vb = list(a = 1))) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, vb = NULL)) +}) + +test_that("delete_session_file rejects invalid rq parameter", { + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, rq = "a")) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, rq = -1)) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, rq = c(2, 3))) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, rq = list(a = 1))) + expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, rq = TRUE)) +}) diff --git a/tests/testthat/test-patch_session_file.R b/tests/testthat/test-patch_session_file.R new file mode 100644 index 00000000..679b7de5 --- /dev/null +++ b/tests/testthat/test-patch_session_file.R @@ -0,0 +1,111 @@ +# patch_session_file() --------------------------------------------------------- +login_test_account() + +test_that("patch_session_file returns NULL when no fields provided", { + expect_null( + patch_session_file( + vol_id = 1777, + session_id = 1, + file_id = 1, + vb = FALSE + ) + ) +}) + +test_that("patch_session_file returns NULL for non-existent file", { + result <- patch_session_file( + vol_id = 1777, + session_id = 999999999, + file_id = 999999999, + name = "nope", + vb = FALSE + ) + expect_null(result) +}) + +test_that("patch_session_file rejects invalid name", { + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "")) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = " ")) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = 123)) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = c("A", "B"))) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = NA)) +}) + +test_that("patch_session_file rejects providing both source_date and date", { + expect_error( + patch_session_file( + vol_id = 1777, + session_id = 1, + file_id = 1, + source_date = "2024-03-15", + date = list(year = 2024, month = 3, day = 15) + ) + ) +}) + +test_that("patch_session_file rejects malformed source_date", { + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, source_date = "not-a-date")) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, source_date = "")) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, source_date = 123)) +}) + +test_that("patch_session_file rejects malformed date", { + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, date = "2024-03-15")) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, date = list(2024, 3, 15))) +}) + +test_that("patch_session_file rejects invalid release_level", { + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, release_level = "")) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, release_level = 1)) +}) + +test_that("patch_session_file rejects invalid date_precision", { + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, date_precision = "")) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, date_precision = 1)) +}) + +test_that("patch_session_file rejects invalid is_estimated", { + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, is_estimated = "yes")) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, is_estimated = c(TRUE, FALSE))) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, is_estimated = 1)) +}) + +test_that("patch_session_file rejects invalid vol_id", { + expect_error(patch_session_file(vol_id = -1, session_id = 1, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 0, session_id = 1, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = "1", session_id = 1, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = TRUE, session_id = 1, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = c(1, 2), session_id = 1, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1.5, session_id = 1, file_id = 1, name = "x")) +}) + +test_that("patch_session_file rejects invalid session_id", { + expect_error(patch_session_file(vol_id = 1777, session_id = -1, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1777, session_id = 0, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1777, session_id = "1", file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1777, session_id = TRUE, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1777, session_id = c(1, 2), file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1777, session_id = 1.5, file_id = 1, name = "x")) +}) + +test_that("patch_session_file rejects invalid file_id", { + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = -1, name = "x")) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 0, name = "x")) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = "1", name = "x")) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = TRUE, name = "x")) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = c(1, 2), name = "x")) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1.5, name = "x")) +}) + +test_that("patch_session_file rejects invalid vb parameter", { + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", vb = -1)) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", vb = "a")) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", vb = NULL)) +}) + +test_that("patch_session_file rejects invalid rq parameter", { + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", rq = "a")) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", rq = -1)) + expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", rq = TRUE)) +}) diff --git a/tests/testthat/test-update_session_file.R b/tests/testthat/test-update_session_file.R new file mode 100644 index 00000000..f90f2c02 --- /dev/null +++ b/tests/testthat/test-update_session_file.R @@ -0,0 +1,103 @@ +# update_session_file() -------------------------------------------------------- +login_test_account() + +test_that("update_session_file returns NULL for non-existent file", { + result <- update_session_file( + vol_id = 1777, + session_id = 999999999, + file_id = 999999999, + name = "nope", + vb = FALSE + ) + expect_null(result) +}) + +test_that("update_session_file rejects missing/invalid name", { + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1)) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "")) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = " ")) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = 123)) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = c("A", "B"))) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = NULL)) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = NA)) +}) + +test_that("update_session_file rejects providing both source_date and date", { + expect_error( + update_session_file( + vol_id = 1777, + session_id = 1, + file_id = 1, + name = "x", + source_date = "2024-03-15", + date = list(year = 2024, month = 3, day = 15) + ) + ) +}) + +test_that("update_session_file rejects malformed source_date", { + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", source_date = "not-a-date")) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", source_date = "")) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", source_date = 123)) +}) + +test_that("update_session_file rejects malformed date", { + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", date = "2024-03-15")) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", date = list(2024, 3, 15))) +}) + +test_that("update_session_file rejects invalid release_level", { + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", release_level = "")) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", release_level = 1)) +}) + +test_that("update_session_file rejects invalid date_precision", { + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", date_precision = "")) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", date_precision = 1)) +}) + +test_that("update_session_file rejects invalid is_estimated", { + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", is_estimated = "yes")) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", is_estimated = c(TRUE, FALSE))) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", is_estimated = 1)) +}) + +test_that("update_session_file rejects invalid vol_id", { + expect_error(update_session_file(vol_id = -1, session_id = 1, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 0, session_id = 1, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = "1", session_id = 1, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = TRUE, session_id = 1, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = c(1, 2), session_id = 1, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1.5, session_id = 1, file_id = 1, name = "x")) +}) + +test_that("update_session_file rejects invalid session_id", { + expect_error(update_session_file(vol_id = 1777, session_id = -1, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1777, session_id = 0, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1777, session_id = "1", file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1777, session_id = TRUE, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1777, session_id = c(1, 2), file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1777, session_id = 1.5, file_id = 1, name = "x")) +}) + +test_that("update_session_file rejects invalid file_id", { + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = -1, name = "x")) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 0, name = "x")) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = "1", name = "x")) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = TRUE, name = "x")) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = c(1, 2), name = "x")) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1.5, name = "x")) +}) + +test_that("update_session_file rejects invalid vb parameter", { + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", vb = -1)) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", vb = "a")) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", vb = NULL)) +}) + +test_that("update_session_file rejects invalid rq parameter", { + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", rq = "a")) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", rq = -1)) + expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", rq = TRUE)) +}) From 8810b82be4b0510a025f878d57a10ffa4b87b3dc Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Tue, 12 May 2026 17:17:42 +0200 Subject: [PATCH 61/77] feat: add folders CRUD (create/update/patch/delete + check-duplicate-files) --- NAMESPACE | 5 ++ R/CONSTANTS.R | 1 + R/check_duplicate_files_in_folder.R | 85 +++++++++++++++++++++ R/create_folder.R | 90 ++++++++++++++++++++++ R/delete_folder.R | 57 ++++++++++++++ R/patch_folder.R | 101 +++++++++++++++++++++++++ R/update_folder.R | 86 +++++++++++++++++++++ man/check_duplicate_files_in_folder.Rd | 47 ++++++++++++ man/create_folder.Rd | 60 +++++++++++++++ man/delete_folder.Rd | 37 +++++++++ man/patch_folder.Rd | 56 ++++++++++++++ man/update_folder.Rd | 54 +++++++++++++ 12 files changed, 679 insertions(+) create mode 100644 R/check_duplicate_files_in_folder.R create mode 100644 R/create_folder.R create mode 100644 R/delete_folder.R create mode 100644 R/patch_folder.R create mode 100644 R/update_folder.R create mode 100644 man/check_duplicate_files_in_folder.Rd create mode 100644 man/create_folder.Rd create mode 100644 man/delete_folder.Rd create mode 100644 man/patch_folder.Rd create mode 100644 man/update_folder.Rd diff --git a/NAMESPACE b/NAMESPACE index be282854..4088a9fa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,11 +5,14 @@ export(HHMMSSmmm_to_ms) export(add_default_record_to_session) export(assign_constants) export(assign_record_to_file) +export(check_duplicate_files_in_folder) export(check_duplicate_files_in_session) export(check_ssl_certs) export(complete_upload) +export(create_folder) export(create_session) export(create_volume_record) +export(delete_folder) export(delete_record_measure) export(delete_session) export(delete_session_file) @@ -80,6 +83,7 @@ export(login_db) export(logout_db) export(make_default_request) export(make_login_client) +export(patch_folder) export(patch_session) export(patch_session_file) export(remove_default_record_from_session) @@ -91,6 +95,7 @@ export(search_volumes) export(set_record_measure) export(set_volume_enabled_categories) export(unassign_record_from_file) +export(update_folder) export(update_session) export(update_session_file) export(update_volume_record) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 8c5fda56..558574ca 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -46,6 +46,7 @@ API_FILES_DOWNLOAD_LINK <- "/volumes/%s/sessions/%s/files/%s/download-link/" API_SESSION_DOWNLOAD_LINK <- "/volumes/%s/sessions/%s/download-link/" API_SESSION_CSV_DOWNLOAD_LINK <- "/volumes/%s/sessions/%s/csv-download-link/" API_FOLDER_DETAIL <- "/volumes/%s/folders/%s/" +API_FOLDER_CHECK_DUPLICATE_FILES <- "/volumes/%s/folders/%s/check-duplicate-files/" API_FOLDER_FILES <- "/volumes/%s/folders/%s/files/" API_FOLDER_FILES_DETAIL <- "/volumes/%s/folders/%s/files/%s/" API_FOLDER_DOWNLOAD_LINK <- "/volumes/%s/folders/%s/download-link/" diff --git a/R/check_duplicate_files_in_folder.R b/R/check_duplicate_files_in_folder.R new file mode 100644 index 00000000..1938a96b --- /dev/null +++ b/R/check_duplicate_files_in_folder.R @@ -0,0 +1,85 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Check Whether Filenames Already Exist in a Folder +#' +#' @description Ask the server which of the supplied filenames already +#' exist as files in the given folder. Useful before bulk uploads to detect +#' name collisions in advance. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param folder_id Numeric folder identifier. Must be a positive integer. +#' @param filenames Character vector of filenames to check. Length must be +#' at least 1; each element must be a non-empty string. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A \code{tibble} with columns \code{filename} (character) and +#' \code{exists} (logical), one row per input filename and in the same +#' order. Returns \code{NULL} if the request fails. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' check_duplicate_files_in_folder( +#' vol_id = 1, +#' folder_id = 42, +#' filenames = c("clip_001.mp4", "clip_002.mp4") +#' ) +#' } +#' } +#' @export +check_duplicate_files_in_folder <- function( # nolint: object_length_linter. + vol_id = 1, + folder_id, + filenames, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(folder_id, "folder_id") + + assertthat::assert_that( + is.character(filenames), + length(filenames) >= 1, + msg = "filenames must be a non-empty character vector" + ) + assertthat::assert_that( + !any(is.na(filenames)), + all(nzchar(trimws(filenames))), + msg = "filenames must not contain NA or empty strings" + ) + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # `as.list()` on a length-1 character would still serialize to a JSON array + # via httr2, but be explicit so the contract matches the server's expected + # `[...]` shape regardless of length. + body <- list(filenames = as.list(filenames)) + + result <- perform_api_post( + path = sprintf(API_FOLDER_CHECK_DUPLICATE_FILES, vol_id, folder_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(result) || isTRUE(result)) { + if (vb) { + message( + "Failed to check duplicate filenames in folder ", + folder_id, " of volume ", vol_id + ) + } + return(NULL) + } + + tibble::tibble( + filename = vapply(result, function(r) as.character(r$filename), character(1)), + exists = vapply(result, function(r) isTRUE(r$exists), logical(1)) + ) +} diff --git a/R/create_folder.R b/R/create_folder.R new file mode 100644 index 00000000..a84e0d5d --- /dev/null +++ b/R/create_folder.R @@ -0,0 +1,90 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Create Folder in Databrary Volume +#' +#' @description Create a new folder in a Databrary volume. \code{name} is +#' required and must be non-empty. Folders group files together but, unlike +#' sessions, do not carry structured date / default-record metadata. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param name Display name for the folder. Required, non-empty after trim. +#' @param release_level Optional release level for the folder +#' (e.g. \code{"PRIVATE"}, \code{"SHARED"}, \code{"EXCERPTS"}, +#' \code{"PUBLIC"}). The server validates the choice. +#' @param source_date Optional folder date. A length-1 \code{Date} object or +#' ISO \code{"YYYY-MM-DD"} string. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the created folder's metadata (same shape as +#' \code{\link{get_folder_by_id}}), or \code{NULL} if creation fails. +#' +#' @seealso \code{\link{update_folder}}, \code{\link{patch_folder}}, +#' \code{\link{delete_folder}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Minimal folder +#' create_folder(vol_id = 1, name = "Stimuli") +#' +#' # Folder with a release level and date +#' create_folder( +#' vol_id = 1, +#' name = "Stimuli", +#' release_level = "SHARED", +#' source_date = as.Date("2024-03-15") +#' ) +#' } +#' } +#' @export +create_folder <- function( + vol_id = 1, + name, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + + assertthat::assert_that(is.character(name), length(name) == 1) + assertthat::assert_that(nzchar(trimws(name)), msg = "name must not be empty") + + if (!is.null(release_level)) { + assertthat::assert_that( + is.character(release_level), + length(release_level) == 1, + nzchar(trimws(release_level)) + ) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list(name = name) + if (!is.null(release_level)) body$release_level <- release_level + if (!is.null(source_date)) { + body$source_date <- coerce_iso_date(source_date, "source_date") + } + + folder <- perform_api_post( + path = sprintf(API_VOLUME_FOLDERS, vol_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(folder)) { + if (vb) { + message("Failed to create folder in volume ", vol_id) + } + return(NULL) + } + + folder +} diff --git a/R/delete_folder.R b/R/delete_folder.R new file mode 100644 index 00000000..5b14a571 --- /dev/null +++ b/R/delete_folder.R @@ -0,0 +1,57 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Delete Folder from Databrary Volume +#' +#' @description Delete (soft-delete) a folder from a Databrary volume. The +#' folder and its associated metadata are marked as deleted but not +#' permanently removed from the database. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param folder_id Numeric folder identifier. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} if the folder was successfully deleted, \code{FALSE} +#' otherwise. +#' +#' @seealso \code{\link{create_folder}}, \code{\link{update_folder}}, +#' \code{\link{patch_folder}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' delete_folder(vol_id = 1, folder_id = 42) +#' } +#' } +#' @export +delete_folder <- function( + vol_id = 1, + folder_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(folder_id, "folder_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + success <- perform_api_delete( + path = sprintf(API_FOLDER_DETAIL, vol_id, folder_id), + rq = rq, + vb = vb + ) + + if (!success) { + if (vb) { + message( + "Failed to delete folder ", folder_id, " from volume ", vol_id + ) + } + } + + success +} diff --git a/R/patch_folder.R b/R/patch_folder.R new file mode 100644 index 00000000..d87a299d --- /dev/null +++ b/R/patch_folder.R @@ -0,0 +1,101 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Partially Update a Folder in Databrary Volume +#' +#' @description Sends a PATCH request to update selected fields of an existing +#' folder. Only provided arguments are sent; omitted fields are left +#' unchanged on the server. The server rejects blanking out a previously +#' non-empty \code{name}. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param folder_id Numeric folder identifier. Must be a positive integer. +#' @param name Optional new folder name. If provided, must be a non-empty +#' length-1 string. +#' @param release_level Optional release level (e.g. \code{"PRIVATE"}, +#' \code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). Server validates +#' the choice. +#' @param source_date Optional folder date. A length-1 \code{Date} object or +#' ISO \code{"YYYY-MM-DD"} string. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the updated folder's metadata (same shape as +#' \code{\link{get_folder_by_id}}), or \code{NULL} if the update fails or +#' no fields were provided. +#' +#' @seealso \code{\link{update_folder}}, \code{\link{create_folder}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' patch_folder(vol_id = 1, folder_id = 42, name = "Renamed folder") +#' } +#' } +#' @export +patch_folder <- function( + vol_id = 1, + folder_id, + name = NULL, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(folder_id, "folder_id") + + if (!is.null(name)) { + assertthat::assert_that(is.character(name), length(name) == 1) + assertthat::assert_that( + nzchar(trimws(name)), + msg = "name must not be empty" + ) + } + + if (!is.null(release_level)) { + assertthat::assert_that( + is.character(release_level), + length(release_level) == 1, + nzchar(trimws(release_level)) + ) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list() + if (!is.null(name)) body$name <- name + if (!is.null(release_level)) body$release_level <- release_level + if (!is.null(source_date)) { + body$source_date <- coerce_iso_date(source_date, "source_date") + } + + if (length(body) == 0) { + if (vb) { + message("No fields provided to update for folder ", folder_id) + } + return(NULL) + } + + folder <- perform_api_patch( + path = sprintf(API_FOLDER_DETAIL, vol_id, folder_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(folder)) { + if (vb) { + message( + "Failed to update folder ", folder_id, " in volume ", vol_id + ) + } + return(NULL) + } + + folder +} diff --git a/R/update_folder.R b/R/update_folder.R new file mode 100644 index 00000000..f68471cb --- /dev/null +++ b/R/update_folder.R @@ -0,0 +1,86 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Replace a Folder in Databrary Volume (PUT) +#' +#' @description Sends a PUT request to fully replace a folder's writable +#' fields. \code{name} is required (non-empty); other fields are optional and +#' default to server-side values when omitted (the underlying serializer +#' marks them \code{required=FALSE}). Use \code{\link{patch_folder}} for +#' partial updates when you don't want full-replacement semantics. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param folder_id Numeric folder identifier. Must be a positive integer. +#' @param name New folder name. Required, non-empty after trim. +#' @param release_level Optional release level (e.g. \code{"PRIVATE"}, +#' \code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). +#' @param source_date Optional folder date. A length-1 \code{Date} object or +#' ISO \code{"YYYY-MM-DD"} string. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the updated folder's metadata (same shape as +#' \code{\link{get_folder_by_id}}), or \code{NULL} if the update fails. +#' +#' @seealso \code{\link{patch_folder}}, \code{\link{create_folder}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' update_folder(vol_id = 1, folder_id = 42, name = "Replacement name") +#' } +#' } +#' @export +update_folder <- function( + vol_id = 1, + folder_id, + name, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(folder_id, "folder_id") + + assertthat::assert_that(is.character(name), length(name) == 1) + assertthat::assert_that(nzchar(trimws(name)), msg = "name must not be empty") + + if (!is.null(release_level)) { + assertthat::assert_that( + is.character(release_level), + length(release_level) == 1, + nzchar(trimws(release_level)) + ) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list(name = name) + if (!is.null(release_level)) body$release_level <- release_level + if (!is.null(source_date)) { + body$source_date <- coerce_iso_date(source_date, "source_date") + } + + folder <- perform_api_put( + path = sprintf(API_FOLDER_DETAIL, vol_id, folder_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(folder)) { + if (vb) { + message( + "Failed to replace folder ", folder_id, " in volume ", vol_id + ) + } + return(NULL) + } + + folder +} diff --git a/man/check_duplicate_files_in_folder.Rd b/man/check_duplicate_files_in_folder.Rd new file mode 100644 index 00000000..4ebc2c46 --- /dev/null +++ b/man/check_duplicate_files_in_folder.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/check_duplicate_files_in_folder.R +\name{check_duplicate_files_in_folder} +\alias{check_duplicate_files_in_folder} +\title{Check Whether Filenames Already Exist in a Folder} +\usage{ +check_duplicate_files_in_folder( + vol_id = 1, + folder_id, + filenames, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{folder_id}{Numeric folder identifier. Must be a positive integer.} + +\item{filenames}{Character vector of filenames to check. Length must be +at least 1; each element must be a non-empty string.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A \code{tibble} with columns \code{filename} (character) and +\code{exists} (logical), one row per input filename and in the same +order. Returns \code{NULL} if the request fails. +} +\description{ +Ask the server which of the supplied filenames already +exist as files in the given folder. Useful before bulk uploads to detect +name collisions in advance. +} +\examples{ +\donttest{ +\dontrun{ +check_duplicate_files_in_folder( + vol_id = 1, + folder_id = 42, + filenames = c("clip_001.mp4", "clip_002.mp4") +) +} +} +} diff --git a/man/create_folder.Rd b/man/create_folder.Rd new file mode 100644 index 00000000..76931abf --- /dev/null +++ b/man/create_folder.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/create_folder.R +\name{create_folder} +\alias{create_folder} +\title{Create Folder in Databrary Volume} +\usage{ +create_folder( + vol_id = 1, + name, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{name}{Display name for the folder. Required, non-empty after trim.} + +\item{release_level}{Optional release level for the folder +(e.g. \code{"PRIVATE"}, \code{"SHARED"}, \code{"EXCERPTS"}, +\code{"PUBLIC"}). The server validates the choice.} + +\item{source_date}{Optional folder date. A length-1 \code{Date} object or +ISO \code{"YYYY-MM-DD"} string.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the created folder's metadata (same shape as +\code{\link{get_folder_by_id}}), or \code{NULL} if creation fails. +} +\description{ +Create a new folder in a Databrary volume. \code{name} is +required and must be non-empty. Folders group files together but, unlike +sessions, do not carry structured date / default-record metadata. +} +\examples{ +\donttest{ +\dontrun{ +# Minimal folder +create_folder(vol_id = 1, name = "Stimuli") + +# Folder with a release level and date +create_folder( + vol_id = 1, + name = "Stimuli", + release_level = "SHARED", + source_date = as.Date("2024-03-15") +) +} +} +} +\seealso{ +\code{\link{update_folder}}, \code{\link{patch_folder}}, +\code{\link{delete_folder}} +} diff --git a/man/delete_folder.Rd b/man/delete_folder.Rd new file mode 100644 index 00000000..ad26c630 --- /dev/null +++ b/man/delete_folder.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/delete_folder.R +\name{delete_folder} +\alias{delete_folder} +\title{Delete Folder from Databrary Volume} +\usage{ +delete_folder(vol_id = 1, folder_id, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{folder_id}{Numeric folder identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} if the folder was successfully deleted, \code{FALSE} +otherwise. +} +\description{ +Delete (soft-delete) a folder from a Databrary volume. The +folder and its associated metadata are marked as deleted but not +permanently removed from the database. +} +\examples{ +\donttest{ +\dontrun{ +delete_folder(vol_id = 1, folder_id = 42) +} +} +} +\seealso{ +\code{\link{create_folder}}, \code{\link{update_folder}}, +\code{\link{patch_folder}} +} diff --git a/man/patch_folder.Rd b/man/patch_folder.Rd new file mode 100644 index 00000000..9c0092de --- /dev/null +++ b/man/patch_folder.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/patch_folder.R +\name{patch_folder} +\alias{patch_folder} +\title{Partially Update a Folder in Databrary Volume} +\usage{ +patch_folder( + vol_id = 1, + folder_id, + name = NULL, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{folder_id}{Numeric folder identifier. Must be a positive integer.} + +\item{name}{Optional new folder name. If provided, must be a non-empty +length-1 string.} + +\item{release_level}{Optional release level (e.g. \code{"PRIVATE"}, +\code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). Server validates +the choice.} + +\item{source_date}{Optional folder date. A length-1 \code{Date} object or +ISO \code{"YYYY-MM-DD"} string.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the updated folder's metadata (same shape as +\code{\link{get_folder_by_id}}), or \code{NULL} if the update fails or +no fields were provided. +} +\description{ +Sends a PATCH request to update selected fields of an existing +folder. Only provided arguments are sent; omitted fields are left +unchanged on the server. The server rejects blanking out a previously +non-empty \code{name}. +} +\examples{ +\donttest{ +\dontrun{ +patch_folder(vol_id = 1, folder_id = 42, name = "Renamed folder") +} +} +} +\seealso{ +\code{\link{update_folder}}, \code{\link{create_folder}} +} diff --git a/man/update_folder.Rd b/man/update_folder.Rd new file mode 100644 index 00000000..8d759cae --- /dev/null +++ b/man/update_folder.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/update_folder.R +\name{update_folder} +\alias{update_folder} +\title{Replace a Folder in Databrary Volume (PUT)} +\usage{ +update_folder( + vol_id = 1, + folder_id, + name, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{folder_id}{Numeric folder identifier. Must be a positive integer.} + +\item{name}{New folder name. Required, non-empty after trim.} + +\item{release_level}{Optional release level (e.g. \code{"PRIVATE"}, +\code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}).} + +\item{source_date}{Optional folder date. A length-1 \code{Date} object or +ISO \code{"YYYY-MM-DD"} string.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the updated folder's metadata (same shape as +\code{\link{get_folder_by_id}}), or \code{NULL} if the update fails. +} +\description{ +Sends a PUT request to fully replace a folder's writable +fields. \code{name} is required (non-empty); other fields are optional and +default to server-side values when omitted (the underlying serializer +marks them \code{required=FALSE}). Use \code{\link{patch_folder}} for +partial updates when you don't want full-replacement semantics. +} +\examples{ +\donttest{ +\dontrun{ +update_folder(vol_id = 1, folder_id = 42, name = "Replacement name") +} +} +} +\seealso{ +\code{\link{patch_folder}}, \code{\link{create_folder}} +} From 748738a0fd779ebb4702b43b3e9a5464a646e6d5 Mon Sep 17 00:00:00 2001 From: Michal Huryn Date: Tue, 12 May 2026 17:33:00 +0200 Subject: [PATCH 62/77] test: add tests for folders CRUD and check-duplicate-files --- .../test-check_duplicate_files_in_folder.R | 153 ++++++++++++++++++ tests/testthat/test-create_folder.R | 141 ++++++++++++++++ tests/testthat/test-delete_folder.R | 86 ++++++++++ tests/testthat/test-patch_folder.R | 139 ++++++++++++++++ tests/testthat/test-update_folder.R | 138 ++++++++++++++++ 5 files changed, 657 insertions(+) create mode 100644 tests/testthat/test-check_duplicate_files_in_folder.R create mode 100644 tests/testthat/test-create_folder.R create mode 100644 tests/testthat/test-delete_folder.R create mode 100644 tests/testthat/test-patch_folder.R create mode 100644 tests/testthat/test-update_folder.R diff --git a/tests/testthat/test-check_duplicate_files_in_folder.R b/tests/testthat/test-check_duplicate_files_in_folder.R new file mode 100644 index 00000000..a5ded545 --- /dev/null +++ b/tests/testthat/test-check_duplicate_files_in_folder.R @@ -0,0 +1,153 @@ +# check_duplicate_files_in_folder() -------------------------------------------- +login_test_account() + +TEST_VOL <- 1777 + +new_folder_id <- function(name = "check_duplicate_files_in_folder test") { + created <- create_folder(vol_id = TEST_VOL, name = name, vb = FALSE) + if (is.null(created)) { + return(NULL) + } + created$id +} + +test_that("check_duplicate_files_in_folder returns a tibble for an empty folder", { + fid <- new_folder_id("check_duplicate_files_in_folder happy path") + skip_if_null_response(fid, "create_folder for check_duplicate_files happy path") + on.exit(delete_folder(vol_id = TEST_VOL, folder_id = fid, vb = FALSE), add = TRUE) + + filenames <- c("nonexistent_a.mp4", "nonexistent_b.mp4") + result <- check_duplicate_files_in_folder( + vol_id = TEST_VOL, + folder_id = fid, + filenames = filenames, + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_folder(empty folder)") + + expect_s3_class(result, "tbl_df") + expect_named(result, c("filename", "exists")) + expect_equal(nrow(result), length(filenames)) + expect_equal(result$filename, filenames) + expect_type(result$exists, "logical") + expect_true(all(!result$exists)) +}) + +test_that("check_duplicate_files_in_folder preserves input order", { + fid <- new_folder_id("check_duplicate_files_in_folder order") + skip_if_null_response(fid, "create_folder for order test") + on.exit(delete_folder(vol_id = TEST_VOL, folder_id = fid, vb = FALSE), add = TRUE) + + filenames <- c("z.mp4", "a.mp4", "m.mp4") + result <- check_duplicate_files_in_folder( + vol_id = TEST_VOL, + folder_id = fid, + filenames = filenames, + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_folder(order)") + + expect_equal(result$filename, filenames) +}) + +test_that("check_duplicate_files_in_folder works with a single filename", { + fid <- new_folder_id("check_duplicate_files_in_folder single") + skip_if_null_response(fid, "create_folder for single filename test") + on.exit(delete_folder(vol_id = TEST_VOL, folder_id = fid, vb = FALSE), add = TRUE) + + result <- check_duplicate_files_in_folder( + vol_id = TEST_VOL, + folder_id = fid, + filenames = "only.mp4", + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_folder(single)") + + expect_equal(nrow(result), 1L) + expect_equal(result$filename, "only.mp4") + expect_false(result$exists) +}) + +test_that("check_duplicate_files_in_folder returns NULL for non-existent folder", { + result <- check_duplicate_files_in_folder( + vol_id = TEST_VOL, + folder_id = 999999999, + filenames = c("a.mp4"), + vb = FALSE + ) + expect_null(result) +}) + +test_that("check_duplicate_files_in_folder works with verbose mode", { + fid <- new_folder_id("check_duplicate_files_in_folder vb") + skip_if_null_response(fid, "create_folder for check_duplicate_files vb") + on.exit(delete_folder(vol_id = TEST_VOL, folder_id = fid, vb = FALSE), add = TRUE) + + result <- check_duplicate_files_in_folder( + vol_id = TEST_VOL, + folder_id = fid, + filenames = c("vb.mp4"), + vb = TRUE + ) + skip_if_null_response(result, "check_duplicate_files_in_folder vb") + expect_s3_class(result, "tbl_df") +}) + +test_that("check_duplicate_files_in_folder works with custom request object", { + fid <- new_folder_id("check_duplicate_files_in_folder custom rq") + skip_if_null_response(fid, "create_folder for check_duplicate_files custom rq") + on.exit(delete_folder(vol_id = TEST_VOL, folder_id = fid, vb = FALSE), add = TRUE) + + custom_rq <- databraryr::make_default_request() + result <- check_duplicate_files_in_folder( + vol_id = TEST_VOL, + folder_id = fid, + filenames = c("custom.mp4"), + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_folder custom rq") + expect_s3_class(result, "tbl_df") +}) + +test_that("check_duplicate_files_in_folder rejects invalid filenames", { + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = character(0))) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = NULL)) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = 123)) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = list("a"))) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = TRUE)) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = c("a", NA))) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = c("a", ""))) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = c("a", " "))) +}) + +test_that("check_duplicate_files_in_folder rejects invalid vol_id", { + expect_error(check_duplicate_files_in_folder(vol_id = -1, folder_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 0, folder_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = "1", folder_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = TRUE, folder_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = c(1, 2), folder_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 1.5, folder_id = 1, filenames = "a")) +}) + +test_that("check_duplicate_files_in_folder rejects invalid folder_id", { + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = -1, filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 0, filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = "1", filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = TRUE, filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = c(1, 2), filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1.5, filenames = "a")) +}) + +test_that("check_duplicate_files_in_folder rejects invalid vb parameter", { + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = "a", vb = -1)) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = "a", vb = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = "a", vb = c(TRUE, FALSE))) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = "a", vb = NULL)) +}) + +test_that("check_duplicate_files_in_folder rejects invalid rq parameter", { + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = "a", rq = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = "a", rq = -1)) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = "a", rq = TRUE)) +}) diff --git a/tests/testthat/test-create_folder.R b/tests/testthat/test-create_folder.R new file mode 100644 index 00000000..0c341f64 --- /dev/null +++ b/tests/testthat/test-create_folder.R @@ -0,0 +1,141 @@ +# create_folder() -------------------------------------------------------------- +login_test_account() + +test_that("create_folder creates a folder with name only", { + result <- create_folder(vol_id = 1777, name = "Test folder", vb = FALSE) + skip_if_null_response(result, "create_folder(vol_id = 1777, name = 'Test folder')") + + if (!is.null(result$id)) { + delete_folder(vol_id = 1777, folder_id = result$id, vb = FALSE) + } + + expect_type(result, "list") + expect_true(!is.null(result$id)) + expect_true(is.numeric(result$id) || is.integer(result$id)) + expect_true(result$id > 0) + expect_equal(as.integer(result$volume), 1777L) + expect_equal(result$name, "Test folder") +}) + +test_that("create_folder accepts a Date source_date", { + result <- create_folder( + vol_id = 1777, + name = "Test folder with Date", + source_date = as.Date("2024-03-15"), + vb = FALSE + ) + skip_if_null_response(result, "create_folder with Date source_date") + + if (!is.null(result$id)) { + delete_folder(vol_id = 1777, folder_id = result$id, vb = FALSE) + } + + expect_type(result, "list") + expect_true(!is.null(result$id)) +}) + +test_that("create_folder accepts an ISO string source_date", { + result <- create_folder( + vol_id = 1777, + name = "Test folder with ISO date", + source_date = "2024-03-15", + vb = FALSE + ) + skip_if_null_response(result, "create_folder with ISO source_date") + + if (!is.null(result$id)) { + delete_folder(vol_id = 1777, folder_id = result$id, vb = FALSE) + } + + expect_type(result, "list") +}) + +test_that("create_folder works with verbose mode", { + result <- create_folder( + vol_id = 1777, + name = "Test folder vb", + vb = TRUE + ) + skip_if_null_response(result, "create_folder with vb = TRUE") + + if (!is.null(result$id)) { + delete_folder(vol_id = 1777, folder_id = result$id, vb = FALSE) + } + + expect_type(result, "list") +}) + +test_that("create_folder works with custom request object", { + custom_rq <- databraryr::make_default_request() + result <- create_folder( + vol_id = 1777, + name = "Test folder custom rq", + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "create_folder with custom_rq") + + if (!is.null(result$id)) { + delete_folder(vol_id = 1777, folder_id = result$id, vb = FALSE) + } + + expect_type(result, "list") +}) + +test_that("create_folder returns NULL for non-existent volume", { + expect_null(create_folder(vol_id = 999999999, name = "Test", vb = FALSE)) +}) + +test_that("create_folder rejects invalid name", { + expect_error(create_folder(vol_id = 1777, name = "")) + expect_error(create_folder(vol_id = 1777, name = " ")) + expect_error(create_folder(vol_id = 1777, name = 123)) + expect_error(create_folder(vol_id = 1777, name = c("A", "B"))) + expect_error(create_folder(vol_id = 1777, name = NULL)) + expect_error(create_folder(vol_id = 1777, name = NA)) +}) + +test_that("create_folder rejects malformed source_date", { + expect_error(create_folder(vol_id = 1777, name = "Test", source_date = "not-a-date")) + expect_error(create_folder(vol_id = 1777, name = "Test", source_date = "")) + expect_error(create_folder(vol_id = 1777, name = "Test", source_date = 123)) + expect_error( + create_folder( + vol_id = 1777, + name = "Test", + source_date = as.Date(c("2024-01-01", "2024-02-01")) + ) + ) +}) + +test_that("create_folder rejects invalid release_level", { + expect_error(create_folder(vol_id = 1777, name = "Test", release_level = "")) + expect_error(create_folder(vol_id = 1777, name = "Test", release_level = 1)) + expect_error(create_folder(vol_id = 1777, name = "Test", release_level = c("A", "B"))) +}) + +test_that("create_folder rejects invalid vol_id", { + expect_error(create_folder(vol_id = -1, name = "Test")) + expect_error(create_folder(vol_id = 0, name = "Test")) + expect_error(create_folder(vol_id = "1", name = "Test")) + expect_error(create_folder(vol_id = TRUE, name = "Test")) + expect_error(create_folder(vol_id = list(a = 1), name = "Test")) + expect_error(create_folder(vol_id = c(1, 2), name = "Test")) + expect_error(create_folder(vol_id = 1.5, name = "Test")) +}) + +test_that("create_folder rejects invalid vb parameter", { + expect_error(create_folder(vol_id = 1777, name = "Test", vb = -1)) + expect_error(create_folder(vol_id = 1777, name = "Test", vb = "a")) + expect_error(create_folder(vol_id = 1777, name = "Test", vb = list(a = 1))) + expect_error(create_folder(vol_id = 1777, name = "Test", vb = c(TRUE, FALSE))) + expect_error(create_folder(vol_id = 1777, name = "Test", vb = NULL)) +}) + +test_that("create_folder rejects invalid rq parameter", { + expect_error(create_folder(vol_id = 1777, name = "Test", rq = "a")) + expect_error(create_folder(vol_id = 1777, name = "Test", rq = -1)) + expect_error(create_folder(vol_id = 1777, name = "Test", rq = c(2, 3))) + expect_error(create_folder(vol_id = 1777, name = "Test", rq = list(a = 1))) + expect_error(create_folder(vol_id = 1777, name = "Test", rq = TRUE)) +}) diff --git a/tests/testthat/test-delete_folder.R b/tests/testthat/test-delete_folder.R new file mode 100644 index 00000000..5ee1d486 --- /dev/null +++ b/tests/testthat/test-delete_folder.R @@ -0,0 +1,86 @@ +# delete_folder() -------------------------------------------------------------- +login_test_account() + +test_that("delete_folder deletes an existing folder", { + created <- create_folder(vol_id = 1777, name = "delete_folder happy path", vb = FALSE) + skip_if_null_response(created, "create_folder for delete_folder happy path") + + folder_id <- created$id + result <- delete_folder(vol_id = 1777, folder_id = folder_id, vb = FALSE) + + expect_true(result) + + # Verify it's gone + expect_null(get_folder_by_id(folder_id = folder_id, vol_id = 1777, vb = FALSE)) +}) + +test_that("delete_folder returns FALSE for non-existent folder", { + expect_false(delete_folder(vol_id = 1777, folder_id = 999999999, vb = FALSE)) +}) + +test_that("delete_folder works with verbose mode", { + created <- create_folder(vol_id = 1777, name = "delete_folder vb", vb = FALSE) + skip_if_null_response(created, "create_folder for delete_folder vb") + + expect_true(delete_folder(vol_id = 1777, folder_id = created$id, vb = TRUE)) +}) + +test_that("delete_folder works with custom request object", { + created <- create_folder( + vol_id = 1777, + name = "delete_folder custom rq", + vb = FALSE + ) + skip_if_null_response(created, "create_folder for delete_folder custom rq") + + custom_rq <- databraryr::make_default_request() + expect_true( + delete_folder( + vol_id = 1777, + folder_id = created$id, + rq = custom_rq, + vb = FALSE + ) + ) +}) + +test_that("delete_folder rejects invalid vol_id", { + expect_error(delete_folder(vol_id = -1, folder_id = 1)) + expect_error(delete_folder(vol_id = 0, folder_id = 1)) + expect_error(delete_folder(vol_id = "1", folder_id = 1)) + expect_error(delete_folder(vol_id = TRUE, folder_id = 1)) + expect_error(delete_folder(vol_id = list(a = 1), folder_id = 1)) + expect_error(delete_folder(vol_id = c(1, 2), folder_id = 1)) + expect_error(delete_folder(vol_id = 1.5, folder_id = 1)) + expect_error(delete_folder(vol_id = NULL, folder_id = 1)) + expect_error(delete_folder(vol_id = NA, folder_id = 1)) +}) + +test_that("delete_folder rejects invalid folder_id", { + expect_error(delete_folder(vol_id = 1777, folder_id = -1)) + expect_error(delete_folder(vol_id = 1777, folder_id = 0)) + expect_error(delete_folder(vol_id = 1777, folder_id = "1")) + expect_error(delete_folder(vol_id = 1777, folder_id = TRUE)) + expect_error(delete_folder(vol_id = 1777, folder_id = list(a = 1))) + expect_error(delete_folder(vol_id = 1777, folder_id = c(1, 2))) + expect_error(delete_folder(vol_id = 1777, folder_id = 1.5)) + expect_error(delete_folder(vol_id = 1777, folder_id = NULL)) + expect_error(delete_folder(vol_id = 1777, folder_id = NA)) +}) + +test_that("delete_folder rejects invalid vb parameter", { + expect_error(delete_folder(vol_id = 1777, folder_id = 1, vb = -1)) + expect_error(delete_folder(vol_id = 1777, folder_id = 1, vb = 3)) + expect_error(delete_folder(vol_id = 1777, folder_id = 1, vb = "a")) + expect_error(delete_folder(vol_id = 1777, folder_id = 1, vb = list(a = 1))) + expect_error(delete_folder(vol_id = 1777, folder_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_folder(vol_id = 1777, folder_id = 1, vb = NULL)) +}) + +test_that("delete_folder rejects invalid rq parameter", { + expect_error(delete_folder(vol_id = 1777, folder_id = 1, rq = "a")) + expect_error(delete_folder(vol_id = 1777, folder_id = 1, rq = -1)) + expect_error(delete_folder(vol_id = 1777, folder_id = 1, rq = c(2, 3))) + expect_error(delete_folder(vol_id = 1777, folder_id = 1, rq = list(a = 1))) + expect_error(delete_folder(vol_id = 1777, folder_id = 1, rq = TRUE)) +}) diff --git a/tests/testthat/test-patch_folder.R b/tests/testthat/test-patch_folder.R new file mode 100644 index 00000000..1c6182ab --- /dev/null +++ b/tests/testthat/test-patch_folder.R @@ -0,0 +1,139 @@ +# patch_folder() --------------------------------------------------------------- +login_test_account() + +new_folder_id <- function(name = "patch_folder test") { + created <- create_folder(vol_id = 1777, name = name, vb = FALSE) + if (is.null(created)) { + return(NULL) + } + created$id +} + +test_that("patch_folder updates name", { + fid <- new_folder_id("patch_folder original") + skip_if_null_response(fid, "create_folder for patch_folder name test") + on.exit(delete_folder(vol_id = 1777, folder_id = fid, vb = FALSE), add = TRUE) + + result <- patch_folder( + vol_id = 1777, + folder_id = fid, + name = "patch_folder renamed", + vb = FALSE + ) + skip_if_null_response(result, "patch_folder(name=...)") + + expect_type(result, "list") + expect_equal(result$name, "patch_folder renamed") + expect_equal(as.integer(result$id), as.integer(fid)) +}) + +test_that("patch_folder updates source_date with a Date object", { + fid <- new_folder_id("patch_folder source_date Date") + skip_if_null_response(fid, "create_folder for patch_folder source_date Date") + on.exit(delete_folder(vol_id = 1777, folder_id = fid, vb = FALSE), add = TRUE) + + result <- patch_folder( + vol_id = 1777, + folder_id = fid, + source_date = as.Date("2024-03-15"), + vb = FALSE + ) + skip_if_null_response(result, "patch_folder(source_date=Date)") + expect_type(result, "list") +}) + +test_that("patch_folder returns NULL when no fields provided", { + expect_null(patch_folder(vol_id = 1777, folder_id = 1, vb = FALSE)) +}) + +test_that("patch_folder returns NULL for non-existent folder", { + result <- patch_folder( + vol_id = 1777, + folder_id = 999999999, + name = "nope", + vb = FALSE + ) + expect_null(result) +}) + +test_that("patch_folder works with verbose mode", { + fid <- new_folder_id("patch_folder vb") + skip_if_null_response(fid, "create_folder for patch_folder vb") + on.exit(delete_folder(vol_id = 1777, folder_id = fid, vb = FALSE), add = TRUE) + + result <- patch_folder( + vol_id = 1777, + folder_id = fid, + name = "patch_folder vb renamed", + vb = TRUE + ) + skip_if_null_response(result, "patch_folder vb") + expect_type(result, "list") +}) + +test_that("patch_folder works with custom request object", { + fid <- new_folder_id("patch_folder custom rq") + skip_if_null_response(fid, "create_folder for patch_folder custom rq") + on.exit(delete_folder(vol_id = 1777, folder_id = fid, vb = FALSE), add = TRUE) + + custom_rq <- databraryr::make_default_request() + result <- patch_folder( + vol_id = 1777, + folder_id = fid, + name = "patch_folder custom rq renamed", + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "patch_folder custom rq") + expect_type(result, "list") +}) + +test_that("patch_folder rejects invalid name", { + expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = "")) + expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = " ")) + expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = 123)) + expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = c("A", "B"))) +}) + +test_that("patch_folder rejects malformed source_date", { + expect_error(patch_folder(vol_id = 1777, folder_id = 1, source_date = "not-a-date")) + expect_error(patch_folder(vol_id = 1777, folder_id = 1, source_date = "")) + expect_error(patch_folder(vol_id = 1777, folder_id = 1, source_date = 123)) +}) + +test_that("patch_folder rejects invalid release_level", { + expect_error(patch_folder(vol_id = 1777, folder_id = 1, release_level = "")) + expect_error(patch_folder(vol_id = 1777, folder_id = 1, release_level = 1)) + expect_error(patch_folder(vol_id = 1777, folder_id = 1, release_level = c("A", "B"))) +}) + +test_that("patch_folder rejects invalid vol_id", { + expect_error(patch_folder(vol_id = -1, folder_id = 1, name = "x")) + expect_error(patch_folder(vol_id = 0, folder_id = 1, name = "x")) + expect_error(patch_folder(vol_id = "1", folder_id = 1, name = "x")) + expect_error(patch_folder(vol_id = TRUE, folder_id = 1, name = "x")) + expect_error(patch_folder(vol_id = c(1, 2), folder_id = 1, name = "x")) + expect_error(patch_folder(vol_id = 1.5, folder_id = 1, name = "x")) +}) + +test_that("patch_folder rejects invalid folder_id", { + expect_error(patch_folder(vol_id = 1777, folder_id = -1, name = "x")) + expect_error(patch_folder(vol_id = 1777, folder_id = 0, name = "x")) + expect_error(patch_folder(vol_id = 1777, folder_id = "1", name = "x")) + expect_error(patch_folder(vol_id = 1777, folder_id = TRUE, name = "x")) + expect_error(patch_folder(vol_id = 1777, folder_id = c(1, 2), name = "x")) + expect_error(patch_folder(vol_id = 1777, folder_id = 1.5, name = "x")) +}) + +test_that("patch_folder rejects invalid vb parameter", { + expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = "x", vb = -1)) + expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = "x", vb = "a")) + expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = "x", vb = NULL)) +}) + +test_that("patch_folder rejects invalid rq parameter", { + expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = "x", rq = "a")) + expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = "x", rq = -1)) + expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = "x", rq = TRUE)) +}) diff --git a/tests/testthat/test-update_folder.R b/tests/testthat/test-update_folder.R new file mode 100644 index 00000000..badd8ebf --- /dev/null +++ b/tests/testthat/test-update_folder.R @@ -0,0 +1,138 @@ +# update_folder() -------------------------------------------------------------- +login_test_account() + +new_folder_id <- function(name = "update_folder test") { + created <- create_folder(vol_id = 1777, name = name, vb = FALSE) + if (is.null(created)) { + return(NULL) + } + created$id +} + +test_that("update_folder replaces name via PUT", { + fid <- new_folder_id("update_folder original") + skip_if_null_response(fid, "create_folder for update_folder name test") + on.exit(delete_folder(vol_id = 1777, folder_id = fid, vb = FALSE), add = TRUE) + + result <- update_folder( + vol_id = 1777, + folder_id = fid, + name = "update_folder replaced", + vb = FALSE + ) + skip_if_null_response(result, "update_folder(name=...)") + + expect_type(result, "list") + expect_equal(result$name, "update_folder replaced") + expect_equal(as.integer(result$id), as.integer(fid)) +}) + +test_that("update_folder replaces source_date with a Date object", { + fid <- new_folder_id("update_folder source_date Date") + skip_if_null_response(fid, "create_folder for update_folder source_date Date") + on.exit(delete_folder(vol_id = 1777, folder_id = fid, vb = FALSE), add = TRUE) + + result <- update_folder( + vol_id = 1777, + folder_id = fid, + name = "update_folder source_date Date", + source_date = as.Date("2024-03-15"), + vb = FALSE + ) + skip_if_null_response(result, "update_folder(source_date=Date)") + expect_type(result, "list") +}) + +test_that("update_folder returns NULL for non-existent folder", { + result <- update_folder( + vol_id = 1777, + folder_id = 999999999, + name = "nope", + vb = FALSE + ) + expect_null(result) +}) + +test_that("update_folder works with verbose mode", { + fid <- new_folder_id("update_folder vb") + skip_if_null_response(fid, "create_folder for update_folder vb") + on.exit(delete_folder(vol_id = 1777, folder_id = fid, vb = FALSE), add = TRUE) + + result <- update_folder( + vol_id = 1777, + folder_id = fid, + name = "update_folder vb replaced", + vb = TRUE + ) + skip_if_null_response(result, "update_folder vb") + expect_type(result, "list") +}) + +test_that("update_folder works with custom request object", { + fid <- new_folder_id("update_folder custom rq") + skip_if_null_response(fid, "create_folder for update_folder custom rq") + on.exit(delete_folder(vol_id = 1777, folder_id = fid, vb = FALSE), add = TRUE) + + custom_rq <- databraryr::make_default_request() + result <- update_folder( + vol_id = 1777, + folder_id = fid, + name = "update_folder custom rq replaced", + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "update_folder custom rq") + expect_type(result, "list") +}) + +test_that("update_folder rejects missing/invalid name", { + expect_error(update_folder(vol_id = 1777, folder_id = 1)) + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "")) + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = " ")) + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = 123)) + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = c("A", "B"))) + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = NULL)) + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = NA)) +}) + +test_that("update_folder rejects malformed source_date", { + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", source_date = "not-a-date")) + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", source_date = "")) + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", source_date = 123)) +}) + +test_that("update_folder rejects invalid release_level", { + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", release_level = "")) + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", release_level = 1)) +}) + +test_that("update_folder rejects invalid vol_id", { + expect_error(update_folder(vol_id = -1, folder_id = 1, name = "x")) + expect_error(update_folder(vol_id = 0, folder_id = 1, name = "x")) + expect_error(update_folder(vol_id = "1", folder_id = 1, name = "x")) + expect_error(update_folder(vol_id = TRUE, folder_id = 1, name = "x")) + expect_error(update_folder(vol_id = c(1, 2), folder_id = 1, name = "x")) + expect_error(update_folder(vol_id = 1.5, folder_id = 1, name = "x")) +}) + +test_that("update_folder rejects invalid folder_id", { + expect_error(update_folder(vol_id = 1777, folder_id = -1, name = "x")) + expect_error(update_folder(vol_id = 1777, folder_id = 0, name = "x")) + expect_error(update_folder(vol_id = 1777, folder_id = "1", name = "x")) + expect_error(update_folder(vol_id = 1777, folder_id = TRUE, name = "x")) + expect_error(update_folder(vol_id = 1777, folder_id = c(1, 2), name = "x")) + expect_error(update_folder(vol_id = 1777, folder_id = 1.5, name = "x")) +}) + +test_that("update_folder rejects invalid vb parameter", { + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", vb = -1)) + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", vb = "a")) + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", vb = NULL)) +}) + +test_that("update_folder rejects invalid rq parameter", { + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", rq = "a")) + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", rq = -1)) + expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", rq = TRUE)) +}) From 87a4f097cbaaaad7be5a69520ea092c4c31f6e32 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Tue, 12 May 2026 14:41:49 +0200 Subject: [PATCH 63/77] refactor: rename age field from is_partial to is_estimated in API utility functions and tests --- R/api_utils.R | 2 +- R/list_volume_records.R | 10 +++++----- tests/testthat/test-get_volume_record_by_id.R | 2 +- tests/testthat/test-list_volume_records.R | 2 +- tests/testthat/test-snake_case_list.R | 4 ++-- 5 files changed, 10 insertions(+), 10 deletions(-) diff --git a/R/api_utils.R b/R/api_utils.R index 1c86cc0a..9ba7e33c 100644 --- a/R/api_utils.R +++ b/R/api_utils.R @@ -432,7 +432,7 @@ record_as_client_list <- function(record) { days = record$age$days, total_days = record$age$total_days, formatted_value = record$age$formatted_value, - is_partial = record$age$is_partial, + is_estimated = record$age$is_estimated, is_blurred = record$age$is_blurred ) } diff --git a/R/list_volume_records.R b/R/list_volume_records.R index 48897ccb..3041e544 100644 --- a/R/list_volume_records.R +++ b/R/list_volume_records.R @@ -17,7 +17,7 @@ empty_volume_records_tibble <- function() { age_days = integer(0), age_total_days = integer(0), age_formatted = character(0), - age_is_partial = logical(0), + age_is_estimated = logical(0), age_is_blurred = logical(0), record_default_sessions = vector("list", 0), record_source_kind = character(0) @@ -128,7 +128,7 @@ list_volume_records <- function(vol_id = 1, age_days <- NA_integer_ age_total_days <- NA_integer_ age_formatted <- NA_character_ - age_is_partial <- NA + age_is_estimated <- NA age_is_blurred <- NA if (!is.null(record$age)) { @@ -157,8 +157,8 @@ list_volume_records <- function(vol_id = 1, } else { NA_character_ } - age_is_partial <- if (!is.null(record$age$is_partial)) { - record$age$is_partial + age_is_estimated <- if (!is.null(record$age$is_estimated)) { + record$age$is_estimated } else { NA } @@ -199,7 +199,7 @@ list_volume_records <- function(vol_id = 1, age_days = age_days, age_total_days = age_total_days, age_formatted = age_formatted, - age_is_partial = age_is_partial, + age_is_estimated = age_is_estimated, age_is_blurred = age_is_blurred, record_default_sessions = list(ds_cell), record_source_kind = if (is.null(record$record_source_kind)) { diff --git a/tests/testthat/test-get_volume_record_by_id.R b/tests/testthat/test-get_volume_record_by_id.R index dafde203..4fcac500 100644 --- a/tests/testthat/test-get_volume_record_by_id.R +++ b/tests/testthat/test-get_volume_record_by_id.R @@ -163,7 +163,7 @@ test_that("get_volume_record_by_id handles age structure correctly", { # If age exists, check its structure if (!is.null(result$age)) { expect_type(result$age, "list") - expected_fields <- c("years", "months", "days", "total_days", "formatted_value", "is_partial", "is_blurred") + expected_fields <- c("years", "months", "days", "total_days", "formatted_value", "is_estimated", "is_blurred") expect_true(all(expected_fields %in% names(result$age))) } } diff --git a/tests/testthat/test-list_volume_records.R b/tests/testthat/test-list_volume_records.R index 46335fc5..a32ef5cf 100644 --- a/tests/testthat/test-list_volume_records.R +++ b/tests/testthat/test-list_volume_records.R @@ -123,7 +123,7 @@ test_that("list_volume_records includes age fields", { # Check that age fields exist age_fields <- c("age_years", "age_months", "age_days", "age_total_days", - "age_formatted", "age_is_partial", "age_is_blurred") + "age_formatted", "age_is_estimated", "age_is_blurred") expect_true(all(age_fields %in% names(result))) }) diff --git a/tests/testthat/test-snake_case_list.R b/tests/testthat/test-snake_case_list.R index a8ae083b..b8fd6948 100644 --- a/tests/testthat/test-snake_case_list.R +++ b/tests/testthat/test-snake_case_list.R @@ -67,7 +67,7 @@ test_that("snake_case_list handles deeply nested record with age (QA repro)", { days = 1948, totalDays = 1948, formattedValue = "5 years, 4 months", - isPartial = FALSE, + isEstimated = FALSE, isBlurred = FALSE ) ) @@ -76,7 +76,7 @@ test_that("snake_case_list handles deeply nested record with age (QA repro)", { expect_equal(result$category_id, 1) expect_equal(names(result$age), c( "years", "months", "days", "total_days", - "formatted_value", "is_partial", "is_blurred" + "formatted_value", "is_estimated", "is_blurred" )) expect_equal(result$age$total_days, 1948) expect_equal(names(result$birthday), c("metric_id", "value")) From 348f61c035618a6c8f3a52a1f98a7dfed72a8858 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Wed, 13 May 2026 09:28:11 +0200 Subject: [PATCH 64/77] feat: enhance session and record management in tests --- DESCRIPTION | 1 + R/check_duplicate_files_in_session.R | 4 +- man/check_duplicate_files_in_session.Rd | 4 +- tests/testthat/helper-fixtures.R | 73 ++++++++++++++ .../test-add_default_record_to_session.R | 73 +++----------- .../test-check_duplicate_files_in_session.R | 45 ++++----- tests/testthat/test-create_session.R | 31 +++--- tests/testthat/test-create_volume_record.R | 25 +---- tests/testthat/test-get_upload_status.R | 14 +-- tests/testthat/test-initiate_upload.R | 12 +-- tests/testthat/test-patch_session.R | 21 +--- .../test-remove_default_record_from_session.R | 95 +++++-------------- .../testthat/test-session_record_lifecycle.R | 56 +++++++++++ tests/testthat/test-update_session.R | 20 +--- tests/testthat/test-upload_file.R | 26 ++--- 15 files changed, 229 insertions(+), 271 deletions(-) create mode 100644 tests/testthat/helper-fixtures.R create mode 100644 tests/testthat/test-session_record_lifecycle.R diff --git a/DESCRIPTION b/DESCRIPTION index 01f9e66c..f312a76e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -42,6 +42,7 @@ Suggests: readr, rmarkdown (>= 2.26), testthat (>= 3.0.0), + withr (>= 2.5.0), xml2 (>= 1.3.0) VignetteBuilder: knitr diff --git a/R/check_duplicate_files_in_session.R b/R/check_duplicate_files_in_session.R index 6e02c72a..a535bbc2 100644 --- a/R/check_duplicate_files_in_session.R +++ b/R/check_duplicate_files_in_session.R @@ -17,7 +17,9 @@ NULL #' #' @return A \code{tibble} with columns \code{filename} (character) and #' \code{exists} (logical), one row per input filename and in the same -#' order. Returns \code{NULL} if the request fails. +#' order. Returns \code{NULL} if the request fails. The server answers +#' successfully even when \code{session_id} does not exist: every file is +#' reported as \code{exists = FALSE} (no rows match that session). #' #' @inheritParams options_params #' diff --git a/man/check_duplicate_files_in_session.Rd b/man/check_duplicate_files_in_session.Rd index 693a45bf..f4d6086d 100644 --- a/man/check_duplicate_files_in_session.Rd +++ b/man/check_duplicate_files_in_session.Rd @@ -27,7 +27,9 @@ at least 1; each element must be a non-empty string.} \value{ A \code{tibble} with columns \code{filename} (character) and \code{exists} (logical), one row per input filename and in the same -order. Returns \code{NULL} if the request fails. +order. Returns \code{NULL} if the request fails. The server answers +successfully even when \code{session_id} does not exist: every file is +reported as \code{exists = FALSE} (no rows match that session). } \description{ Ask the server which of the supplied filenames already diff --git a/tests/testthat/helper-fixtures.R b/tests/testthat/helper-fixtures.R new file mode 100644 index 00000000..85a0ea3a --- /dev/null +++ b/tests/testthat/helper-fixtures.R @@ -0,0 +1,73 @@ +# Shared sandbox IDs for live API integration tests (staging volume 1777). +TEST_VOL_ID <- 1777L +TEST_CATEGORY_ID <- 6L + +# create_session, then schedule delete_session on `envir` via withr::defer. +# Default `envir = parent.frame()`: call from test_that() so cleanup runs when +# the test ends. Wrappers must pass `envir = parent.frame()` through. +make_test_session <- function( + name, + vol_id = TEST_VOL_ID, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + default_records = NULL, + vb = FALSE, + rq = NULL, + envir = parent.frame()) { + created <- create_session( + vol_id = vol_id, + name = name, + release_level = release_level, + source_date = source_date, + date = date, + date_precision = date_precision, + default_records = default_records, + vb = vb, + rq = rq + ) + + if (is.null(created) || is.null(created$id)) { + return(NULL) + } + + sid <- created$id + withr::defer( + delete_session(vol_id = vol_id, session_id = sid, vb = FALSE), + envir = envir + ) + sid +} + +# See make_test_session() for `envir` usage. +make_test_record <- function( + name, + category_id = TEST_CATEGORY_ID, + vol_id = TEST_VOL_ID, + measures = list(), + participant = NULL, + vb = FALSE, + rq = NULL, + envir = parent.frame()) { + created <- create_volume_record( + vol_id = vol_id, + category_id = category_id, + name = name, + measures = measures, + participant = participant, + vb = vb, + rq = rq + ) + + if (is.null(created) || is.null(created$record_id)) { + return(NULL) + } + + rid <- created$record_id + withr::defer( + delete_volume_record(vol_id = vol_id, record_id = rid, vb = FALSE), + envir = envir + ) + rid +} diff --git a/tests/testthat/test-add_default_record_to_session.R b/tests/testthat/test-add_default_record_to_session.R index c74930ac..1f3d44c9 100644 --- a/tests/testthat/test-add_default_record_to_session.R +++ b/tests/testthat/test-add_default_record_to_session.R @@ -1,45 +1,15 @@ # add_default_record_to_session() ---------------------------------------------- login_test_account() -# Sandbox volume 1777, category 6 ("task") is used elsewhere for record tests. -TEST_VOL <- 1777 -TEST_CATEGORY <- 6 - -new_session_id <- function(name = "add_default_record test") { - created <- create_session(vol_id = TEST_VOL, name = name, vb = FALSE) - if (is.null(created)) { - return(NULL) - } - created$id -} - -new_record_id <- function(name = "add_default_record test record") { - created <- create_volume_record( - vol_id = TEST_VOL, - category_id = TEST_CATEGORY, - name = name, - vb = FALSE - ) - if (is.null(created)) { - return(NULL) - } - created$record_id -} - test_that("add_default_record_to_session attaches a record", { - sid <- new_session_id("add_default_record happy path") + sid <- make_test_session("add_default_record happy path") skip_if_null_response(sid, "create_session for add_default_record happy path") - on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) - rid <- new_record_id("add_default_record happy path record") + rid <- make_test_record("add_default_record happy path record") skip_if_null_response(rid, "create_volume_record for add_default_record happy path") - on.exit( - delete_volume_record(vol_id = TEST_VOL, record_id = rid, vb = FALSE), - add = TRUE - ) result <- add_default_record_to_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = sid, record_id = rid, vb = FALSE @@ -48,7 +18,7 @@ test_that("add_default_record_to_session attaches a record", { # Verify it shows up among the session's default_records session <- get_session_by_id( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = sid, vb = FALSE ) @@ -61,13 +31,12 @@ test_that("add_default_record_to_session attaches a record", { }) test_that("add_default_record_to_session returns FALSE for non-existent record", { - sid <- new_session_id("add_default_record non-existent record") + sid <- make_test_session("add_default_record non-existent record") skip_if_null_response(sid, "create_session for non-existent record test") - on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) expect_false( add_default_record_to_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = sid, record_id = 999999999, vb = FALSE @@ -76,16 +45,12 @@ test_that("add_default_record_to_session returns FALSE for non-existent record", }) test_that("add_default_record_to_session returns FALSE for non-existent session", { - rid <- new_record_id("add_default_record non-existent session record") + rid <- make_test_record("add_default_record non-existent session record") skip_if_null_response(rid, "create_volume_record for non-existent session test") - on.exit( - delete_volume_record(vol_id = TEST_VOL, record_id = rid, vb = FALSE), - add = TRUE - ) expect_false( add_default_record_to_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = 999999999, record_id = rid, vb = FALSE @@ -94,20 +59,15 @@ test_that("add_default_record_to_session returns FALSE for non-existent session" }) test_that("add_default_record_to_session works with verbose mode", { - sid <- new_session_id("add_default_record vb") + sid <- make_test_session("add_default_record vb") skip_if_null_response(sid, "create_session for add_default_record vb") - on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) - rid <- new_record_id("add_default_record vb record") + rid <- make_test_record("add_default_record vb record") skip_if_null_response(rid, "create_volume_record for add_default_record vb") - on.exit( - delete_volume_record(vol_id = TEST_VOL, record_id = rid, vb = FALSE), - add = TRUE - ) expect_true( add_default_record_to_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = sid, record_id = rid, vb = TRUE @@ -116,21 +76,16 @@ test_that("add_default_record_to_session works with verbose mode", { }) test_that("add_default_record_to_session works with custom request object", { - sid <- new_session_id("add_default_record custom rq") + sid <- make_test_session("add_default_record custom rq") skip_if_null_response(sid, "create_session for add_default_record custom rq") - on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) - rid <- new_record_id("add_default_record custom rq record") + rid <- make_test_record("add_default_record custom rq record") skip_if_null_response(rid, "create_volume_record for add_default_record custom rq") - on.exit( - delete_volume_record(vol_id = TEST_VOL, record_id = rid, vb = FALSE), - add = TRUE - ) custom_rq <- databraryr::make_default_request() expect_true( add_default_record_to_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = sid, record_id = rid, rq = custom_rq, diff --git a/tests/testthat/test-check_duplicate_files_in_session.R b/tests/testthat/test-check_duplicate_files_in_session.R index d8170227..b28961ea 100644 --- a/tests/testthat/test-check_duplicate_files_in_session.R +++ b/tests/testthat/test-check_duplicate_files_in_session.R @@ -1,24 +1,13 @@ # check_duplicate_files_in_session() ------------------------------------------- login_test_account() -TEST_VOL <- 1777 - -new_session_id <- function(name = "check_duplicate_files test") { - created <- create_session(vol_id = TEST_VOL, name = name, vb = FALSE) - if (is.null(created)) { - return(NULL) - } - created$id -} - test_that("check_duplicate_files_in_session returns a tibble for an empty session", { - sid <- new_session_id("check_duplicate_files happy path") + sid <- make_test_session("check_duplicate_files happy path") skip_if_null_response(sid, "create_session for check_duplicate_files happy path") - on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) filenames <- c("nonexistent_a.mp4", "nonexistent_b.mp4") result <- check_duplicate_files_in_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = sid, filenames = filenames, vb = FALSE @@ -34,13 +23,12 @@ test_that("check_duplicate_files_in_session returns a tibble for an empty sessio }) test_that("check_duplicate_files_in_session preserves input order", { - sid <- new_session_id("check_duplicate_files order") + sid <- make_test_session("check_duplicate_files order") skip_if_null_response(sid, "create_session for order test") - on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) filenames <- c("z.mp4", "a.mp4", "m.mp4") result <- check_duplicate_files_in_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = sid, filenames = filenames, vb = FALSE @@ -51,12 +39,11 @@ test_that("check_duplicate_files_in_session preserves input order", { }) test_that("check_duplicate_files_in_session works with a single filename", { - sid <- new_session_id("check_duplicate_files single") + sid <- make_test_session("check_duplicate_files single") skip_if_null_response(sid, "create_session for single filename test") - on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) result <- check_duplicate_files_in_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = sid, filenames = "only.mp4", vb = FALSE @@ -68,23 +55,26 @@ test_that("check_duplicate_files_in_session works with a single filename", { expect_false(result$exists) }) -test_that("check_duplicate_files_in_session returns NULL for non-existent session", { +test_that("check_duplicate_files_in_session treats missing session like empty (all not found)", { + # Backend does not require the session to exist; it queries files by session_id only. result <- check_duplicate_files_in_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = 999999999, filenames = c("a.mp4"), vb = FALSE ) - expect_null(result) + skip_if_null_response(result, "check_duplicate_files_in_session(non-existent session)") + expect_s3_class(result, "tbl_df") + expect_equal(result$filename, "a.mp4") + expect_false(result$exists) }) test_that("check_duplicate_files_in_session works with verbose mode", { - sid <- new_session_id("check_duplicate_files vb") + sid <- make_test_session("check_duplicate_files vb") skip_if_null_response(sid, "create_session for check_duplicate_files vb") - on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) result <- check_duplicate_files_in_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = sid, filenames = c("vb.mp4"), vb = TRUE @@ -94,13 +84,12 @@ test_that("check_duplicate_files_in_session works with verbose mode", { }) test_that("check_duplicate_files_in_session works with custom request object", { - sid <- new_session_id("check_duplicate_files custom rq") + sid <- make_test_session("check_duplicate_files custom rq") skip_if_null_response(sid, "create_session for check_duplicate_files custom rq") - on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) custom_rq <- databraryr::make_default_request() result <- check_duplicate_files_in_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = sid, filenames = c("custom.mp4"), rq = custom_rq, diff --git a/tests/testthat/test-create_session.R b/tests/testthat/test-create_session.R index 0c5a0149..c6ad3c5e 100644 --- a/tests/testthat/test-create_session.R +++ b/tests/testthat/test-create_session.R @@ -5,16 +5,23 @@ test_that("create_session creates a session with name only", { result <- create_session(vol_id = 1777, name = "Test session", vb = FALSE) skip_if_null_response(result, "create_session(vol_id = 1777, name = 'Test session')") - if (!is.null(result$id)) { - delete_session(vol_id = 1777, session_id = result$id, vb = FALSE) - } + on.exit(delete_session(vol_id = 1777, session_id = result$id, vb = FALSE), add = TRUE) expect_type(result, "list") expect_true(!is.null(result$id)) expect_true(is.numeric(result$id) || is.integer(result$id)) expect_true(result$id > 0) - expect_equal(as.integer(result$volume), 1777L) expect_equal(result$name, "Test session") + # POST create returns SessionWriteSerializer data (no nested `volume`); confirm volume via GET. + fetched <- get_session_by_id(session_id = result$id, vol_id = 1777, vb = FALSE) + skip_if_null_response(fetched, "get_session_by_id after create_session") + v <- fetched$volume + vol_id_actual <- if (is.list(v) && !is.null(v$id)) { + as.integer(v$id) + } else { + as.integer(v) + } + expect_equal(vol_id_actual, 1777L) }) test_that("create_session accepts a Date source_date", { @@ -26,9 +33,7 @@ test_that("create_session accepts a Date source_date", { ) skip_if_null_response(result, "create_session with Date source_date") - if (!is.null(result$id)) { - delete_session(vol_id = 1777, session_id = result$id, vb = FALSE) - } + on.exit(delete_session(vol_id = 1777, session_id = result$id, vb = FALSE), add = TRUE) expect_type(result, "list") expect_true(!is.null(result$id)) @@ -43,9 +48,7 @@ test_that("create_session accepts an ISO string source_date", { ) skip_if_null_response(result, "create_session with ISO source_date") - if (!is.null(result$id)) { - delete_session(vol_id = 1777, session_id = result$id, vb = FALSE) - } + on.exit(delete_session(vol_id = 1777, session_id = result$id, vb = FALSE), add = TRUE) expect_type(result, "list") }) @@ -58,9 +61,7 @@ test_that("create_session works with verbose mode", { ) skip_if_null_response(result, "create_session with vb = TRUE") - if (!is.null(result$id)) { - delete_session(vol_id = 1777, session_id = result$id, vb = FALSE) - } + on.exit(delete_session(vol_id = 1777, session_id = result$id, vb = FALSE), add = TRUE) expect_type(result, "list") }) @@ -75,9 +76,7 @@ test_that("create_session works with custom request object", { ) skip_if_null_response(result, "create_session with custom_rq") - if (!is.null(result$id)) { - delete_session(vol_id = 1777, session_id = result$id, vb = FALSE) - } + on.exit(delete_session(vol_id = 1777, session_id = result$id, vb = FALSE), add = TRUE) expect_type(result, "list") }) diff --git a/tests/testthat/test-create_volume_record.R b/tests/testthat/test-create_volume_record.R index b044e29d..c928df6e 100644 --- a/tests/testthat/test-create_volume_record.R +++ b/tests/testthat/test-create_volume_record.R @@ -11,10 +11,7 @@ test_that("create_volume_record creates a record with valid parameters", { ) skip_if_null_response(result, "create_volume_record(vol_id = 1777, category_id = 6, name = 'Test condition')") - # Clean up - if (!is.null(result$record_id)) { - delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE) - } + on.exit(delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE), add = TRUE) expect_type(result, "list") expect_named(result, c( @@ -37,10 +34,7 @@ test_that("create_volume_record creates a record with measures", { ) skip_if_null_response(result, "create_volume_record with name") - # Clean up - if (!is.null(result$record_id)) { - delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE) - } + on.exit(delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE), add = TRUE) expect_type(result, "list") expect_true(!is.null(result$measures)) @@ -58,10 +52,7 @@ test_that("create_volume_record creates a record with name and additional measur ) skip_if_null_response(result, "create_volume_record with name and measures") - # Clean up - if (!is.null(result$record_id)) { - delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE) - } + on.exit(delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE), add = TRUE) expect_type(result, "list") expect_true(!is.null(result$measures)) @@ -94,10 +85,7 @@ test_that("create_volume_record works with verbose mode", { ) skip_if_null_response(result, "create_volume_record with vb = TRUE") - # Clean up - if (!is.null(result$record_id)) { - delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE) - } + on.exit(delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE), add = TRUE) expect_type(result, "list") expect_true(!is.null(result$record_id)) @@ -180,10 +168,7 @@ test_that("create_volume_record works with custom request object", { ) skip_if_null_response(result, "create_volume_record with custom_rq") - # Clean up - if (!is.null(result$record_id)) { - delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE) - } + on.exit(delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE), add = TRUE) expect_type(result, "list") expect_true(!is.null(result$record_id)) diff --git a/tests/testthat/test-get_upload_status.R b/tests/testthat/test-get_upload_status.R index bc66fa39..dd8e1868 100644 --- a/tests/testthat/test-get_upload_status.R +++ b/tests/testthat/test-get_upload_status.R @@ -1,8 +1,6 @@ # get_upload_status() ---------------------------------------------------------- login_test_account() -TEST_VOL <- 1777 - test_that("get_upload_status requires exactly one identifier", { expect_error(get_upload_status()) expect_error(get_upload_status( @@ -27,19 +25,13 @@ test_that("get_upload_status returns NULL for unknown guid", { }) test_that("get_upload_status returns a status string for a real upload", { - session <- create_session( - vol_id = TEST_VOL, name = "get_upload_status test", vb = FALSE - ) - skip_if_null_response(session, "create_session for get_upload_status") - on.exit( - delete_session(vol_id = TEST_VOL, session_id = session$id, vb = FALSE), - add = TRUE - ) + sid <- make_test_session("get_upload_status test") + skip_if_null_response(sid, "create_session for get_upload_status") init <- initiate_upload( filename = "status_probe.mp4", destination_type = "session", - object_id = session$id, + object_id = sid, file_size = 1024L, content_type = "video/mp4", vb = FALSE diff --git a/tests/testthat/test-initiate_upload.R b/tests/testthat/test-initiate_upload.R index fab64d64..ef3d5e26 100644 --- a/tests/testthat/test-initiate_upload.R +++ b/tests/testthat/test-initiate_upload.R @@ -1,14 +1,6 @@ # initiate_upload() ------------------------------------------------------------ login_test_account() -TEST_VOL <- 1777 - -new_session_id <- function(name = "initiate_upload test") { - created <- create_session(vol_id = TEST_VOL, name = name, vb = FALSE) - skip_if_null_response(created, "create_session for initiate_upload test") - created$id -} - test_that("initiate_upload validates required args", { expect_error(initiate_upload( filename = "", destination_type = "session", object_id = 1 @@ -77,8 +69,8 @@ test_that("initiate_upload rejects invalid vb / rq", { }) test_that("initiate_upload returns signed url and status_url for a session", { - sid <- new_session_id("initiate_upload happy path") - on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) + sid <- make_test_session("initiate_upload happy path") + skip_if_null_response(sid, "create_session for initiate_upload happy path") result <- initiate_upload( filename = "test_clip.mp4", diff --git a/tests/testthat/test-patch_session.R b/tests/testthat/test-patch_session.R index 19305531..f8b09327 100644 --- a/tests/testthat/test-patch_session.R +++ b/tests/testthat/test-patch_session.R @@ -1,19 +1,9 @@ # patch_session() -------------------------------------------------------------- login_test_account() -# Roundtrip helper: create a fresh session for each test, return its id. -new_session_id <- function(name = "patch_session test") { - created <- create_session(vol_id = 1777, name = name, vb = FALSE) - if (is.null(created)) { - return(NULL) - } - created$id -} - test_that("patch_session updates name", { - sid <- new_session_id("patch_session original") + sid <- make_test_session("patch_session original") skip_if_null_response(sid, "create_session for patch_session name test") - on.exit(delete_session(vol_id = 1777, session_id = sid, vb = FALSE), add = TRUE) result <- patch_session( vol_id = 1777, @@ -29,9 +19,8 @@ test_that("patch_session updates name", { }) test_that("patch_session updates source_date with a Date object", { - sid <- new_session_id("patch_session source_date Date") + sid <- make_test_session("patch_session source_date Date") skip_if_null_response(sid, "create_session for patch_session source_date Date") - on.exit(delete_session(vol_id = 1777, session_id = sid, vb = FALSE), add = TRUE) result <- patch_session( vol_id = 1777, @@ -58,9 +47,8 @@ test_that("patch_session returns NULL for non-existent session", { }) test_that("patch_session works with verbose mode", { - sid <- new_session_id("patch_session vb") + sid <- make_test_session("patch_session vb") skip_if_null_response(sid, "create_session for patch_session vb") - on.exit(delete_session(vol_id = 1777, session_id = sid, vb = FALSE), add = TRUE) result <- patch_session( vol_id = 1777, @@ -73,9 +61,8 @@ test_that("patch_session works with verbose mode", { }) test_that("patch_session works with custom request object", { - sid <- new_session_id("patch_session custom rq") + sid <- make_test_session("patch_session custom rq") skip_if_null_response(sid, "create_session for patch_session custom rq") - on.exit(delete_session(vol_id = 1777, session_id = sid, vb = FALSE), add = TRUE) custom_rq <- databraryr::make_default_request() result <- patch_session( diff --git a/tests/testthat/test-remove_default_record_from_session.R b/tests/testthat/test-remove_default_record_from_session.R index 46db8e1e..8d166bd9 100644 --- a/tests/testthat/test-remove_default_record_from_session.R +++ b/tests/testthat/test-remove_default_record_from_session.R @@ -1,66 +1,41 @@ # remove_default_record_from_session() ----------------------------------------- login_test_account() -TEST_VOL <- 1777 -TEST_CATEGORY <- 6 - -new_session_id <- function(name = "remove_default_record test") { - created <- create_session(vol_id = TEST_VOL, name = name, vb = FALSE) - if (is.null(created)) { - return(NULL) - } - created$id -} - -new_record_id <- function(name = "remove_default_record test record") { - created <- create_volume_record( - vol_id = TEST_VOL, - category_id = TEST_CATEGORY, - name = name, - vb = FALSE - ) - if (is.null(created)) { +# Create a session + record with the record attached as a default. +# Deferred cleanup is registered on the caller's environment; must be invoked +# from test_that(). +setup_attached <- function(name) { + envir <- parent.frame() + sid <- make_test_session(paste0(name, " session"), envir = envir) + if (is.null(sid)) { return(NULL) } - created$record_id -} -# Setup helper: create session + record + attach the record as a default. -setup_attached <- function(name) { - sid <- new_session_id(paste0(name, " session")) - if (is.null(sid)) return(NULL) - rid <- new_record_id(paste0(name, " record")) + rid <- make_test_record(paste0(name, " record"), envir = envir) if (is.null(rid)) { - delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE) return(NULL) } + attached <- add_default_record_to_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = sid, record_id = rid, vb = FALSE ) + if (!isTRUE(attached)) { - delete_volume_record(vol_id = TEST_VOL, record_id = rid, vb = FALSE) - delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE) return(NULL) } + list(session_id = sid, record_id = rid) } test_that("remove_default_record_from_session detaches a record", { setup <- setup_attached("remove_default_record happy path") skip_if_null_response(setup, "setup for remove_default_record happy path") - on.exit( - { - delete_volume_record(vol_id = TEST_VOL, record_id = setup$record_id, vb = FALSE) - delete_session(vol_id = TEST_VOL, session_id = setup$session_id, vb = FALSE) - }, - add = TRUE - ) result <- remove_default_record_from_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = setup$session_id, record_id = setup$record_id, vb = FALSE @@ -69,7 +44,7 @@ test_that("remove_default_record_from_session detaches a record", { # Verify the record is no longer among default_records session <- get_session_by_id( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = setup$session_id, vb = FALSE ) @@ -82,20 +57,15 @@ test_that("remove_default_record_from_session detaches a record", { }) test_that("remove_default_record_from_session returns FALSE for unattached record", { - sid <- new_session_id("remove_default_record unattached") + sid <- make_test_session("remove_default_record unattached") skip_if_null_response(sid, "create_session for unattached test") - on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) - rid <- new_record_id("remove_default_record unattached record") + rid <- make_test_record("remove_default_record unattached record") skip_if_null_response(rid, "create_volume_record for unattached test") - on.exit( - delete_volume_record(vol_id = TEST_VOL, record_id = rid, vb = FALSE), - add = TRUE - ) expect_false( remove_default_record_from_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = sid, record_id = rid, vb = FALSE @@ -104,13 +74,12 @@ test_that("remove_default_record_from_session returns FALSE for unattached recor }) test_that("remove_default_record_from_session returns FALSE for non-existent record", { - sid <- new_session_id("remove_default_record non-existent record") + sid <- make_test_session("remove_default_record non-existent record") skip_if_null_response(sid, "create_session for non-existent record test") - on.exit(delete_session(vol_id = TEST_VOL, session_id = sid, vb = FALSE), add = TRUE) expect_false( remove_default_record_from_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = sid, record_id = 999999999, vb = FALSE @@ -119,16 +88,12 @@ test_that("remove_default_record_from_session returns FALSE for non-existent rec }) test_that("remove_default_record_from_session returns FALSE for non-existent session", { - rid <- new_record_id("remove_default_record non-existent session record") + rid <- make_test_record("remove_default_record non-existent session record") skip_if_null_response(rid, "create_volume_record for non-existent session test") - on.exit( - delete_volume_record(vol_id = TEST_VOL, record_id = rid, vb = FALSE), - add = TRUE - ) expect_false( remove_default_record_from_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = 999999999, record_id = rid, vb = FALSE @@ -139,17 +104,10 @@ test_that("remove_default_record_from_session returns FALSE for non-existent ses test_that("remove_default_record_from_session works with verbose mode", { setup <- setup_attached("remove_default_record vb") skip_if_null_response(setup, "setup for remove_default_record vb") - on.exit( - { - delete_volume_record(vol_id = TEST_VOL, record_id = setup$record_id, vb = FALSE) - delete_session(vol_id = TEST_VOL, session_id = setup$session_id, vb = FALSE) - }, - add = TRUE - ) expect_true( remove_default_record_from_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = setup$session_id, record_id = setup$record_id, vb = TRUE @@ -160,18 +118,11 @@ test_that("remove_default_record_from_session works with verbose mode", { test_that("remove_default_record_from_session works with custom request object", { setup <- setup_attached("remove_default_record custom rq") skip_if_null_response(setup, "setup for remove_default_record custom rq") - on.exit( - { - delete_volume_record(vol_id = TEST_VOL, record_id = setup$record_id, vb = FALSE) - delete_session(vol_id = TEST_VOL, session_id = setup$session_id, vb = FALSE) - }, - add = TRUE - ) custom_rq <- databraryr::make_default_request() expect_true( remove_default_record_from_session( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, session_id = setup$session_id, record_id = setup$record_id, rq = custom_rq, diff --git a/tests/testthat/test-session_record_lifecycle.R b/tests/testthat/test-session_record_lifecycle.R new file mode 100644 index 00000000..c8b53b35 --- /dev/null +++ b/tests/testthat/test-session_record_lifecycle.R @@ -0,0 +1,56 @@ +# Session + record integration roundtrip (idempotent via helper-fixtures.R). +login_test_account() + +test_that("full session and record lifecycle roundtrip", { + sid <- make_test_session("session_record lifecycle session") + skip_if_null_response(sid, "create_session for lifecycle") + + patched <- patch_session( + vol_id = TEST_VOL_ID, + session_id = sid, + name = "session_record lifecycle session renamed", + vb = FALSE + ) + skip_if_null_response(patched, "patch_session in lifecycle") + expect_equal(patched$name, "session_record lifecycle session renamed") + + rid <- make_test_record("session_record lifecycle record") + skip_if_null_response(rid, "create_volume_record for lifecycle") + + # Optional metric 30 on category 6 in sandbox volume 1777 (see create_volume_record tests). + measure_result <- set_record_measure( + vol_id = TEST_VOL_ID, + record_id = rid, + metric_id = 30L, + value = "Lifecycle measure value", + vb = FALSE + ) + skip_if_null_response(measure_result, "set_record_measure in lifecycle") + + expect_true( + add_default_record_to_session( + vol_id = TEST_VOL_ID, + session_id = sid, + record_id = rid, + vb = FALSE + ) + ) + + expect_true( + remove_default_record_from_session( + vol_id = TEST_VOL_ID, + session_id = sid, + record_id = rid, + vb = FALSE + ) + ) + + updated <- update_volume_record( + vol_id = TEST_VOL_ID, + record_id = rid, + measures = list("29" = "Lifecycle updated"), + vb = FALSE + ) + skip_if_null_response(updated, "update_volume_record in lifecycle") + expect_equal(updated$record_id, rid) +}) diff --git a/tests/testthat/test-update_session.R b/tests/testthat/test-update_session.R index 7b255933..0879a49c 100644 --- a/tests/testthat/test-update_session.R +++ b/tests/testthat/test-update_session.R @@ -1,18 +1,9 @@ # update_session() ------------------------------------------------------------- login_test_account() -new_session_id <- function(name = "update_session test") { - created <- create_session(vol_id = 1777, name = name, vb = FALSE) - if (is.null(created)) { - return(NULL) - } - created$id -} - test_that("update_session replaces name via PUT", { - sid <- new_session_id("update_session original") + sid <- make_test_session("update_session original") skip_if_null_response(sid, "create_session for update_session name test") - on.exit(delete_session(vol_id = 1777, session_id = sid, vb = FALSE), add = TRUE) result <- update_session( vol_id = 1777, @@ -28,9 +19,8 @@ test_that("update_session replaces name via PUT", { }) test_that("update_session replaces source_date with a Date object", { - sid <- new_session_id("update_session source_date Date") + sid <- make_test_session("update_session source_date Date") skip_if_null_response(sid, "create_session for update_session source_date Date") - on.exit(delete_session(vol_id = 1777, session_id = sid, vb = FALSE), add = TRUE) result <- update_session( vol_id = 1777, @@ -54,9 +44,8 @@ test_that("update_session returns NULL for non-existent session", { }) test_that("update_session works with verbose mode", { - sid <- new_session_id("update_session vb") + sid <- make_test_session("update_session vb") skip_if_null_response(sid, "create_session for update_session vb") - on.exit(delete_session(vol_id = 1777, session_id = sid, vb = FALSE), add = TRUE) result <- update_session( vol_id = 1777, @@ -69,9 +58,8 @@ test_that("update_session works with verbose mode", { }) test_that("update_session works with custom request object", { - sid <- new_session_id("update_session custom rq") + sid <- make_test_session("update_session custom rq") skip_if_null_response(sid, "create_session for update_session custom rq") - on.exit(delete_session(vol_id = 1777, session_id = sid, vb = FALSE), add = TRUE) custom_rq <- databraryr::make_default_request() result <- update_session( diff --git a/tests/testthat/test-upload_file.R b/tests/testthat/test-upload_file.R index 59d7a781..b067ee8a 100644 --- a/tests/testthat/test-upload_file.R +++ b/tests/testthat/test-upload_file.R @@ -1,8 +1,6 @@ # upload_file() ---------------------------------------------------------------- login_test_account() -TEST_VOL <- 1777 - test_that("upload_file rejects missing or empty path", { expect_error(upload_file( path = "/nope/does/not/exist", destination_type = "session", object_id = 1 @@ -22,14 +20,8 @@ test_that("upload_file rejects empty file", { }) test_that("upload_file uploads a small file end-to-end", { - session <- create_session( - vol_id = TEST_VOL, name = "upload_file test", vb = FALSE - ) - skip_if_null_response(session, "create_session for upload_file") - on.exit( - delete_session(vol_id = TEST_VOL, session_id = session$id, vb = FALSE), - add = TRUE - ) + sid <- make_test_session("upload_file test") + skip_if_null_response(sid, "create_session for upload_file") tmp <- tempfile(fileext = ".bin") on.exit(unlink(tmp), add = TRUE) @@ -38,7 +30,7 @@ test_that("upload_file uploads a small file end-to-end", { result <- upload_file( path = tmp, destination_type = "session", - object_id = session$id, + object_id = sid, content_type = "application/octet-stream", vb = FALSE ) @@ -50,14 +42,8 @@ test_that("upload_file uploads a small file end-to-end", { }) test_that("upload_file infers filename and content_type", { - session <- create_session( - vol_id = TEST_VOL, name = "upload_file inference test", vb = FALSE - ) - skip_if_null_response(session, "create_session for upload_file inference") - on.exit( - delete_session(vol_id = TEST_VOL, session_id = session$id, vb = FALSE), - add = TRUE - ) + sid <- make_test_session("upload_file inference test") + skip_if_null_response(sid, "create_session for upload_file inference") tmp <- tempfile(fileext = ".mp4") on.exit(unlink(tmp), add = TRUE) @@ -66,7 +52,7 @@ test_that("upload_file infers filename and content_type", { result <- upload_file( path = tmp, destination_type = "session", - object_id = session$id, + object_id = sid, vb = FALSE ) skip_if_null_response(result, "upload_file inference") From 29f048ff7f1af396e6956e347c97094f0412899a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 14 May 2026 09:11:06 +0200 Subject: [PATCH 65/77] fix: update documentation and tests for check_duplicate_files_in_folder to handle missing folder_id scenario --- R/check_duplicate_files_in_folder.R | 4 +++- man/check_duplicate_files_in_folder.Rd | 4 +++- tests/testthat/test-check_duplicate_files_in_folder.R | 9 +++++++-- 3 files changed, 13 insertions(+), 4 deletions(-) diff --git a/R/check_duplicate_files_in_folder.R b/R/check_duplicate_files_in_folder.R index 1938a96b..15a7797e 100644 --- a/R/check_duplicate_files_in_folder.R +++ b/R/check_duplicate_files_in_folder.R @@ -17,7 +17,9 @@ NULL #' #' @return A \code{tibble} with columns \code{filename} (character) and #' \code{exists} (logical), one row per input filename and in the same -#' order. Returns \code{NULL} if the request fails. +#' order. Returns \code{NULL} if the request fails. Against current staging API, +#' a missing \code{folder_id} still yields a successful response with +#' \code{exists = FALSE} for each filename (nothing matches that folder). #' #' @inheritParams options_params #' diff --git a/man/check_duplicate_files_in_folder.Rd b/man/check_duplicate_files_in_folder.Rd index 4ebc2c46..39b7cee7 100644 --- a/man/check_duplicate_files_in_folder.Rd +++ b/man/check_duplicate_files_in_folder.Rd @@ -27,7 +27,9 @@ at least 1; each element must be a non-empty string.} \value{ A \code{tibble} with columns \code{filename} (character) and \code{exists} (logical), one row per input filename and in the same -order. Returns \code{NULL} if the request fails. +order. Returns \code{NULL} if the request fails. Against current staging API, +a missing \code{folder_id} still yields a successful response with +\code{exists = FALSE} for each filename (nothing matches that folder). } \description{ Ask the server which of the supplied filenames already diff --git a/tests/testthat/test-check_duplicate_files_in_folder.R b/tests/testthat/test-check_duplicate_files_in_folder.R index a5ded545..16d4d5f5 100644 --- a/tests/testthat/test-check_duplicate_files_in_folder.R +++ b/tests/testthat/test-check_duplicate_files_in_folder.R @@ -68,14 +68,19 @@ test_that("check_duplicate_files_in_folder works with a single filename", { expect_false(result$exists) }) -test_that("check_duplicate_files_in_folder returns NULL for non-existent folder", { +test_that("check_duplicate_files_in_folder treats missing folder like empty (all not found)", { + # Backend accepts the request and queries by folder_id only; staging returns + # a tibble with exists = FALSE when no files match (same idea as sessions). result <- check_duplicate_files_in_folder( vol_id = TEST_VOL, folder_id = 999999999, filenames = c("a.mp4"), vb = FALSE ) - expect_null(result) + skip_if_null_response(result, "check_duplicate_files_in_folder(non-existent folder)") + expect_s3_class(result, "tbl_df") + expect_equal(result$filename, "a.mp4") + expect_false(result$exists) }) test_that("check_duplicate_files_in_folder works with verbose mode", { From cc2d49486d953ead3ea05e341c6733bc3dd2924b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 14 May 2026 14:42:17 +0200 Subject: [PATCH 66/77] refactor: remove list_session_activity function and update related documentation; modify check_duplicate_files functions to clarify usage and improve error handling; adjust download functions to accept NULL for data frames and enhance parameter validation --- NAMESPACE | 1 - R/check_duplicate_files_in_folder.R | 2 +- R/check_duplicate_files_in_session.R | 2 +- R/download_folder_assets_fr_df.R | 47 ++-- R/download_session_assets_fr_df.R | 48 ++-- R/list_session_activity.R | 155 ----------- R/list_volume_records.R | 20 +- man/check_duplicate_files_in_folder.Rd | 2 +- man/check_duplicate_files_in_session.Rd | 2 +- man/download_folder_assets_fr_df.Rd | 6 +- man/download_session_assets_fr_df.Rd | 8 +- man/list_session_activity.Rd | 39 --- tests/testthat/helper-auth.R | 9 + tests/testthat/helper-fixtures.R | 115 ++++++++ tests/testthat/test-assign_constants.R | 4 +- tests/testthat/test-assign_record_to_file.R | 212 +++++++------- .../test-check_duplicate_files_in_folder.R | 39 +-- tests/testthat/test-create_folder.R | 117 ++++---- tests/testthat/test-create_session.R | 94 +++---- tests/testthat/test-create_volume_record.R | 106 +++---- tests/testthat/test-delete_folder.R | 71 +++-- tests/testthat/test-delete_record_measure.R | 119 +++----- tests/testthat/test-delete_session.R | 72 +++-- tests/testthat/test-delete_session_file.R | 60 ++-- tests/testthat/test-delete_volume_record.R | 102 +++---- tests/testthat/test-get_db_stats.R | 4 +- tests/testthat/test-get_folder_file.R | 28 +- .../test-get_institution_statistics.R | 17 +- tests/testthat/test-get_user_statistics.R | 5 +- .../test-get_volume_collaborator_by_id.R | 31 +-- tests/testthat/test-get_volume_record_by_id.R | 42 +-- tests/testthat/test-list_institutions.R | 15 +- tests/testthat/test-list_session_activity.R | 25 -- tests/testthat/test-list_volume_activity.R | 5 - tests/testthat/test-list_volume_assets.R | 10 +- tests/testthat/test-list_volume_info.R | 1 - tests/testthat/test-list_volume_links.R | 4 +- tests/testthat/test-list_volume_records.R | 15 +- tests/testthat/test-list_volume_sessions.R | 5 +- tests/testthat/test-list_volume_tags.R | 4 +- tests/testthat/test-patch_folder.R | 78 +++--- tests/testthat/test-patch_session.R | 78 +++--- tests/testthat/test-patch_session_file.R | 78 +++--- .../test-remove_default_record_from_session.R | 21 +- tests/testthat/test-search_for_tags.R | 5 +- tests/testthat/test-search_institutions.R | 5 +- tests/testthat/test-search_users.R | 5 +- tests/testthat/test-search_volumes.R | 5 +- tests/testthat/test-set_record_measure.R | 114 +++----- .../testthat/test-unassign_record_from_file.R | 260 +++++++++--------- tests/testthat/test-update_folder.R | 80 +++--- tests/testthat/test-update_session.R | 80 +++--- tests/testthat/test-update_session_file.R | 80 +++--- tests/testthat/test-update_volume_record.R | 72 ++--- tests/testthat/test-upload_file.R | 6 +- tests/testthat/test-volume_categories.R | 15 +- 56 files changed, 1215 insertions(+), 1430 deletions(-) delete mode 100644 R/list_session_activity.R delete mode 100644 man/list_session_activity.Rd delete mode 100644 tests/testthat/test-list_session_activity.R diff --git a/NAMESPACE b/NAMESPACE index 4088a9fa..a267d97b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -60,7 +60,6 @@ export(list_categories) export(list_folder_assets) export(list_institution_affiliates) export(list_institutions) -export(list_session_activity) export(list_session_assets) export(list_user_affiliates) export(list_user_history) diff --git a/R/check_duplicate_files_in_folder.R b/R/check_duplicate_files_in_folder.R index 15a7797e..c31e8658 100644 --- a/R/check_duplicate_files_in_folder.R +++ b/R/check_duplicate_files_in_folder.R @@ -6,7 +6,7 @@ NULL #' Check Whether Filenames Already Exist in a Folder #' #' @description Ask the server which of the supplied filenames already -#' exist as files in the given folder. Useful before bulk uploads to detect +#' exist as files in the given folder. Useful before uploading multiple files to detect #' name collisions in advance. #' #' @param vol_id Target volume number. Must be a positive integer. diff --git a/R/check_duplicate_files_in_session.R b/R/check_duplicate_files_in_session.R index a535bbc2..e6e3d688 100644 --- a/R/check_duplicate_files_in_session.R +++ b/R/check_duplicate_files_in_session.R @@ -6,7 +6,7 @@ NULL #' Check Whether Filenames Already Exist in a Session #' #' @description Ask the server which of the supplied filenames already -#' exist as files in the given session. Useful before bulk uploads to detect +#' exist as files in the given session. Useful before uploading multiple files to detect #' name collisions in advance. #' #' @param vol_id Target volume number. Must be a positive integer. diff --git a/R/download_folder_assets_fr_df.R b/R/download_folder_assets_fr_df.R index 17067019..6552b97d 100644 --- a/R/download_folder_assets_fr_df.R +++ b/R/download_folder_assets_fr_df.R @@ -48,6 +48,32 @@ download_folder_assets_fr_df <- timeout_secs = REQUEST_TIMEOUT_VERY_LONG, vb = options::opt("vb"), rq = NULL) { + assertthat::assert_that(length(target_dir) == 1) + assertthat::assert_that(is.character(target_dir)) + + assertthat::assert_that(length(add_folder_subdir) == 1) + assertthat::assert_that(is.logical(add_folder_subdir)) + + assertthat::assert_that(length(overwrite) == 1) + assertthat::assert_that(is.logical(overwrite)) + + assertthat::assert_that(length(make_portable_fn) == 1) + assertthat::assert_that(is.logical(make_portable_fn)) + + assertthat::assert_that(assertthat::is.number(timeout_secs)) + assertthat::assert_that(length(timeout_secs) == 1) + assertthat::assert_that(timeout_secs > 0) + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || + ("httr2_request" %in% class(rq))) + + if (is.null(folder_df)) { + folder_df <- list_folder_assets(vol_id = 1) + } + assertthat::assert_that(is.data.frame(folder_df)) required_cols <- c("vol_id", "folder_id", "asset_id", "asset_name") missing_cols <- setdiff(required_cols, names(folder_df)) @@ -59,8 +85,6 @@ download_folder_assets_fr_df <- ) } - assertthat::assert_that(length(target_dir) == 1) - assertthat::assert_that(is.character(target_dir)) if (dir.exists(target_dir)) { if (!overwrite) { if (vb) { @@ -75,25 +99,6 @@ download_folder_assets_fr_df <- } assertthat::is.writeable(target_dir) - assertthat::assert_that(length(add_folder_subdir) == 1) - assertthat::assert_that(is.logical(add_folder_subdir)) - - assertthat::assert_that(length(overwrite) == 1) - assertthat::assert_that(is.logical(overwrite)) - - assertthat::assert_that(length(make_portable_fn) == 1) - assertthat::assert_that(is.logical(make_portable_fn)) - - assertthat::assert_that(assertthat::is.number(timeout_secs)) - assertthat::assert_that(length(timeout_secs) == 1) - assertthat::assert_that(timeout_secs > 0) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || - ("httr2_request" %in% class(rq))) - if (vb) { message("Downloading n=", nrow(folder_df), " files to ", target_dir) } diff --git a/R/download_session_assets_fr_df.R b/R/download_session_assets_fr_df.R index b7b7da9c..fde7f6c6 100644 --- a/R/download_session_assets_fr_df.R +++ b/R/download_session_assets_fr_df.R @@ -49,6 +49,33 @@ download_session_assets_fr_df <- timeout_secs = REQUEST_TIMEOUT_VERY_LONG, vb = options::opt("vb"), rq = NULL) { + assertthat::assert_that(length(target_dir) == 1) + assertthat::assert_that(is.character(target_dir)) + + assertthat::assert_that(length(add_session_subdir) == 1) + assertthat::assert_that(is.logical(add_session_subdir)) + + assertthat::assert_that(length(overwrite) == 1) + assertthat::assert_that(is.logical(overwrite)) + + assertthat::assert_that(length(make_portable_fn) == 1) + assertthat::assert_that(is.logical(make_portable_fn)) + + assertthat::assert_that(assertthat::is.number(timeout_secs)) + assertthat::assert_that(length(timeout_secs) == 1) + assertthat::assert_that(timeout_secs > 0) + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || + ("httr2_request" %in% class(rq))) + + if (is.null(session_df)) { + session_df <- list_session_assets(session_id = 9224, + vol_id = 1) + } + assertthat::assert_that(is.data.frame(session_df)) required_cols <- c("vol_id", "session_id", "asset_id", "asset_name") missing_cols <- setdiff(required_cols, names(session_df)) @@ -60,8 +87,6 @@ download_session_assets_fr_df <- ) } - assertthat::assert_that(length(target_dir) == 1) - assertthat::assert_that(is.character(target_dir)) if (dir.exists(target_dir)) { if (!overwrite) { if (vb) { @@ -76,25 +101,6 @@ download_session_assets_fr_df <- } assertthat::is.writeable(target_dir) - assertthat::assert_that(length(add_session_subdir) == 1) - assertthat::assert_that(is.logical(add_session_subdir)) - - assertthat::assert_that(length(overwrite) == 1) - assertthat::assert_that(is.logical(overwrite)) - - assertthat::assert_that(length(make_portable_fn) == 1) - assertthat::assert_that(is.logical(make_portable_fn)) - - assertthat::assert_that(assertthat::is.number(timeout_secs)) - assertthat::assert_that(length(timeout_secs) == 1) - assertthat::assert_that(timeout_secs > 0) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) || - ("httr2_request" %in% class(rq))) - if (vb) { message("Downloading n=", nrow(session_df), " files to ", target_dir) } diff --git a/R/list_session_activity.R b/R/list_session_activity.R deleted file mode 100644 index c8326fa1..00000000 --- a/R/list_session_activity.R +++ /dev/null @@ -1,155 +0,0 @@ -#' @eval options::as_params() -#' @name options_params -#' -NULL - -#' List Activity History in Databrary Session. -#' -#' @description For an accessible session, returns the logged history events associated with -#' the session. Requires authenticated access with sufficient permissions. -#' -#' @param vol_id Volume identifier (required by the Django API). Must be a positive integer. -#' @param session_id Session identifier. Must be a positive integer. -#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. -#' @param rq An `httr2` request object. Defaults to `NULL`. When `NULL`, a -#' default request is generated, but this will only permit public information -#' to be returned. -#' -#' @returns A tibble with the activity history for a session, or `NULL` when -#' no data is available. -#' -#' @inheritParams options_params -#' -#' @examples -#' \donttest{ -#' \dontrun{ -#' list_session_activity(vol_id = 1892, session_id = 76113) -#' } -#' } -#' @export -list_session_activity <- - function(vol_id = 1892, - session_id = 76113, - vb = options::opt("vb"), - rq = NULL) { - # Check parameters - assertthat::assert_that(length(vol_id) == 1) - assertthat::assert_that(is.numeric(vol_id)) - assertthat::assert_that(vol_id > 0) - - assertthat::assert_that(length(session_id) == 1) - assertthat::assert_that(is.numeric(session_id)) - assertthat::assert_that(session_id > 0) - - assertthat::assert_that(length(vb) == 1) - validate_flag(vb, "vb") - - assertthat::assert_that(is.null(rq) || - inherits(rq, "httr2_request")) - - if (is.null(rq)) { - rq <- databraryr::make_default_request() - } - rq <- httr2::req_timeout(rq, REQUEST_TIMEOUT_VERY_LONG) - - activities <- collect_paginated_get( - path = sprintf(API_VOLUME_HISTORY, vol_id), - rq = rq, - vb = vb - ) - - if (is.null(activities) || length(activities) == 0) { - if (vb) { - message("No activity history available for volume ", vol_id) - } - return(NULL) - } - - session_details <- databraryr::get_session_by_id( - session_id = session_id, - vol_id = vol_id, - vb = vb, - rq = rq - ) - session_name <- NULL - if (!is.null(session_details)) { - session_name <- session_details$name - } - - session_entries <- purrr::keep(activities, function(entry) { - session_identifier <- entry$session_id - if (is.null(session_identifier) && !is.null(entry$session)) { - session_value <- entry$session - if (is.list(session_value) && !is.null(session_value$id)) { - session_identifier <- session_value$id - } else { - session_identifier <- session_value - } - } - - if (!is.null(session_identifier)) { - return(isTRUE(session_identifier == session_id)) - } - - if (!is.null(session_name) && !is.null(entry$name)) { - return(isTRUE(entry$name == session_name)) - } - - FALSE - }) - - if (length(session_entries) == 0) { - if (vb) { - message("No activity history for session ", - session_id, - " within volume ", - vol_id) - } - return(NULL) - } - - purrr::map_dfr(session_entries, function(entry) { - history_user <- entry$history_user - folder_id <- entry$folder_id - if (is.null(folder_id) && !is.null(entry$folder)) { - folder <- entry$folder - if (is.list(folder) && !is.null(folder$id)) { - folder_id <- folder$id - } else { - folder_id <- folder - } - } - - safe_int <- function(value) { - if (is.null(value)) - NA_integer_ - else - value - } - - safe_chr <- function(value) { - if (is.null(value)) - NA_character_ - else - value - } - - tibble::tibble( - event_type = entry$type, - event_timestamp = entry$timestamp, - history_id = safe_int(entry$history_id), - history_user_id = safe_int(history_user$id), - history_user_email = safe_chr(history_user$email), - history_user_first_name = safe_chr(history_user$first_name), - history_user_last_name = safe_chr(history_user$last_name), - ip_address = entry$ip_address, - changed_fields = list(entry$changed_fields), - changed_data = list(entry$changed_data), - volume_id = vol_id, - session_id = session_id, - session_name = safe_chr(entry$name), - folder_id = safe_int(folder_id), - deleted_at = entry$deleted_at - ) - }) - } diff --git a/R/list_volume_records.R b/R/list_volume_records.R index 3041e544..5c4e8995 100644 --- a/R/list_volume_records.R +++ b/R/list_volume_records.R @@ -102,24 +102,16 @@ list_volume_records <- function(vol_id = 1, if (length(records) == 0) { if (vb) { - message("No records found with category_id = ", - category_id, - " for volume ", - vol_id) + cat_part <- if (is.null(category_id)) { + "(all categories)" + } else { + paste0("category_id = ", category_id) + } + message("No records found with ", cat_part, " for volume ", vol_id) } return(empty_volume_records_tibble()) } - if (vb) - message( - "Found n = ", - length(records), - " records with category_id = ", - category_id, - " in volume ", - vol_id - ) - # Process records into tibble purrr::map_dfr(records, function(record) { # Process age if present diff --git a/man/check_duplicate_files_in_folder.Rd b/man/check_duplicate_files_in_folder.Rd index 39b7cee7..49bb93f4 100644 --- a/man/check_duplicate_files_in_folder.Rd +++ b/man/check_duplicate_files_in_folder.Rd @@ -33,7 +33,7 @@ a missing \code{folder_id} still yields a successful response with } \description{ Ask the server which of the supplied filenames already -exist as files in the given folder. Useful before bulk uploads to detect +exist as files in the given folder. Useful before uploading multiple files to detect name collisions in advance. } \examples{ diff --git a/man/check_duplicate_files_in_session.Rd b/man/check_duplicate_files_in_session.Rd index f4d6086d..87e4ee49 100644 --- a/man/check_duplicate_files_in_session.Rd +++ b/man/check_duplicate_files_in_session.Rd @@ -33,7 +33,7 @@ reported as \code{exists = FALSE} (no rows match that session). } \description{ Ask the server which of the supplied filenames already -exist as files in the given session. Useful before bulk uploads to detect +exist as files in the given session. Useful before uploading multiple files to detect name collisions in advance. } \examples{ diff --git a/man/download_folder_assets_fr_df.Rd b/man/download_folder_assets_fr_df.Rd index aa3a3edc..40094704 100644 --- a/man/download_folder_assets_fr_df.Rd +++ b/man/download_folder_assets_fr_df.Rd @@ -5,7 +5,7 @@ \title{Download Multiple Assets From a Folder Data Frame.} \usage{ download_folder_assets_fr_df( - folder_df = list_folder_assets(vol_id = 1), + folder_df = NULL, target_dir = tempdir(), add_folder_subdir = TRUE, overwrite = TRUE, @@ -17,7 +17,9 @@ download_folder_assets_fr_df( } \arguments{ \item{folder_df}{Data frame describing assets. Must include \code{vol_id}, -\code{folder_id}, \code{asset_id}, and \code{asset_name} columns.} +\code{folder_id}, \code{asset_id}, and \code{asset_name} columns. Defaults to \code{NULL}, in +which case \code{list_folder_assets(vol_id = 1)} is used after other arguments +are validated (so invalid parameters fail without a network call).} \item{target_dir}{Character string. Base directory for downloads. Defaults to \code{tempdir()}.} diff --git a/man/download_session_assets_fr_df.Rd b/man/download_session_assets_fr_df.Rd index 661ab45c..39a83d49 100644 --- a/man/download_session_assets_fr_df.Rd +++ b/man/download_session_assets_fr_df.Rd @@ -5,7 +5,7 @@ \title{Download Multiple Assets From a Session Data Frame.} \usage{ download_session_assets_fr_df( - session_df = list_session_assets(session_id = 9224, vol_id = 1), + session_df = NULL, target_dir = tempdir(), add_session_subdir = TRUE, overwrite = TRUE, @@ -17,8 +17,10 @@ download_session_assets_fr_df( } \arguments{ \item{session_df}{Data frame describing assets. Must include \code{vol_id}, -\code{session_id}, \code{asset_id}, and \code{asset_name} columns. Default is the result -\code{download_session_assets_fr_df(session_id = assets, vol_id = 1)}.} +\code{session_id}, \code{asset_id}, and \code{asset_name} columns. Defaults to \code{NULL}, +in which case \code{list_session_assets(session_id = 9224, vol_id = 1)} is +used after other arguments are validated (so invalid parameters such as +\code{target_dir = 3} fail without a network call).} \item{target_dir}{Character string. Base directory for downloads. Defaults to \code{tempdir()}.} diff --git a/man/list_session_activity.Rd b/man/list_session_activity.Rd deleted file mode 100644 index ffa4fab1..00000000 --- a/man/list_session_activity.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/list_session_activity.R -\name{list_session_activity} -\alias{list_session_activity} -\title{List Activity History in Databrary Session.} -\usage{ -list_session_activity( - vol_id = 1892, - session_id = 76113, - vb = options::opt("vb"), - rq = NULL -) -} -\arguments{ -\item{vol_id}{Volume identifier (required by the Django API). Must be a positive integer.} - -\item{session_id}{Session identifier. Must be a positive integer.} - -\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} - -\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}. When \code{NULL}, a -default request is generated, but this will only permit public information -to be returned.} -} -\value{ -A tibble with the activity history for a session, or \code{NULL} when -no data is available. -} -\description{ -For an accessible session, returns the logged history events associated with -the session. Requires authenticated access with sufficient permissions. -} -\examples{ -\donttest{ -\dontrun{ -list_session_activity(vol_id = 1892, session_id = 76113) -} -} -} diff --git a/tests/testthat/helper-auth.R b/tests/testthat/helper-auth.R index 26111cb6..a153397c 100644 --- a/tests/testthat/helper-auth.R +++ b/tests/testthat/helper-auth.R @@ -23,6 +23,15 @@ login_test_account <- function() { Sys.setenv(DATABRARY_BASE_URL = "https://api.stg-databrary.its.nyu.edu") } + # Reuse token for the rest of the R process (testthat default: one process per run). + bundle_existing <- databraryr:::get_token_bundle() + if ( + !is.null(bundle_existing) && + !databraryr:::is_missing_string(bundle_existing$access_token) + ) { + return(invisible(TRUE)) + } + vals <- list( email = Sys.getenv("DATABRARY_LOGIN"), password = Sys.getenv("DATABRARY_PASSWORD"), diff --git a/tests/testthat/helper-fixtures.R b/tests/testthat/helper-fixtures.R index 85a0ea3a..6d027046 100644 --- a/tests/testthat/helper-fixtures.R +++ b/tests/testthat/helper-fixtures.R @@ -71,3 +71,118 @@ make_test_record <- function( ) rid } + +# create_folder, then schedule delete_folder on `envir` via withr::defer. +# See make_test_session() for `envir` usage. +make_test_folder <- function( + name, + vol_id = TEST_VOL_ID, + release_level = NULL, + source_date = NULL, + vb = FALSE, + rq = NULL, + envir = parent.frame()) { + created <- create_folder( + vol_id = vol_id, + name = name, + release_level = release_level, + source_date = source_date, + vb = vb, + rq = rq + ) + + if (is.null(created) || is.null(created$id)) { + return(NULL) + } + + fid <- as.integer(created$id) + withr::defer( + delete_folder(vol_id = vol_id, folder_id = fid, vb = FALSE), + envir = envir + ) + fid +} + +# Upload a small text file into a session and wait until it appears in listing. +# Use file_basename with a text extension (e.g. .txt); staging may reject +# application/octet-stream. Session defer deletes the session and assets. +upload_test_session_asset <- function( + session_id, + vol_id = TEST_VOL_ID, + file_basename = "test_asset.txt", + vb = FALSE, + max_wait_s = 120L, + envir = parent.frame()) { + tmp <- tempfile(fileext = paste0(".", tools::file_ext(file_basename))) + writeLines(strrep("x", 2048L), tmp, useBytes = FALSE) + withr::defer(unlink(tmp, force = TRUE), envir = envir) + + ct <- databraryr:::guess_content_type(file_basename) + + up <- upload_file( + path = tmp, + destination_type = "session", + object_id = session_id, + content_type = ct, + filename = file_basename, + vb = vb + ) + if (is.null(up)) { + return(NULL) + } + + deadline <- Sys.time() + as.numeric(max_wait_s) + while (Sys.time() < deadline) { + assets <- list_session_assets(vol_id = vol_id, session_id = session_id, vb = FALSE) + if (!is.null(assets) && nrow(assets) > 0L) { + m <- which(assets$asset_name == file_basename) + if (length(m)) { + return(as.integer(assets$asset_id[m[[1L]]])) + } + return(as.integer(assets$asset_id[nrow(assets)])) + } + Sys.sleep(1) + } + NULL +} + +# Folder variant of upload_test_session_asset(); folder teardown via make_test_folder defer. +upload_test_folder_asset <- function( + folder_id, + vol_id = TEST_VOL_ID, + file_basename = "folder_test_asset.txt", + vb = FALSE, + max_wait_s = 120L, + envir = parent.frame()) { + tmp <- tempfile(fileext = paste0(".", tools::file_ext(file_basename))) + writeLines(strrep("x", 2048L), tmp, useBytes = FALSE) + withr::defer(unlink(tmp, force = TRUE), envir = envir) + + ct <- databraryr:::guess_content_type(file_basename) + + up <- upload_file( + path = tmp, + destination_type = "folder", + object_id = folder_id, + content_type = ct, + filename = file_basename, + vb = vb + ) + if (is.null(up)) { + return(NULL) + } + + deadline <- Sys.time() + as.numeric(max_wait_s) + while (Sys.time() < deadline) { + assets <- list_folder_assets(vol_id = vol_id, folder_id = folder_id, vb = FALSE) + if (!is.null(assets) && nrow(assets) > 0L) { + m <- which(assets$asset_name == file_basename) + if (length(m)) { + return(as.integer(assets$asset_id[m[[1L]]])) + } + return(as.integer(assets$asset_id[nrow(assets)])) + } + Sys.sleep(1) + } + NULL +} diff --git a/tests/testthat/test-assign_constants.R b/tests/testthat/test-assign_constants.R index 3d30711a..1f44d200 100644 --- a/tests/testthat/test-assign_constants.R +++ b/tests/testthat/test-assign_constants.R @@ -1,5 +1,6 @@ +login_test_account() + test_that("assign_constants returns constants", { - login_test_account() result <- assign_constants() skip_if_null_response(result, "assign_constants()") expect_true(is.list(result)) @@ -19,7 +20,6 @@ test_that("assign_constants rejects bad input parameters", { }) test_that("assign_constants returns permission metadata", { - login_test_account() result <- assign_constants() skip_if_null_response(result, "assign_constants() metadata") expect_true("permission" %in% names(result)) diff --git a/tests/testthat/test-assign_record_to_file.R b/tests/testthat/test-assign_record_to_file.R index 3454d374..c5015bed 100644 --- a/tests/testthat/test-assign_record_to_file.R +++ b/tests/testthat/test-assign_record_to_file.R @@ -2,116 +2,110 @@ login_test_account() test_that("assign_record_to_file assigns a record to a file", { - # First create a record (unique name to avoid "already in use" across test runs) + sid <- make_test_session("assign_record_to_file session") + skip_if_null_response(sid, "create_session for assign test") + + asset_name <- sprintf("assign_probe_%d.txt", sample(100000L:999999L, 1L)) + file_id <- upload_test_session_asset(sid, file_basename = asset_name) + skip_if_null_response(file_id, "upload for assign test") + create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, name = sprintf("Assign test %d", sample(100000L:999999L, 1L)), vb = FALSE ) skip_if_null_response(create_result, "create_volume_record for assign test") record_id <- create_result$record_id - - # Get a session and file from volume 1 - sessions <- list_volume_sessions(vol_id = 1777, vb = FALSE) - skip_if_null_response(sessions, "list_volume_sessions for assign test") - - if (nrow(sessions) > 0) { - session_id <- sessions$session_id[1] - - # Get files from the session - files <- list_session_assets(vol_id = 1777, session_id = session_id, vb = FALSE) - - if (!is.null(files) && nrow(files) > 0) { - file_id <- files$asset_id[1] - - # Assign the record to the file - assign_result <- assign_record_to_file( - vol_id = 1777, - session_id = session_id, - file_id = file_id, - record_id = record_id, - vb = FALSE + withr::defer( + { + try( + unassign_record_from_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ), + silent = TRUE ) - - # Clean up - unassign first, then delete record - unassign_record_from_file( - vol_id = 1777, - session_id = session_id, - file_id = file_id, - record_id = record_id, - vb = FALSE + try( + delete_volume_record(vol_id = TEST_VOL_ID, record_id = record_id, vb = FALSE), + silent = TRUE ) - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + }, + envir = parent.frame() + ) - skip_if_null_response(assign_result, "assign_record_to_file") + assign_result <- assign_record_to_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) - expect_true(!is.null(assign_result)) - } - } + skip_if_null_response(assign_result, "assign_record_to_file") - # Clean up record if test was skipped - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + expect_true(!is.null(assign_result)) }) test_that("assign_record_to_file is idempotent", { - # Create a record (unique name to avoid "already in use" across test runs) + sid <- make_test_session("assign_record_to_file idempotent session") + skip_if_null_response(sid, "create_session for idempotent assign test") + + asset_name <- sprintf("assign_idem_%d.txt", sample(100000L:999999L, 1L)) + file_id <- upload_test_session_asset(sid, file_basename = asset_name) + skip_if_null_response(file_id, "upload for idempotent assign test") + create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, name = sprintf("Assign idempotent %d", sample(100000L:999999L, 1L)), vb = FALSE ) skip_if_null_response(create_result, "create_volume_record for idempotent test") record_id <- create_result$record_id - - # Get a session and file - sessions <- list_volume_sessions(vol_id = 1777, vb = FALSE) - skip_if_null_response(sessions, "list_volume_sessions for idempotent test") - - if (nrow(sessions) > 0) { - session_id <- sessions$session_id[1] - files <- list_session_assets(vol_id = 1777, session_id = session_id, vb = FALSE) - - if (!is.null(files) && nrow(files) > 0) { - file_id <- files$asset_id[1] - - # Assign twice - assign_result1 <- assign_record_to_file( - vol_id = 1777, - session_id = session_id, - file_id = file_id, - record_id = record_id, - vb = FALSE + withr::defer( + { + try( + unassign_record_from_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ), + silent = TRUE ) - - assign_result2 <- assign_record_to_file( - vol_id = 1777, - session_id = session_id, - file_id = file_id, - record_id = record_id, - vb = FALSE + try( + delete_volume_record(vol_id = TEST_VOL_ID, record_id = record_id, vb = FALSE), + silent = TRUE ) + }, + envir = parent.frame() + ) - # Clean up - unassign_record_from_file( - vol_id = 1777, - session_id = session_id, - file_id = file_id, - record_id = record_id, - vb = FALSE - ) - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + assign_result1 <- assign_record_to_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) - expect_true(!is.null(assign_result1)) - expect_true(!is.null(assign_result2)) - } - } + assign_result2 <- assign_record_to_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + expect_true(!is.null(assign_result1)) + expect_true(!is.null(assign_result2)) }) test_that("assign_record_to_file rejects invalid vol_id", { @@ -124,42 +118,42 @@ test_that("assign_record_to_file rejects invalid vol_id", { }) test_that("assign_record_to_file rejects invalid session_id", { - expect_error(assign_record_to_file(vol_id = 1777, session_id = -1, file_id = 1, record_id = 1)) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 0, file_id = 1, record_id = 1)) - expect_error(assign_record_to_file(vol_id = 1777, session_id = "1", file_id = 1, record_id = 1)) - expect_error(assign_record_to_file(vol_id = 1777, session_id = TRUE, file_id = 1, record_id = 1)) - expect_error(assign_record_to_file(vol_id = 1777, session_id = c(1, 2), file_id = 1, record_id = 1)) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1.5, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = -1, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 0, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = "1", file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = TRUE, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = c(1, 2), file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1.5, file_id = 1, record_id = 1)) }) test_that("assign_record_to_file rejects invalid file_id", { - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = -1, record_id = 1)) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 0, record_id = 1)) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = "1", record_id = 1)) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = TRUE, record_id = 1)) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = c(1, 2), record_id = 1)) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1.5, record_id = 1)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = -1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 0, record_id = 1)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = "1", record_id = 1)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = TRUE, record_id = 1)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = c(1, 2), record_id = 1)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1.5, record_id = 1)) }) test_that("assign_record_to_file rejects invalid record_id", { - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = -1)) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 0)) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = "1")) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = TRUE)) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = c(1, 2))) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1.5)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = -1)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 0)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = "1")) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = TRUE)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = c(1, 2))) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1.5)) }) test_that("assign_record_to_file rejects invalid vb parameter", { - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = -1)) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = 3)) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = "a")) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = c(TRUE, FALSE))) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = NULL)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = -1)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = 3)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = "a")) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = NULL)) }) test_that("assign_record_to_file rejects invalid rq parameter", { - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, rq = "a")) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, rq = -1)) - expect_error(assign_record_to_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, rq = TRUE)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, rq = "a")) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, rq = -1)) + expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, rq = TRUE)) }) diff --git a/tests/testthat/test-check_duplicate_files_in_folder.R b/tests/testthat/test-check_duplicate_files_in_folder.R index 16d4d5f5..ca198771 100644 --- a/tests/testthat/test-check_duplicate_files_in_folder.R +++ b/tests/testthat/test-check_duplicate_files_in_folder.R @@ -1,24 +1,13 @@ # check_duplicate_files_in_folder() -------------------------------------------- login_test_account() -TEST_VOL <- 1777 - -new_folder_id <- function(name = "check_duplicate_files_in_folder test") { - created <- create_folder(vol_id = TEST_VOL, name = name, vb = FALSE) - if (is.null(created)) { - return(NULL) - } - created$id -} - test_that("check_duplicate_files_in_folder returns a tibble for an empty folder", { - fid <- new_folder_id("check_duplicate_files_in_folder happy path") + fid <- make_test_folder("check_duplicate_files_in_folder happy path") skip_if_null_response(fid, "create_folder for check_duplicate_files happy path") - on.exit(delete_folder(vol_id = TEST_VOL, folder_id = fid, vb = FALSE), add = TRUE) filenames <- c("nonexistent_a.mp4", "nonexistent_b.mp4") result <- check_duplicate_files_in_folder( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, folder_id = fid, filenames = filenames, vb = FALSE @@ -34,13 +23,12 @@ test_that("check_duplicate_files_in_folder returns a tibble for an empty folder" }) test_that("check_duplicate_files_in_folder preserves input order", { - fid <- new_folder_id("check_duplicate_files_in_folder order") + fid <- make_test_folder("check_duplicate_files_in_folder order") skip_if_null_response(fid, "create_folder for order test") - on.exit(delete_folder(vol_id = TEST_VOL, folder_id = fid, vb = FALSE), add = TRUE) filenames <- c("z.mp4", "a.mp4", "m.mp4") result <- check_duplicate_files_in_folder( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, folder_id = fid, filenames = filenames, vb = FALSE @@ -51,12 +39,11 @@ test_that("check_duplicate_files_in_folder preserves input order", { }) test_that("check_duplicate_files_in_folder works with a single filename", { - fid <- new_folder_id("check_duplicate_files_in_folder single") + fid <- make_test_folder("check_duplicate_files_in_folder single") skip_if_null_response(fid, "create_folder for single filename test") - on.exit(delete_folder(vol_id = TEST_VOL, folder_id = fid, vb = FALSE), add = TRUE) result <- check_duplicate_files_in_folder( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, folder_id = fid, filenames = "only.mp4", vb = FALSE @@ -69,10 +56,8 @@ test_that("check_duplicate_files_in_folder works with a single filename", { }) test_that("check_duplicate_files_in_folder treats missing folder like empty (all not found)", { - # Backend accepts the request and queries by folder_id only; staging returns - # a tibble with exists = FALSE when no files match (same idea as sessions). result <- check_duplicate_files_in_folder( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, folder_id = 999999999, filenames = c("a.mp4"), vb = FALSE @@ -84,12 +69,11 @@ test_that("check_duplicate_files_in_folder treats missing folder like empty (all }) test_that("check_duplicate_files_in_folder works with verbose mode", { - fid <- new_folder_id("check_duplicate_files_in_folder vb") + fid <- make_test_folder("check_duplicate_files_in_folder vb") skip_if_null_response(fid, "create_folder for check_duplicate_files vb") - on.exit(delete_folder(vol_id = TEST_VOL, folder_id = fid, vb = FALSE), add = TRUE) result <- check_duplicate_files_in_folder( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, folder_id = fid, filenames = c("vb.mp4"), vb = TRUE @@ -99,13 +83,12 @@ test_that("check_duplicate_files_in_folder works with verbose mode", { }) test_that("check_duplicate_files_in_folder works with custom request object", { - fid <- new_folder_id("check_duplicate_files_in_folder custom rq") + fid <- make_test_folder("check_duplicate_files_in_folder custom rq") skip_if_null_response(fid, "create_folder for check_duplicate_files custom rq") - on.exit(delete_folder(vol_id = TEST_VOL, folder_id = fid, vb = FALSE), add = TRUE) custom_rq <- databraryr::make_default_request() result <- check_duplicate_files_in_folder( - vol_id = TEST_VOL, + vol_id = TEST_VOL_ID, folder_id = fid, filenames = c("custom.mp4"), rq = custom_rq, diff --git a/tests/testthat/test-create_folder.R b/tests/testthat/test-create_folder.R index 0c341f64..7ef987d4 100644 --- a/tests/testthat/test-create_folder.R +++ b/tests/testthat/test-create_folder.R @@ -2,33 +2,43 @@ login_test_account() test_that("create_folder creates a folder with name only", { - result <- create_folder(vol_id = 1777, name = "Test folder", vb = FALSE) - skip_if_null_response(result, "create_folder(vol_id = 1777, name = 'Test folder')") - - if (!is.null(result$id)) { - delete_folder(vol_id = 1777, folder_id = result$id, vb = FALSE) - } + result <- create_folder(vol_id = TEST_VOL_ID, name = "Test folder", vb = FALSE) + skip_if_null_response(result, "create_folder happy path") + + on.exit( + { + if (!is.null(result$id)) { + delete_folder(vol_id = TEST_VOL_ID, folder_id = result$id, vb = FALSE) + } + }, + add = TRUE + ) expect_type(result, "list") expect_true(!is.null(result$id)) expect_true(is.numeric(result$id) || is.integer(result$id)) expect_true(result$id > 0) - expect_equal(as.integer(result$volume), 1777L) + expect_equal(as.integer(result$volume), TEST_VOL_ID) expect_equal(result$name, "Test folder") }) test_that("create_folder accepts a Date source_date", { result <- create_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, name = "Test folder with Date", source_date = as.Date("2024-03-15"), vb = FALSE ) skip_if_null_response(result, "create_folder with Date source_date") - if (!is.null(result$id)) { - delete_folder(vol_id = 1777, folder_id = result$id, vb = FALSE) - } + on.exit( + { + if (!is.null(result$id)) { + delete_folder(vol_id = TEST_VOL_ID, folder_id = result$id, vb = FALSE) + } + }, + add = TRUE + ) expect_type(result, "list") expect_true(!is.null(result$id)) @@ -36,31 +46,41 @@ test_that("create_folder accepts a Date source_date", { test_that("create_folder accepts an ISO string source_date", { result <- create_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, name = "Test folder with ISO date", source_date = "2024-03-15", vb = FALSE ) skip_if_null_response(result, "create_folder with ISO source_date") - if (!is.null(result$id)) { - delete_folder(vol_id = 1777, folder_id = result$id, vb = FALSE) - } + on.exit( + { + if (!is.null(result$id)) { + delete_folder(vol_id = TEST_VOL_ID, folder_id = result$id, vb = FALSE) + } + }, + add = TRUE + ) expect_type(result, "list") }) test_that("create_folder works with verbose mode", { result <- create_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, name = "Test folder vb", vb = TRUE ) skip_if_null_response(result, "create_folder with vb = TRUE") - if (!is.null(result$id)) { - delete_folder(vol_id = 1777, folder_id = result$id, vb = FALSE) - } + on.exit( + { + if (!is.null(result$id)) { + delete_folder(vol_id = TEST_VOL_ID, folder_id = result$id, vb = FALSE) + } + }, + add = TRUE + ) expect_type(result, "list") }) @@ -68,16 +88,21 @@ test_that("create_folder works with verbose mode", { test_that("create_folder works with custom request object", { custom_rq <- databraryr::make_default_request() result <- create_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, name = "Test folder custom rq", rq = custom_rq, vb = FALSE ) skip_if_null_response(result, "create_folder with custom_rq") - if (!is.null(result$id)) { - delete_folder(vol_id = 1777, folder_id = result$id, vb = FALSE) - } + on.exit( + { + if (!is.null(result$id)) { + delete_folder(vol_id = TEST_VOL_ID, folder_id = result$id, vb = FALSE) + } + }, + add = TRUE + ) expect_type(result, "list") }) @@ -87,21 +112,21 @@ test_that("create_folder returns NULL for non-existent volume", { }) test_that("create_folder rejects invalid name", { - expect_error(create_folder(vol_id = 1777, name = "")) - expect_error(create_folder(vol_id = 1777, name = " ")) - expect_error(create_folder(vol_id = 1777, name = 123)) - expect_error(create_folder(vol_id = 1777, name = c("A", "B"))) - expect_error(create_folder(vol_id = 1777, name = NULL)) - expect_error(create_folder(vol_id = 1777, name = NA)) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "")) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = " ")) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = 123)) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = c("A", "B"))) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = NULL)) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = NA)) }) test_that("create_folder rejects malformed source_date", { - expect_error(create_folder(vol_id = 1777, name = "Test", source_date = "not-a-date")) - expect_error(create_folder(vol_id = 1777, name = "Test", source_date = "")) - expect_error(create_folder(vol_id = 1777, name = "Test", source_date = 123)) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", source_date = "not-a-date")) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", source_date = "")) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", source_date = 123)) expect_error( create_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, name = "Test", source_date = as.Date(c("2024-01-01", "2024-02-01")) ) @@ -109,9 +134,9 @@ test_that("create_folder rejects malformed source_date", { }) test_that("create_folder rejects invalid release_level", { - expect_error(create_folder(vol_id = 1777, name = "Test", release_level = "")) - expect_error(create_folder(vol_id = 1777, name = "Test", release_level = 1)) - expect_error(create_folder(vol_id = 1777, name = "Test", release_level = c("A", "B"))) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", release_level = "")) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", release_level = 1)) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", release_level = c("A", "B"))) }) test_that("create_folder rejects invalid vol_id", { @@ -125,17 +150,17 @@ test_that("create_folder rejects invalid vol_id", { }) test_that("create_folder rejects invalid vb parameter", { - expect_error(create_folder(vol_id = 1777, name = "Test", vb = -1)) - expect_error(create_folder(vol_id = 1777, name = "Test", vb = "a")) - expect_error(create_folder(vol_id = 1777, name = "Test", vb = list(a = 1))) - expect_error(create_folder(vol_id = 1777, name = "Test", vb = c(TRUE, FALSE))) - expect_error(create_folder(vol_id = 1777, name = "Test", vb = NULL)) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", vb = -1)) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", vb = "a")) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", vb = list(a = 1))) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", vb = c(TRUE, FALSE))) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", vb = NULL)) }) test_that("create_folder rejects invalid rq parameter", { - expect_error(create_folder(vol_id = 1777, name = "Test", rq = "a")) - expect_error(create_folder(vol_id = 1777, name = "Test", rq = -1)) - expect_error(create_folder(vol_id = 1777, name = "Test", rq = c(2, 3))) - expect_error(create_folder(vol_id = 1777, name = "Test", rq = list(a = 1))) - expect_error(create_folder(vol_id = 1777, name = "Test", rq = TRUE)) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", rq = "a")) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", rq = -1)) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", rq = c(2, 3))) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", rq = list(a = 1))) + expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", rq = TRUE)) }) diff --git a/tests/testthat/test-create_session.R b/tests/testthat/test-create_session.R index c6ad3c5e..6f7dec66 100644 --- a/tests/testthat/test-create_session.R +++ b/tests/testthat/test-create_session.R @@ -2,10 +2,10 @@ login_test_account() test_that("create_session creates a session with name only", { - result <- create_session(vol_id = 1777, name = "Test session", vb = FALSE) - skip_if_null_response(result, "create_session(vol_id = 1777, name = 'Test session')") + result <- create_session(vol_id = TEST_VOL_ID, name = "Test session", vb = FALSE) + skip_if_null_response(result, "create_session(vol_id = TEST_VOL_ID, name = 'Test session')") - on.exit(delete_session(vol_id = 1777, session_id = result$id, vb = FALSE), add = TRUE) + on.exit(delete_session(vol_id = TEST_VOL_ID, session_id = result$id, vb = FALSE), add = TRUE) expect_type(result, "list") expect_true(!is.null(result$id)) @@ -13,7 +13,7 @@ test_that("create_session creates a session with name only", { expect_true(result$id > 0) expect_equal(result$name, "Test session") # POST create returns SessionWriteSerializer data (no nested `volume`); confirm volume via GET. - fetched <- get_session_by_id(session_id = result$id, vol_id = 1777, vb = FALSE) + fetched <- get_session_by_id(session_id = result$id, vol_id = TEST_VOL_ID, vb = FALSE) skip_if_null_response(fetched, "get_session_by_id after create_session") v <- fetched$volume vol_id_actual <- if (is.list(v) && !is.null(v$id)) { @@ -21,19 +21,19 @@ test_that("create_session creates a session with name only", { } else { as.integer(v) } - expect_equal(vol_id_actual, 1777L) + expect_equal(vol_id_actual, as.integer(TEST_VOL_ID)) }) test_that("create_session accepts a Date source_date", { result <- create_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, name = "Test session with Date", source_date = as.Date("2024-03-15"), vb = FALSE ) skip_if_null_response(result, "create_session with Date source_date") - on.exit(delete_session(vol_id = 1777, session_id = result$id, vb = FALSE), add = TRUE) + on.exit(delete_session(vol_id = TEST_VOL_ID, session_id = result$id, vb = FALSE), add = TRUE) expect_type(result, "list") expect_true(!is.null(result$id)) @@ -41,27 +41,27 @@ test_that("create_session accepts a Date source_date", { test_that("create_session accepts an ISO string source_date", { result <- create_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, name = "Test session with ISO date", source_date = "2024-03-15", vb = FALSE ) skip_if_null_response(result, "create_session with ISO source_date") - on.exit(delete_session(vol_id = 1777, session_id = result$id, vb = FALSE), add = TRUE) + on.exit(delete_session(vol_id = TEST_VOL_ID, session_id = result$id, vb = FALSE), add = TRUE) expect_type(result, "list") }) test_that("create_session works with verbose mode", { result <- create_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, name = "Test session vb", vb = TRUE ) skip_if_null_response(result, "create_session with vb = TRUE") - on.exit(delete_session(vol_id = 1777, session_id = result$id, vb = FALSE), add = TRUE) + on.exit(delete_session(vol_id = TEST_VOL_ID, session_id = result$id, vb = FALSE), add = TRUE) expect_type(result, "list") }) @@ -69,14 +69,14 @@ test_that("create_session works with verbose mode", { test_that("create_session works with custom request object", { custom_rq <- databraryr::make_default_request() result <- create_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, name = "Test session custom rq", rq = custom_rq, vb = FALSE ) skip_if_null_response(result, "create_session with custom_rq") - on.exit(delete_session(vol_id = 1777, session_id = result$id, vb = FALSE), add = TRUE) + on.exit(delete_session(vol_id = TEST_VOL_ID, session_id = result$id, vb = FALSE), add = TRUE) expect_type(result, "list") }) @@ -86,18 +86,18 @@ test_that("create_session returns NULL for non-existent volume", { }) test_that("create_session rejects invalid name", { - expect_error(create_session(vol_id = 1777, name = "")) - expect_error(create_session(vol_id = 1777, name = " ")) - expect_error(create_session(vol_id = 1777, name = 123)) - expect_error(create_session(vol_id = 1777, name = c("A", "B"))) - expect_error(create_session(vol_id = 1777, name = NULL)) - expect_error(create_session(vol_id = 1777, name = NA)) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "")) + expect_error(create_session(vol_id = TEST_VOL_ID, name = " ")) + expect_error(create_session(vol_id = TEST_VOL_ID, name = 123)) + expect_error(create_session(vol_id = TEST_VOL_ID, name = c("A", "B"))) + expect_error(create_session(vol_id = TEST_VOL_ID, name = NULL)) + expect_error(create_session(vol_id = TEST_VOL_ID, name = NA)) }) test_that("create_session rejects providing both source_date and date", { expect_error( create_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, name = "Test", source_date = "2024-03-15", date = list(year = 2024, month = 3, day = 15) @@ -106,12 +106,12 @@ test_that("create_session rejects providing both source_date and date", { }) test_that("create_session rejects malformed source_date", { - expect_error(create_session(vol_id = 1777, name = "Test", source_date = "not-a-date")) - expect_error(create_session(vol_id = 1777, name = "Test", source_date = "")) - expect_error(create_session(vol_id = 1777, name = "Test", source_date = 123)) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", source_date = "not-a-date")) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", source_date = "")) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", source_date = 123)) expect_error( create_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, name = "Test", source_date = as.Date(c("2024-01-01", "2024-02-01")) ) @@ -119,28 +119,28 @@ test_that("create_session rejects malformed source_date", { }) test_that("create_session rejects malformed date list", { - expect_error(create_session(vol_id = 1777, name = "Test", date = "2024-03-15")) - expect_error(create_session(vol_id = 1777, name = "Test", date = list(2024, 3, 15))) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", date = "2024-03-15")) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", date = list(2024, 3, 15))) }) test_that("create_session rejects invalid release_level", { - expect_error(create_session(vol_id = 1777, name = "Test", release_level = "")) - expect_error(create_session(vol_id = 1777, name = "Test", release_level = 1)) - expect_error(create_session(vol_id = 1777, name = "Test", release_level = c("A", "B"))) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", release_level = "")) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", release_level = 1)) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", release_level = c("A", "B"))) }) test_that("create_session rejects invalid date_precision", { - expect_error(create_session(vol_id = 1777, name = "Test", date_precision = "")) - expect_error(create_session(vol_id = 1777, name = "Test", date_precision = 1)) - expect_error(create_session(vol_id = 1777, name = "Test", date_precision = c("FULL", "YEAR"))) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", date_precision = "")) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", date_precision = 1)) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", date_precision = c("FULL", "YEAR"))) }) test_that("create_session rejects invalid default_records", { - expect_error(create_session(vol_id = 1777, name = "Test", default_records = "1")) - expect_error(create_session(vol_id = 1777, name = "Test", default_records = c(1, -2))) - expect_error(create_session(vol_id = 1777, name = "Test", default_records = c(1, 0))) - expect_error(create_session(vol_id = 1777, name = "Test", default_records = c(1.5, 2))) - expect_error(create_session(vol_id = 1777, name = "Test", default_records = integer(0))) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", default_records = "1")) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", default_records = c(1, -2))) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", default_records = c(1, 0))) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", default_records = c(1.5, 2))) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", default_records = integer(0))) }) test_that("create_session rejects invalid vol_id", { @@ -154,17 +154,17 @@ test_that("create_session rejects invalid vol_id", { }) test_that("create_session rejects invalid vb parameter", { - expect_error(create_session(vol_id = 1777, name = "Test", vb = -1)) - expect_error(create_session(vol_id = 1777, name = "Test", vb = "a")) - expect_error(create_session(vol_id = 1777, name = "Test", vb = list(a = 1))) - expect_error(create_session(vol_id = 1777, name = "Test", vb = c(TRUE, FALSE))) - expect_error(create_session(vol_id = 1777, name = "Test", vb = NULL)) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", vb = -1)) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", vb = "a")) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", vb = list(a = 1))) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", vb = c(TRUE, FALSE))) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", vb = NULL)) }) test_that("create_session rejects invalid rq parameter", { - expect_error(create_session(vol_id = 1777, name = "Test", rq = "a")) - expect_error(create_session(vol_id = 1777, name = "Test", rq = -1)) - expect_error(create_session(vol_id = 1777, name = "Test", rq = c(2, 3))) - expect_error(create_session(vol_id = 1777, name = "Test", rq = list(a = 1))) - expect_error(create_session(vol_id = 1777, name = "Test", rq = TRUE)) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", rq = "a")) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", rq = -1)) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", rq = c(2, 3))) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", rq = list(a = 1))) + expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", rq = TRUE)) }) diff --git a/tests/testthat/test-create_volume_record.R b/tests/testthat/test-create_volume_record.R index c928df6e..e04e02f6 100644 --- a/tests/testthat/test-create_volume_record.R +++ b/tests/testthat/test-create_volume_record.R @@ -4,22 +4,22 @@ login_test_account() test_that("create_volume_record creates a record with valid parameters", { # Create a record with name (resolves required name metric from volume config) result <- create_volume_record( - vol_id = 1777, - category_id = 6, + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, name = "Test condition", vb = FALSE ) - skip_if_null_response(result, "create_volume_record(vol_id = 1777, category_id = 6, name = 'Test condition')") + skip_if_null_response(result, "create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = 'Test condition')") - on.exit(delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE), add = TRUE) + on.exit(delete_volume_record(vol_id = TEST_VOL_ID, record_id = result$record_id, vb = FALSE), add = TRUE) expect_type(result, "list") expect_named(result, c( "record_id", "record_volume", "record_volume_name", "record_category_id", "measures", "birthday", "age", "default_sessions", "record_source_kind" )) - expect_equal(as.integer(result$record_volume), 1777L) - expect_equal(result$record_category_id, 6) + expect_equal(as.integer(result$record_volume), as.integer(TEST_VOL_ID)) + expect_equal(result$record_category_id, TEST_CATEGORY_ID) expect_true(is.numeric(result$record_id) || is.integer(result$record_id)) expect_true(result$record_id > 0) }) @@ -27,14 +27,14 @@ test_that("create_volume_record creates a record with valid parameters", { test_that("create_volume_record creates a record with measures", { # Create a record by name (includes required name metric) result <- create_volume_record( - vol_id = 1777, - category_id = 6, + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, name = "Test condition", vb = FALSE ) skip_if_null_response(result, "create_volume_record with name") - on.exit(delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE), add = TRUE) + on.exit(delete_volume_record(vol_id = TEST_VOL_ID, record_id = result$record_id, vb = FALSE), add = TRUE) expect_type(result, "list") expect_true(!is.null(result$measures)) @@ -44,15 +44,15 @@ test_that("create_volume_record creates a record with measures", { test_that("create_volume_record creates a record with name and additional measures", { # Task category (6) in vol 1777 has optional metric 30 result <- create_volume_record( - vol_id = 1777, - category_id = 6, + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, name = "Task with extra measures", measures = list("30" = "Extra value"), vb = FALSE ) skip_if_null_response(result, "create_volume_record with name and measures") - on.exit(delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE), add = TRUE) + on.exit(delete_volume_record(vol_id = TEST_VOL_ID, record_id = result$record_id, vb = FALSE), add = TRUE) expect_type(result, "list") expect_true(!is.null(result$measures)) @@ -60,16 +60,16 @@ test_that("create_volume_record creates a record with name and additional measur }) test_that("create_volume_record rejects invalid name", { - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "")) - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = " ")) - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = 123)) - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = c("A", "B"))) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "")) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = " ")) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = 123)) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = c("A", "B"))) }) test_that("create_volume_record returns NULL for non-existent volume", { result <- create_volume_record( vol_id = 999999, - category_id = 6, + category_id = TEST_CATEGORY_ID, name = "Test", vb = FALSE ) @@ -78,14 +78,14 @@ test_that("create_volume_record returns NULL for non-existent volume", { test_that("create_volume_record works with verbose mode", { result <- create_volume_record( - vol_id = 1777, - category_id = 6, + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, name = "Test condition vb", vb = TRUE ) skip_if_null_response(result, "create_volume_record with vb = TRUE") - on.exit(delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE), add = TRUE) + on.exit(delete_volume_record(vol_id = TEST_VOL_ID, record_id = result$record_id, vb = FALSE), add = TRUE) expect_type(result, "list") expect_true(!is.null(result$record_id)) @@ -93,82 +93,82 @@ test_that("create_volume_record works with verbose mode", { test_that("create_volume_record rejects invalid vol_id", { # Negative ID - expect_error(create_volume_record(vol_id = -1, category_id = 6, name = "Test")) + expect_error(create_volume_record(vol_id = -1, category_id = TEST_CATEGORY_ID, name = "Test")) # Zero ID - expect_error(create_volume_record(vol_id = 0, category_id = 6, name = "Test")) + expect_error(create_volume_record(vol_id = 0, category_id = TEST_CATEGORY_ID, name = "Test")) # Non-numeric ID - expect_error(create_volume_record(vol_id = "1", category_id = 6, name = "Test")) - expect_error(create_volume_record(vol_id = TRUE, category_id = 6, name = "Test")) - expect_error(create_volume_record(vol_id = list(a = 1), category_id = 6, name = "Test")) + expect_error(create_volume_record(vol_id = "1", category_id = TEST_CATEGORY_ID, name = "Test")) + expect_error(create_volume_record(vol_id = TRUE, category_id = TEST_CATEGORY_ID, name = "Test")) + expect_error(create_volume_record(vol_id = list(a = 1), category_id = TEST_CATEGORY_ID, name = "Test")) # Multiple values - expect_error(create_volume_record(vol_id = c(1, 2), category_id = 6, name = "Test")) + expect_error(create_volume_record(vol_id = c(1, 2), category_id = TEST_CATEGORY_ID, name = "Test")) # Decimal/non-integer - expect_error(create_volume_record(vol_id = 1777.5, category_id = 6, name = "Test")) + expect_error(create_volume_record(vol_id = 1777.5, category_id = TEST_CATEGORY_ID, name = "Test")) }) test_that("create_volume_record rejects invalid category_id", { # Negative ID - expect_error(create_volume_record(vol_id = 1777, category_id = -1, name = "Test")) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = -1, name = "Test")) # Zero ID - expect_error(create_volume_record(vol_id = 1777, category_id = 0, name = "Test")) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = 0, name = "Test")) # Non-numeric ID - expect_error(create_volume_record(vol_id = 1777, category_id = "1", name = "Test")) - expect_error(create_volume_record(vol_id = 1777, category_id = TRUE, name = "Test")) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = "1", name = "Test")) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TRUE, name = "Test")) # Multiple values - expect_error(create_volume_record(vol_id = 1777, category_id = c(1, 2), name = "Test")) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = c(1, 2), name = "Test")) # Decimal/non-integer - expect_error(create_volume_record(vol_id = 1777, category_id = 1.5, name = "Test")) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = 1.5, name = "Test")) }) test_that("create_volume_record rejects invalid measures", { - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", measures = "text")) - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", measures = 123)) - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", measures = TRUE)) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", measures = "text")) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", measures = 123)) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", measures = TRUE)) }) test_that("create_volume_record rejects invalid participant", { - expect_error(create_volume_record(vol_id = 1777, category_id = 1, name = "Test", participant = "text")) - expect_error(create_volume_record(vol_id = 1777, category_id = 1, name = "Test", participant = 123)) - expect_error(create_volume_record(vol_id = 1777, category_id = 1, name = "Test", participant = TRUE)) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = 1, name = "Test", participant = "text")) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = 1, name = "Test", participant = 123)) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = 1, name = "Test", participant = TRUE)) }) test_that("create_volume_record rejects invalid vb parameter", { - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", vb = -1)) - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", vb = 3)) - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", vb = "a")) - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", vb = list(a = 1))) - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", vb = c(TRUE, FALSE))) - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", vb = NULL)) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", vb = -1)) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", vb = 3)) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", vb = "a")) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", vb = list(a = 1))) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", vb = c(TRUE, FALSE))) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", vb = NULL)) }) test_that("create_volume_record rejects invalid rq parameter", { - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", rq = "a")) - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", rq = -1)) - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", rq = c(2, 3))) - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", rq = list(a = 1))) - expect_error(create_volume_record(vol_id = 1777, category_id = 6, name = "Test", rq = TRUE)) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", rq = "a")) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", rq = -1)) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", rq = c(2, 3))) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", rq = list(a = 1))) + expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", rq = TRUE)) }) test_that("create_volume_record works with custom request object", { custom_rq <- databraryr::make_default_request() result <- create_volume_record( - vol_id = 1777, - category_id = 6, + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, name = "Test condition rq", rq = custom_rq, vb = FALSE ) skip_if_null_response(result, "create_volume_record with custom_rq") - on.exit(delete_volume_record(vol_id = 1777, record_id = result$record_id, vb = FALSE), add = TRUE) + on.exit(delete_volume_record(vol_id = TEST_VOL_ID, record_id = result$record_id, vb = FALSE), add = TRUE) expect_type(result, "list") expect_true(!is.null(result$record_id)) diff --git a/tests/testthat/test-delete_folder.R b/tests/testthat/test-delete_folder.R index 5ee1d486..7a0e46ef 100644 --- a/tests/testthat/test-delete_folder.R +++ b/tests/testthat/test-delete_folder.R @@ -2,41 +2,56 @@ login_test_account() test_that("delete_folder deletes an existing folder", { - created <- create_folder(vol_id = 1777, name = "delete_folder happy path", vb = FALSE) + created <- create_folder(vol_id = TEST_VOL_ID, name = "delete_folder happy path", vb = FALSE) skip_if_null_response(created, "create_folder for delete_folder happy path") folder_id <- created$id - result <- delete_folder(vol_id = 1777, folder_id = folder_id, vb = FALSE) + on.exit( + try(delete_folder(vol_id = TEST_VOL_ID, folder_id = folder_id, vb = FALSE), silent = TRUE), + add = TRUE + ) + + result <- delete_folder(vol_id = TEST_VOL_ID, folder_id = folder_id, vb = FALSE) expect_true(result) # Verify it's gone - expect_null(get_folder_by_id(folder_id = folder_id, vol_id = 1777, vb = FALSE)) + expect_null(get_folder_by_id(folder_id = folder_id, vol_id = TEST_VOL_ID, vb = FALSE)) }) test_that("delete_folder returns FALSE for non-existent folder", { - expect_false(delete_folder(vol_id = 1777, folder_id = 999999999, vb = FALSE)) + expect_false(delete_folder(vol_id = TEST_VOL_ID, folder_id = 999999999, vb = FALSE)) }) test_that("delete_folder works with verbose mode", { - created <- create_folder(vol_id = 1777, name = "delete_folder vb", vb = FALSE) + created <- create_folder(vol_id = TEST_VOL_ID, name = "delete_folder vb", vb = FALSE) skip_if_null_response(created, "create_folder for delete_folder vb") - expect_true(delete_folder(vol_id = 1777, folder_id = created$id, vb = TRUE)) + on.exit( + try(delete_folder(vol_id = TEST_VOL_ID, folder_id = created$id, vb = FALSE), silent = TRUE), + add = TRUE + ) + + expect_true(delete_folder(vol_id = TEST_VOL_ID, folder_id = created$id, vb = TRUE)) }) test_that("delete_folder works with custom request object", { created <- create_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, name = "delete_folder custom rq", vb = FALSE ) skip_if_null_response(created, "create_folder for delete_folder custom rq") + on.exit( + try(delete_folder(vol_id = TEST_VOL_ID, folder_id = created$id, vb = FALSE), silent = TRUE), + add = TRUE + ) + custom_rq <- databraryr::make_default_request() expect_true( delete_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, folder_id = created$id, rq = custom_rq, vb = FALSE @@ -57,30 +72,30 @@ test_that("delete_folder rejects invalid vol_id", { }) test_that("delete_folder rejects invalid folder_id", { - expect_error(delete_folder(vol_id = 1777, folder_id = -1)) - expect_error(delete_folder(vol_id = 1777, folder_id = 0)) - expect_error(delete_folder(vol_id = 1777, folder_id = "1")) - expect_error(delete_folder(vol_id = 1777, folder_id = TRUE)) - expect_error(delete_folder(vol_id = 1777, folder_id = list(a = 1))) - expect_error(delete_folder(vol_id = 1777, folder_id = c(1, 2))) - expect_error(delete_folder(vol_id = 1777, folder_id = 1.5)) - expect_error(delete_folder(vol_id = 1777, folder_id = NULL)) - expect_error(delete_folder(vol_id = 1777, folder_id = NA)) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = -1)) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 0)) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = "1")) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = TRUE)) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = list(a = 1))) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = c(1, 2))) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1.5)) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = NULL)) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = NA)) }) test_that("delete_folder rejects invalid vb parameter", { - expect_error(delete_folder(vol_id = 1777, folder_id = 1, vb = -1)) - expect_error(delete_folder(vol_id = 1777, folder_id = 1, vb = 3)) - expect_error(delete_folder(vol_id = 1777, folder_id = 1, vb = "a")) - expect_error(delete_folder(vol_id = 1777, folder_id = 1, vb = list(a = 1))) - expect_error(delete_folder(vol_id = 1777, folder_id = 1, vb = c(TRUE, FALSE))) - expect_error(delete_folder(vol_id = 1777, folder_id = 1, vb = NULL)) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, vb = -1)) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, vb = 3)) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, vb = "a")) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, vb = list(a = 1))) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, vb = NULL)) }) test_that("delete_folder rejects invalid rq parameter", { - expect_error(delete_folder(vol_id = 1777, folder_id = 1, rq = "a")) - expect_error(delete_folder(vol_id = 1777, folder_id = 1, rq = -1)) - expect_error(delete_folder(vol_id = 1777, folder_id = 1, rq = c(2, 3))) - expect_error(delete_folder(vol_id = 1777, folder_id = 1, rq = list(a = 1))) - expect_error(delete_folder(vol_id = 1777, folder_id = 1, rq = TRUE)) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, rq = "a")) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, rq = -1)) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, rq = c(2, 3))) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, rq = list(a = 1))) + expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, rq = TRUE)) }) diff --git a/tests/testthat/test-delete_record_measure.R b/tests/testthat/test-delete_record_measure.R index 6e26d4db..1de75118 100644 --- a/tests/testthat/test-delete_record_measure.R +++ b/tests/testthat/test-delete_record_measure.R @@ -2,84 +2,47 @@ login_test_account() test_that("delete_record_measure deletes a measure", { - # Create a record and add an optional measure (metric 29 is name/required) - create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, - name = "Delete measure test", - vb = FALSE - ) - skip_if_null_response(create_result, "create_volume_record for delete_measure test") + record_id <- make_test_record("Delete measure test") + skip_if_null_response(record_id, "create_volume_record for delete_measure test") - record_id <- create_result$record_id + set_record_measure(vol_id = TEST_VOL_ID, record_id = record_id, metric_id = 30, value = "temp", vb = FALSE) - # First set an optional measure (30), then delete it - set_record_measure(vol_id = 1777, record_id = record_id, metric_id = 30, value = "temp", vb = FALSE) - - # Delete the non-required measure delete_result <- delete_record_measure( - vol_id = 1777, + vol_id = TEST_VOL_ID, record_id = record_id, metric_id = 30, vb = FALSE ) - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) - expect_true(delete_result) }) test_that("delete_record_measure returns FALSE for non-existent measure", { - # Create a record (name is the required measure) - create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, - name = "Delete measure fail test", - vb = FALSE - ) - skip_if_null_response(create_result, "create_volume_record for delete_measure fail test") + record_id <- make_test_record("Delete measure fail test") + skip_if_null_response(record_id, "create_volume_record for delete_measure fail test") - record_id <- create_result$record_id - - # Try to delete a non-existent measure delete_result <- delete_record_measure( - vol_id = 1777, + vol_id = TEST_VOL_ID, record_id = record_id, metric_id = 29, vb = FALSE ) - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) - expect_false(delete_result) }) test_that("delete_record_measure works with verbose mode", { - # Create a record and add optional measure - create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, - name = "Delete verbose test", - vb = FALSE - ) - skip_if_null_response(create_result, "create_volume_record for delete_measure verbose test") + record_id <- make_test_record("Delete verbose test") + skip_if_null_response(record_id, "create_volume_record for delete_measure verbose test") + set_record_measure(vol_id = TEST_VOL_ID, record_id = record_id, metric_id = 30, value = "temp", vb = FALSE) - record_id <- create_result$record_id - set_record_measure(vol_id = 1777, record_id = record_id, metric_id = 30, value = "temp", vb = FALSE) - - # Delete with verbose delete_result <- delete_record_measure( - vol_id = 1777, + vol_id = TEST_VOL_ID, record_id = record_id, metric_id = 30, vb = TRUE ) - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) - expect_true(delete_result) }) @@ -93,62 +56,50 @@ test_that("delete_record_measure rejects invalid vol_id", { }) test_that("delete_record_measure rejects invalid record_id", { - expect_error(delete_record_measure(vol_id = 1777, record_id = -1, metric_id = 29)) - expect_error(delete_record_measure(vol_id = 1777, record_id = 0, metric_id = 29)) - expect_error(delete_record_measure(vol_id = 1777, record_id = "1", metric_id = 29)) - expect_error(delete_record_measure(vol_id = 1777, record_id = TRUE, metric_id = 29)) - expect_error(delete_record_measure(vol_id = 1777, record_id = c(1, 2), metric_id = 29)) - expect_error(delete_record_measure(vol_id = 1777, record_id = 1.5, metric_id = 29)) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = -1, metric_id = 29)) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 0, metric_id = 29)) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = "1", metric_id = 29)) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = TRUE, metric_id = 29)) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = c(1, 2), metric_id = 29)) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1.5, metric_id = 29)) }) test_that("delete_record_measure rejects invalid metric_id", { - expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = -1)) - expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 0)) - expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = "1")) - expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = TRUE)) - expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = c(1, 2))) - expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 1.5)) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = -1)) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 0)) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = "1")) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = TRUE)) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = c(1, 2))) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 1.5)) }) test_that("delete_record_measure rejects invalid vb parameter", { - expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, vb = -1)) - expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, vb = 3)) - expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, vb = "a")) - expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, vb = c(TRUE, FALSE))) - expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, vb = NULL)) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, vb = -1)) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, vb = 3)) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, vb = "a")) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, vb = c(TRUE, FALSE))) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, vb = NULL)) }) test_that("delete_record_measure rejects invalid rq parameter", { - expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, rq = "a")) - expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, rq = -1)) - expect_error(delete_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, rq = TRUE)) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, rq = "a")) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, rq = -1)) + expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, rq = TRUE)) }) test_that("delete_record_measure works with custom request object", { - # Create a record and add optional measure - create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, - name = "Delete custom rq test", - vb = FALSE - ) - skip_if_null_response(create_result, "create_volume_record for delete_measure custom rq test") + record_id <- make_test_record("Delete custom rq test") + skip_if_null_response(record_id, "create_volume_record for delete_measure custom rq test") + set_record_measure(vol_id = TEST_VOL_ID, record_id = record_id, metric_id = 30, value = "temp", vb = FALSE) - record_id <- create_result$record_id - set_record_measure(vol_id = 1777, record_id = record_id, metric_id = 30, value = "temp", vb = FALSE) - - # Delete with custom request custom_rq <- databraryr::make_default_request() delete_result <- delete_record_measure( - vol_id = 1777, + vol_id = TEST_VOL_ID, record_id = record_id, metric_id = 30, rq = custom_rq, vb = FALSE ) - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) - expect_true(delete_result) }) diff --git a/tests/testthat/test-delete_session.R b/tests/testthat/test-delete_session.R index ab53d058..8dbb19ca 100644 --- a/tests/testthat/test-delete_session.R +++ b/tests/testthat/test-delete_session.R @@ -2,41 +2,55 @@ login_test_account() test_that("delete_session deletes an existing session", { - created <- create_session(vol_id = 1777, name = "delete_session happy path", vb = FALSE) + created <- create_session(vol_id = TEST_VOL_ID, name = "delete_session happy path", vb = FALSE) skip_if_null_response(created, "create_session for delete_session happy path") session_id <- created$id - result <- delete_session(vol_id = 1777, session_id = session_id, vb = FALSE) + on.exit( + try(delete_session(vol_id = TEST_VOL_ID, session_id = session_id, vb = FALSE), silent = TRUE), + add = TRUE + ) + + result <- delete_session(vol_id = TEST_VOL_ID, session_id = session_id, vb = FALSE) expect_true(result) - # Verify it's gone - expect_null(get_session_by_id(vol_id = 1777, session_id = session_id, vb = FALSE)) + expect_null(get_session_by_id(vol_id = TEST_VOL_ID, session_id = session_id, vb = FALSE)) }) test_that("delete_session returns FALSE for non-existent session", { - expect_false(delete_session(vol_id = 1777, session_id = 999999999, vb = FALSE)) + expect_false(delete_session(vol_id = TEST_VOL_ID, session_id = 999999999, vb = FALSE)) }) test_that("delete_session works with verbose mode", { - created <- create_session(vol_id = 1777, name = "delete_session vb", vb = FALSE) + created <- create_session(vol_id = TEST_VOL_ID, name = "delete_session vb", vb = FALSE) skip_if_null_response(created, "create_session for delete_session vb") - expect_true(delete_session(vol_id = 1777, session_id = created$id, vb = TRUE)) + on.exit( + try(delete_session(vol_id = TEST_VOL_ID, session_id = created$id, vb = FALSE), silent = TRUE), + add = TRUE + ) + + expect_true(delete_session(vol_id = TEST_VOL_ID, session_id = created$id, vb = TRUE)) }) test_that("delete_session works with custom request object", { created <- create_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, name = "delete_session custom rq", vb = FALSE ) skip_if_null_response(created, "create_session for delete_session custom rq") + on.exit( + try(delete_session(vol_id = TEST_VOL_ID, session_id = created$id, vb = FALSE), silent = TRUE), + add = TRUE + ) + custom_rq <- databraryr::make_default_request() expect_true( delete_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = created$id, rq = custom_rq, vb = FALSE @@ -57,30 +71,30 @@ test_that("delete_session rejects invalid vol_id", { }) test_that("delete_session rejects invalid session_id", { - expect_error(delete_session(vol_id = 1777, session_id = -1)) - expect_error(delete_session(vol_id = 1777, session_id = 0)) - expect_error(delete_session(vol_id = 1777, session_id = "1")) - expect_error(delete_session(vol_id = 1777, session_id = TRUE)) - expect_error(delete_session(vol_id = 1777, session_id = list(a = 1))) - expect_error(delete_session(vol_id = 1777, session_id = c(1, 2))) - expect_error(delete_session(vol_id = 1777, session_id = 1.5)) - expect_error(delete_session(vol_id = 1777, session_id = NULL)) - expect_error(delete_session(vol_id = 1777, session_id = NA)) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = -1)) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 0)) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = "1")) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = TRUE)) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = list(a = 1))) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = c(1, 2))) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1.5)) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = NULL)) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = NA)) }) test_that("delete_session rejects invalid vb parameter", { - expect_error(delete_session(vol_id = 1777, session_id = 1, vb = -1)) - expect_error(delete_session(vol_id = 1777, session_id = 1, vb = 3)) - expect_error(delete_session(vol_id = 1777, session_id = 1, vb = "a")) - expect_error(delete_session(vol_id = 1777, session_id = 1, vb = list(a = 1))) - expect_error(delete_session(vol_id = 1777, session_id = 1, vb = c(TRUE, FALSE))) - expect_error(delete_session(vol_id = 1777, session_id = 1, vb = NULL)) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, vb = -1)) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, vb = 3)) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, vb = "a")) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, vb = list(a = 1))) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, vb = NULL)) }) test_that("delete_session rejects invalid rq parameter", { - expect_error(delete_session(vol_id = 1777, session_id = 1, rq = "a")) - expect_error(delete_session(vol_id = 1777, session_id = 1, rq = -1)) - expect_error(delete_session(vol_id = 1777, session_id = 1, rq = c(2, 3))) - expect_error(delete_session(vol_id = 1777, session_id = 1, rq = list(a = 1))) - expect_error(delete_session(vol_id = 1777, session_id = 1, rq = TRUE)) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, rq = "a")) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, rq = -1)) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, rq = c(2, 3))) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, rq = list(a = 1))) + expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, rq = TRUE)) }) diff --git a/tests/testthat/test-delete_session_file.R b/tests/testthat/test-delete_session_file.R index 06ace953..add6e514 100644 --- a/tests/testthat/test-delete_session_file.R +++ b/tests/testthat/test-delete_session_file.R @@ -4,7 +4,7 @@ login_test_account() test_that("delete_session_file returns FALSE for non-existent file", { expect_false( delete_session_file( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = 999999999, file_id = 999999999, vb = FALSE @@ -25,42 +25,42 @@ test_that("delete_session_file rejects invalid vol_id", { }) test_that("delete_session_file rejects invalid session_id", { - expect_error(delete_session_file(vol_id = 1777, session_id = -1, file_id = 1)) - expect_error(delete_session_file(vol_id = 1777, session_id = 0, file_id = 1)) - expect_error(delete_session_file(vol_id = 1777, session_id = "1", file_id = 1)) - expect_error(delete_session_file(vol_id = 1777, session_id = TRUE, file_id = 1)) - expect_error(delete_session_file(vol_id = 1777, session_id = list(a = 1), file_id = 1)) - expect_error(delete_session_file(vol_id = 1777, session_id = c(1, 2), file_id = 1)) - expect_error(delete_session_file(vol_id = 1777, session_id = 1.5, file_id = 1)) - expect_error(delete_session_file(vol_id = 1777, session_id = NULL, file_id = 1)) - expect_error(delete_session_file(vol_id = 1777, session_id = NA, file_id = 1)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = -1, file_id = 1)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 0, file_id = 1)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = "1", file_id = 1)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = TRUE, file_id = 1)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = list(a = 1), file_id = 1)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = c(1, 2), file_id = 1)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1.5, file_id = 1)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = NULL, file_id = 1)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = NA, file_id = 1)) }) test_that("delete_session_file rejects invalid file_id", { - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = -1)) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 0)) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = "1")) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = TRUE)) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = list(a = 1))) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = c(1, 2))) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1.5)) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = NULL)) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = NA)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = -1)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 0)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = "1")) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = TRUE)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = list(a = 1))) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = c(1, 2))) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1.5)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = NULL)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = NA)) }) test_that("delete_session_file rejects invalid vb parameter", { - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, vb = -1)) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, vb = 3)) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, vb = "a")) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, vb = list(a = 1))) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, vb = c(TRUE, FALSE))) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, vb = NULL)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, vb = -1)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, vb = 3)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, vb = "a")) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, vb = list(a = 1))) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, vb = NULL)) }) test_that("delete_session_file rejects invalid rq parameter", { - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, rq = "a")) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, rq = -1)) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, rq = c(2, 3))) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, rq = list(a = 1))) - expect_error(delete_session_file(vol_id = 1777, session_id = 1, file_id = 1, rq = TRUE)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, rq = "a")) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, rq = -1)) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, rq = c(2, 3))) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, rq = list(a = 1))) + expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, rq = TRUE)) }) diff --git a/tests/testthat/test-delete_volume_record.R b/tests/testthat/test-delete_volume_record.R index 1539a9a5..e83590d2 100644 --- a/tests/testthat/test-delete_volume_record.R +++ b/tests/testthat/test-delete_volume_record.R @@ -2,29 +2,19 @@ login_test_account() test_that("delete_volume_record deletes an existing record", { - # First create a record - create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, - name = "Delete test", - vb = FALSE - ) - skip_if_null_response(create_result, "create_volume_record for delete test") + record_id <- make_test_record("Delete test") + skip_if_null_response(record_id, "create_volume_record for delete test") - record_id <- create_result$record_id - - # Delete the record delete_result <- delete_volume_record( - vol_id = 1777, + vol_id = TEST_VOL_ID, record_id = record_id, vb = FALSE ) expect_true(delete_result) - # Verify it's gone get_result <- get_volume_record_by_id( - vol_id = 1777, + vol_id = TEST_VOL_ID, record_id = record_id, vb = FALSE ) @@ -33,7 +23,7 @@ test_that("delete_volume_record deletes an existing record", { test_that("delete_volume_record returns FALSE for non-existent record", { result <- delete_volume_record( - vol_id = 1777, + vol_id = TEST_VOL_ID, record_id = 999999, vb = FALSE ) @@ -41,25 +31,16 @@ test_that("delete_volume_record returns FALSE for non-existent record", { }) test_that("delete_volume_record works with verbose mode", { - # First create a record - create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, - name = "Delete test", - vb = FALSE - ) - skip_if_null_response(create_result, "create_volume_record for delete verbose test") - - record_id <- create_result$record_id - - # Delete with verbose - delete_result <- delete_volume_record( - vol_id = 1777, - record_id = record_id, - vb = TRUE + record_id <- make_test_record("Delete vb test") + skip_if_null_response(record_id, "create_volume_record for delete verbose test") + + expect_true( + delete_volume_record( + vol_id = TEST_VOL_ID, + record_id = record_id, + vb = TRUE + ) ) - - expect_true(delete_result) }) test_that("delete_volume_record rejects invalid vol_id", { @@ -75,50 +56,41 @@ test_that("delete_volume_record rejects invalid vol_id", { }) test_that("delete_volume_record rejects invalid record_id", { - expect_error(delete_volume_record(vol_id = 1777, record_id = -1)) - expect_error(delete_volume_record(vol_id = 1777, record_id = 0)) - expect_error(delete_volume_record(vol_id = 1777, record_id = "1")) - expect_error(delete_volume_record(vol_id = 1777, record_id = TRUE)) - expect_error(delete_volume_record(vol_id = 1777, record_id = list(a = 1))) - expect_error(delete_volume_record(vol_id = 1777, record_id = c(1, 2))) - expect_error(delete_volume_record(vol_id = 1777, record_id = 1.5)) - expect_error(delete_volume_record(vol_id = 1777, record_id = NULL)) - expect_error(delete_volume_record(vol_id = 1777, record_id = NA)) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = -1)) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 0)) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = "1")) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = TRUE)) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = list(a = 1))) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = c(1, 2))) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1.5)) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = NULL)) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = NA)) }) test_that("delete_volume_record rejects invalid vb parameter", { - expect_error(delete_volume_record(vol_id = 1777, record_id = 1, vb = -1)) - expect_error(delete_volume_record(vol_id = 1777, record_id = 1, vb = 3)) - expect_error(delete_volume_record(vol_id = 1777, record_id = 1, vb = "a")) - expect_error(delete_volume_record(vol_id = 1777, record_id = 1, vb = list(a = 1, b = 2))) - expect_error(delete_volume_record(vol_id = 1777, record_id = 1, vb = c(TRUE, FALSE))) - expect_error(delete_volume_record(vol_id = 1777, record_id = 1, vb = NULL)) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = -1)) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = 3)) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = "a")) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = list(a = 1, b = 2))) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = NULL)) }) test_that("delete_volume_record rejects invalid rq parameter", { - expect_error(delete_volume_record(vol_id = 1777, record_id = 1, rq = "a")) - expect_error(delete_volume_record(vol_id = 1777, record_id = 1, rq = -1)) - expect_error(delete_volume_record(vol_id = 1777, record_id = 1, rq = c(2, 3))) - expect_error(delete_volume_record(vol_id = 1777, record_id = 1, rq = list(a = 1, b = 2))) - expect_error(delete_volume_record(vol_id = 1777, record_id = 1, rq = TRUE)) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, rq = "a")) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, rq = -1)) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, rq = c(2, 3))) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, rq = list(a = 1, b = 2))) + expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, rq = TRUE)) }) test_that("delete_volume_record works with custom request object", { - # First create a record - create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, - name = "Delete custom rq test", - vb = FALSE - ) - skip_if_null_response(create_result, "create_volume_record for delete custom rq test") - - record_id <- create_result$record_id + record_id <- make_test_record("Delete custom rq test") + skip_if_null_response(record_id, "create_volume_record for delete custom rq test") - # Delete with custom request custom_rq <- databraryr::make_default_request() delete_result <- delete_volume_record( - vol_id = 1777, + vol_id = TEST_VOL_ID, record_id = record_id, rq = custom_rq, vb = FALSE diff --git a/tests/testthat/test-get_db_stats.R b/tests/testthat/test-get_db_stats.R index 0f8f173f..02c34721 100644 --- a/tests/testthat/test-get_db_stats.R +++ b/tests/testthat/test-get_db_stats.R @@ -1,6 +1,7 @@ # get_db_stats --------------------------------------------------------- +login_test_account() + test_that("get_db_stats returns statistics snapshot", { - login_test_account() stats <- get_db_stats() skip_if_null_response(stats, "get_db_stats()") expect_s3_class(stats, "tbl_df") @@ -8,7 +9,6 @@ test_that("get_db_stats returns statistics snapshot", { }) test_that("get_db_stats returns data.frames for supported types", { - login_test_account() types <- c("people", "institutions", "places", "datasets", "data", "volumes", "numbers") for (type in types) { result <- get_db_stats(type) diff --git a/tests/testthat/test-get_folder_file.R b/tests/testthat/test-get_folder_file.R index 21e88c0d..a16cee3d 100644 --- a/tests/testthat/test-get_folder_file.R +++ b/tests/testthat/test-get_folder_file.R @@ -1,12 +1,30 @@ # get_folder_file ------------------------------------------------------- test_that("get_folder_file returns file metadata", { login_test_account() - files <- list_folder_assets(vol_id = 1, folder_id = 1) - skip_if_null_response(files, "list_folder_assets(vol_id = 1, folder_id = 1)") - target_file <- files$asset_id[1] - result <- get_folder_file(vol_id = 1, folder_id = 1, file_id = target_file) - skip_if_null_response(result, sprintf("get_folder_file(vol_id = 1, folder_id = 1, file_id = %s)", target_file)) + fid <- make_test_folder(sprintf("get_folder_file probe %d", sample(100000L:999999L, 1L))) + skip_if_null_response(fid, "create_folder for get_folder_file") + + asset_name <- sprintf("get_folder_file_%d.txt", sample(100000L:999999L, 1L)) + target_file <- upload_test_folder_asset( + folder_id = fid, + file_basename = asset_name + ) + skip_if_null_response(target_file, "upload folder asset for get_folder_file") + + result <- get_folder_file( + vol_id = TEST_VOL_ID, + folder_id = fid, + file_id = target_file, + vb = FALSE + ) + skip_if_null_response( + result, + sprintf( + "get_folder_file(vol_id = TEST_VOL_ID, folder_id = %s, file_id = %s)", + fid, target_file + ) + ) expect_type(result, "list") expect_equal(result$id, target_file) diff --git a/tests/testthat/test-get_institution_statistics.R b/tests/testthat/test-get_institution_statistics.R index 511f3cff..b29821dd 100644 --- a/tests/testthat/test-get_institution_statistics.R +++ b/tests/testthat/test-get_institution_statistics.R @@ -1,9 +1,10 @@ +login_test_account() + test_that("get_institution_statistics returns statistics for institution with data", { - login_test_account() - result <- get_institution_statistics(1) - skip_if_null_response(result, "get_institution_statistics(1)") + result <- get_institution_statistics(178) + skip_if_null_response(result, "get_institution_statistics(178)") expect_true(is.list(result)) - expect_equal(result$institution_id, 1) + expect_equal(result$institution_id, 178) expect_true(is.numeric(result$volumes_number)) expect_true(is.numeric(result$files_number)) expect_true(is.numeric(result$uploaded_data_footprint)) @@ -11,16 +12,14 @@ test_that("get_institution_statistics returns statistics for institution with da }) test_that("get_institution_statistics returns NULL for institution without statistics", { - login_test_account() result <- get_institution_statistics(999) # Institution 999 may not exist or may have no statistics expect_true(is.null(result) || is.list(result)) }) test_that("get_institution_statistics with vb = TRUE", { - login_test_account() - result <- get_institution_statistics(1, vb = TRUE) - skip_if_null_response(result, "get_institution_statistics(1, vb = TRUE)") + result <- get_institution_statistics(178, vb = TRUE) + skip_if_null_response(result, "get_institution_statistics(178, vb = TRUE)") expect_true(is.list(result)) - expect_equal(result$institution_id, 1) + expect_equal(result$institution_id, 178) }) diff --git a/tests/testthat/test-get_user_statistics.R b/tests/testthat/test-get_user_statistics.R index acb22758..7b36f554 100644 --- a/tests/testthat/test-get_user_statistics.R +++ b/tests/testthat/test-get_user_statistics.R @@ -1,5 +1,6 @@ +login_test_account() + test_that("get_user_statistics returns statistics for user with data", { - login_test_account() result <- get_user_statistics(6) skip_if_null_response(result, "get_user_statistics(6)") expect_true(is.list(result)) @@ -11,14 +12,12 @@ test_that("get_user_statistics returns statistics for user with data", { }) test_that("get_user_statistics returns NULL for user without statistics", { - login_test_account() result <- get_user_statistics(999) # User 999 may not exist or may have no statistics expect_true(is.null(result) || is.list(result)) }) test_that("get_user_statistics with vb = TRUE", { - login_test_account() result <- get_user_statistics(6, vb = TRUE) skip_if_null_response(result, "get_user_statistics(6, vb = TRUE)") expect_true(is.list(result)) diff --git a/tests/testthat/test-get_volume_collaborator_by_id.R b/tests/testthat/test-get_volume_collaborator_by_id.R index 5c86bde6..48f14c3d 100644 --- a/tests/testthat/test-get_volume_collaborator_by_id.R +++ b/tests/testthat/test-get_volume_collaborator_by_id.R @@ -220,26 +220,25 @@ test_that("get_volume_collaborator_by_id can retrieve multiple different collabo collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") - if (nrow(collaborators) >= 2) { - # Filter out NA values and ensure we have valid IDs - valid_ids <- collaborators$collaborator_id[!is.na(collaborators$collaborator_id) & collaborators$collaborator_id > 0] + valid_ids <- collaborators$collaborator_id[ + !is.na(collaborators$collaborator_id) & collaborators$collaborator_id > 0 + ] + if (length(valid_ids) < 2) { + testthat::skip("Need at least 2 collaborators with collaborator_id > 0") + } - if (length(valid_ids) >= 2) { - collaborator_id_1 <- valid_ids[1] - collaborator_id_2 <- valid_ids[2] + collaborator_id_1 <- valid_ids[1] + collaborator_id_2 <- valid_ids[2] - result1 <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = collaborator_id_1, vb = FALSE) - result2 <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = collaborator_id_2, vb = FALSE) + result1 <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = collaborator_id_1, vb = FALSE) + result2 <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = collaborator_id_2, vb = FALSE) - skip_if_null_response(result1, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", collaborator_id_1)) - skip_if_null_response(result2, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", collaborator_id_2)) + skip_if_null_response(result1, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", collaborator_id_1)) + skip_if_null_response(result2, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", collaborator_id_2)) - # If both exist, they should be different - expect_false(identical(result1$collaborator_id, result2$collaborator_id)) - expect_equal(result1$collaborator_id, collaborator_id_1) - expect_equal(result2$collaborator_id, collaborator_id_2) - } - } + expect_false(identical(result1$collaborator_id, result2$collaborator_id)) + expect_equal(result1$collaborator_id, collaborator_id_1) + expect_equal(result2$collaborator_id, collaborator_id_2) }) test_that("get_volume_collaborator_by_id returns complete structure with all fields", { diff --git a/tests/testthat/test-get_volume_record_by_id.R b/tests/testthat/test-get_volume_record_by_id.R index 4fcac500..648f2e76 100644 --- a/tests/testthat/test-get_volume_record_by_id.R +++ b/tests/testthat/test-get_volume_record_by_id.R @@ -1,9 +1,10 @@ # get_volume_record_by_id() -------------------------------------------------- login_test_account() +records_vol_1777 <- list_volume_records(vol_id = 1777, vb = FALSE) + test_that("get_volume_record_by_id retrieves valid record", { - # First get a list of records to find a valid record_id - records <- list_volume_records(vol_id = 1777, vb = FALSE) + records <- records_vol_1777 skip_if_null_response(records, "list_volume_records(vol_id = 1777)") if (nrow(records) > 0) { @@ -37,7 +38,7 @@ test_that("get_volume_record_by_id returns NULL for non-existent volume", { }) test_that("get_volume_record_by_id works with verbose mode", { - records <- list_volume_records(vol_id = 1777, vb = FALSE) + records <- records_vol_1777 skip_if_null_response(records, "list_volume_records(vol_id = 1777)") if (nrow(records) > 0) { @@ -120,7 +121,7 @@ test_that("get_volume_record_by_id rejects invalid rq parameter", { }) test_that("get_volume_record_by_id result structure is consistent", { - records <- list_volume_records(vol_id = 1777, vb = FALSE) + records <- records_vol_1777 skip_if_null_response(records, "list_volume_records(vol_id = 1777)") if (nrow(records) > 0) { @@ -152,25 +153,28 @@ test_that("get_volume_record_by_id result structure is consistent", { }) test_that("get_volume_record_by_id handles age structure correctly", { - records <- list_volume_records(vol_id = 1777, vb = FALSE) + records <- records_vol_1777 skip_if_null_response(records, "list_volume_records(vol_id = 1777)") - if (nrow(records) > 0) { - test_record_id <- records$record_id[1] - result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id) - skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", test_record_id)) + if (nrow(records) == 0) { + testthat::skip("No records on volume; cannot validate age structure") + } + + test_record_id <- records$record_id[1] + result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id) + skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", test_record_id)) - # If age exists, check its structure - if (!is.null(result$age)) { - expect_type(result$age, "list") - expected_fields <- c("years", "months", "days", "total_days", "formatted_value", "is_estimated", "is_blurred") - expect_true(all(expected_fields %in% names(result$age))) - } + if (is.null(result$age)) { + expect_null(result$age) + } else { + expect_type(result$age, "list") + expected_fields <- c("years", "months", "days", "total_days", "formatted_value", "is_estimated", "is_blurred") + expect_true(all(expected_fields %in% names(result$age))) } }) test_that("get_volume_record_by_id handles measures correctly", { - records <- list_volume_records(vol_id = 1777, vb = FALSE) + records <- records_vol_1777 skip_if_null_response(records, "list_volume_records(vol_id = 1777)") if (nrow(records) > 0) { @@ -184,7 +188,7 @@ test_that("get_volume_record_by_id handles measures correctly", { }) test_that("get_volume_record_by_id works with custom request object", { - records <- list_volume_records(vol_id = 1777, vb = FALSE) + records <- records_vol_1777 skip_if_null_response(records, "list_volume_records(vol_id = 1777)") if (nrow(records) > 0) { @@ -199,7 +203,7 @@ test_that("get_volume_record_by_id works with custom request object", { }) test_that("get_volume_record_by_id can retrieve multiple different records", { - records <- list_volume_records(vol_id = 1777, vb = FALSE) + records <- records_vol_1777 skip_if_null_response(records, "list_volume_records(vol_id = 1777)") unique_ids <- unique(records$record_id) @@ -222,7 +226,7 @@ test_that("get_volume_record_by_id can retrieve multiple different records", { }) test_that("get_volume_record_by_id returns complete structure with all fields", { - records <- list_volume_records(vol_id = 1777, vb = FALSE) + records <- records_vol_1777 skip_if_null_response(records, "list_volume_records(vol_id = 1777)") if (nrow(records) > 0) { diff --git a/tests/testthat/test-list_institutions.R b/tests/testthat/test-list_institutions.R index e0c14a64..7c348d03 100644 --- a/tests/testthat/test-list_institutions.R +++ b/tests/testthat/test-list_institutions.R @@ -1,8 +1,10 @@ # list_institutions() --------------------------------------------------------- login_test_account() +institutions_all <- list_institutions(vb = FALSE) + test_that("list_institutions returns all institutions without search filter", { - result <- list_institutions(vb = FALSE) + result <- institutions_all skip_if_null_response(result, "list_institutions()") expect_s3_class(result, "tbl_df") @@ -88,7 +90,7 @@ test_that("list_institutions rejects invalid rq parameter", { }) test_that("list_institutions result structure is consistent", { - result <- list_institutions(vb = FALSE) + result <- institutions_all skip_if_null_response(result, "list_institutions()") # Check that all expected fields exist @@ -102,7 +104,7 @@ test_that("list_institutions result structure is consistent", { }) test_that("list_institutions handles NA values correctly", { - result <- list_institutions(vb = FALSE) + result <- institutions_all skip_if_null_response(result, "list_institutions()") # institution_url can be NA for institutions without a URL @@ -122,8 +124,7 @@ test_that("list_institutions works with custom request object", { }) test_that("list_institutions returns different results with and without search", { - # Get all institutions - all_institutions <- list_institutions(vb = FALSE) + all_institutions <- institutions_all skip_if_null_response(all_institutions, "list_institutions()") # Get filtered institutions @@ -136,7 +137,7 @@ test_that("list_institutions returns different results with and without search", }) test_that("list_institutions returns unique institution IDs", { - result <- list_institutions(vb = FALSE) + result <- institutions_all skip_if_null_response(result, "list_institutions()") # Check that all institution IDs are unique @@ -156,7 +157,7 @@ test_that("list_institutions search is case insensitive", { }) test_that("list_institutions can retrieve institutions with avatars", { - result <- list_institutions(vb = FALSE) + result <- institutions_all skip_if_null_response(result, "list_institutions()") # Filter institutions that have avatars diff --git a/tests/testthat/test-list_session_activity.R b/tests/testthat/test-list_session_activity.R deleted file mode 100644 index f7f75444..00000000 --- a/tests/testthat/test-list_session_activity.R +++ /dev/null @@ -1,25 +0,0 @@ -# list_session_activity --------------------------------------------------------- -test_that("list_session_activity returns tibble or is NULL", { - login_test_account() - result <- list_session_activity(vol_id = 1892, session_id = 76113) - skip_if_null_response(result, "list_session_activity(vol_id = 1892, session_id = 76113)") - expect_s3_class(result, "tbl_df") -}) - -test_that("list_session_activity rejects bad input parameters", { - expect_error(list_session_activity(session_id = "a")) - expect_error(list_session_activity(session_id = c(1, 2))) - expect_error(list_session_activity(session_id = TRUE)) - expect_error(list_session_activity(session_id = list(a = 1, b = 2))) - expect_error(list_session_activity(session_id = -1)) - - expect_error(list_session_activity(vb = -1)) - expect_error(list_session_activity(vb = 3)) - expect_error(list_session_activity(vb = "a")) - expect_error(list_session_activity(vb = list(a = 1, b = 2))) - - expect_error(list_session_activity(rq = "a")) - expect_error(list_session_activity(rq = -1)) - expect_error(list_session_activity(rq = c(2, 3))) - expect_error(list_session_activity(rq = list(a = 1, b = 2))) -}) diff --git a/tests/testthat/test-list_volume_activity.R b/tests/testthat/test-list_volume_activity.R index 78bb78b7..63aa8d5d 100644 --- a/tests/testthat/test-list_volume_activity.R +++ b/tests/testthat/test-list_volume_activity.R @@ -17,9 +17,4 @@ test_that("list_volume_activity rejects bad input parameters", { expect_error(list_volume_activity(vb = 3)) expect_error(list_volume_activity(vb = "a")) expect_error(list_volume_activity(vb = list(a=1, b=2))) - - expect_error(list_session_activity(rq = "a")) - expect_error(list_session_activity(rq = -1)) - expect_error(list_session_activity(rq = c(2,3))) - expect_error(list_session_activity(rq = list(a=1, b=2))) }) \ No newline at end of file diff --git a/tests/testthat/test-list_volume_assets.R b/tests/testthat/test-list_volume_assets.R index 11b9f055..47b44be8 100644 --- a/tests/testthat/test-list_volume_assets.R +++ b/tests/testthat/test-list_volume_assets.R @@ -1,13 +1,13 @@ # list_volume_assets ----------------------------------------------- +login_test_account() + test_that("list_volume_assets returns tibble or is NULL", { - login_test_account() result <- list_volume_assets() skip_if_null_response(result, "list_volume_assets()") expect_s3_class(result, "tbl_df") }) test_that("list_volume_assets returns tibble for accessible volume", { - login_test_account() result <- list_volume_assets(vol_id = 2) skip_if_null_response(result, "list_volume_assets(vol_id = 2)") expect_s3_class(result, "tbl_df") @@ -25,16 +25,10 @@ test_that("list_volume_assets rejects bad input parameters", { expect_error(list_volume_assets(vb = 3)) expect_error(list_volume_assets(vb = "a")) expect_error(list_volume_assets(vb = list(a = 1, b = 2))) - - expect_error(list_session_activity(rq = "a")) - expect_error(list_session_activity(rq = -1)) - expect_error(list_session_activity(rq = c(2, 3))) - expect_error(list_session_activity(rq = list(a = 1, b = 2))) }) test_that("list_volume_assets returns NULL for invalid/missing volume IDs", { - login_test_account() expect_true(is.null(list_volume_assets(vol_id = 3))) expect_true(is.null(list_volume_assets(vol_id = 6))) }) diff --git a/tests/testthat/test-list_volume_info.R b/tests/testthat/test-list_volume_info.R index 826ed5fa..4ac2978a 100644 --- a/tests/testthat/test-list_volume_info.R +++ b/tests/testthat/test-list_volume_info.R @@ -10,7 +10,6 @@ test_that("list_volume_info returns tibble for default volume", { expect_true(is.list(result$vol_owner_institution)) }) -login_test_account() test_that("list_volume_info returns tibble for another volume", { result <- list_volume_info(vol_id = 2) skip_if_null_response(result, "list_volume_info(vol_id = 2)") diff --git a/tests/testthat/test-list_volume_links.R b/tests/testthat/test-list_volume_links.R index 7e015781..1314ae63 100644 --- a/tests/testthat/test-list_volume_links.R +++ b/tests/testthat/test-list_volume_links.R @@ -1,6 +1,7 @@ # list_volume_links --------------------------------------------------------- +login_test_account() + test_that("list_volume_links returns data.frame or is NULL", { - login_test_account() result <- list_volume_links(vol_id = 1) skip_if_null_response(result, "list_volume_links(vol_id = 1)") expect_s3_class(result, "tbl_df") @@ -8,7 +9,6 @@ test_that("list_volume_links returns data.frame or is NULL", { }) test_that("list_volume_links rejects bad input parameters", { - login_test_account() expect_error(list_volume_links(vol_id = "a")) expect_error(list_volume_links(vol_id = c(1,2))) expect_error(list_volume_links(vol_id = TRUE)) diff --git a/tests/testthat/test-list_volume_records.R b/tests/testthat/test-list_volume_records.R index a32ef5cf..3f65df54 100644 --- a/tests/testthat/test-list_volume_records.R +++ b/tests/testthat/test-list_volume_records.R @@ -1,8 +1,10 @@ # list_volume_records --------------------------------------------------------- login_test_account() +records_1777 <- list_volume_records(vol_id = 1777, vb = FALSE) + test_that("list_volume_records returns tibble given valid vol_id", { - result <- list_volume_records(vol_id = 1777) + result <- records_1777 skip_if_null_response(result, "list_volume_records(vol_id = 1777)") expect_s3_class(result, "tbl_df") @@ -14,7 +16,7 @@ test_that("list_volume_records returns tibble given valid vol_id", { }) test_that("list_volume_records returns valid record structure", { - result <- list_volume_records(vol_id = 1777, vb = FALSE) + result <- records_1777 skip_if_null_response(result, "list_volume_records(vol_id = 1777)") # Check column types @@ -38,8 +40,7 @@ test_that("list_volume_records returns NULL for non-existent volume", { }) test_that("list_volume_records works with category_id filter", { - # First get all records to find a valid category_id - all_records <- list_volume_records(vol_id = 1777, vb = FALSE) + all_records <- records_1777 skip_if_null_response(all_records, "list_volume_records(vol_id = 1777)") if (nrow(all_records) > 0) { @@ -118,7 +119,7 @@ test_that("list_volume_records rejects invalid rq parameter", { }) test_that("list_volume_records includes age fields", { - result <- list_volume_records(vol_id = 1777) + result <- records_1777 skip_if_null_response(result, "list_volume_records(vol_id = 1777)") # Check that age fields exist @@ -128,7 +129,7 @@ test_that("list_volume_records includes age fields", { }) test_that("list_volume_records includes measures as list column", { - result <- list_volume_records(vol_id = 1777) + result <- records_1777 skip_if_null_response(result, "list_volume_records(vol_id = 1777)") # Check that measures column is a list @@ -146,7 +147,7 @@ test_that("list_volume_records works with custom request object", { }) test_that("list_volume_records returns for different volumes", { - result1 <- list_volume_records(vol_id = 1777, vb = FALSE) + result1 <- records_1777 skip_if_null_response(result1, "list_volume_records(vol_id = 1777)") result2 <- list_volume_records(vol_id = 2, vb = FALSE) diff --git a/tests/testthat/test-list_volume_sessions.R b/tests/testthat/test-list_volume_sessions.R index d09a9879..5cd9abbf 100644 --- a/tests/testthat/test-list_volume_sessions.R +++ b/tests/testthat/test-list_volume_sessions.R @@ -1,6 +1,7 @@ # list_volume_sessions -------------------------------------------------------- +login_test_account() + test_that("list_volume_sessions returns tibble given valid vol_id", { - login_test_account() result <- list_volume_sessions() skip_if_null_response(result, "list_volume_sessions()") expect_s3_class(result, "tbl_df") @@ -8,7 +9,6 @@ test_that("list_volume_sessions returns tibble given valid vol_id", { }) test_that("list_volume_sessions returns tibble for another volume", { - login_test_account() result <- list_volume_sessions(vol_id = 2) skip_if_null_response(result, "list_volume_sessions(vol_id = 2)") expect_s3_class(result, "tbl_df") @@ -16,7 +16,6 @@ test_that("list_volume_sessions returns tibble for another volume", { }) test_that("list_volume_sessions returns NULL for unknown volume", { - login_test_account() expect_null(list_volume_sessions(vol_id = 9999)) }) diff --git a/tests/testthat/test-list_volume_tags.R b/tests/testthat/test-list_volume_tags.R index b7c274ed..8feead9c 100644 --- a/tests/testthat/test-list_volume_tags.R +++ b/tests/testthat/test-list_volume_tags.R @@ -1,6 +1,7 @@ # list_volume_tags --------------------------------------------------------- +login_test_account() + test_that("list_volume_tags returns tags for volume 1", { - login_test_account() tags <- list_volume_tags(vol_id = 1) skip_if_null_response(tags, "list_volume_tags(vol_id = 1)") expect_true(is.list(tags)) @@ -27,6 +28,5 @@ test_that("list_volume_tags rejects bad input parameters", { }) test_that("list_volume_tags returns NULL for volume without tags", { - login_test_account() expect_true(is.null(list_volume_tags(vol_id = 3))) }) diff --git a/tests/testthat/test-patch_folder.R b/tests/testthat/test-patch_folder.R index 1c6182ab..b39c958a 100644 --- a/tests/testthat/test-patch_folder.R +++ b/tests/testthat/test-patch_folder.R @@ -1,21 +1,12 @@ # patch_folder() --------------------------------------------------------------- login_test_account() -new_folder_id <- function(name = "patch_folder test") { - created <- create_folder(vol_id = 1777, name = name, vb = FALSE) - if (is.null(created)) { - return(NULL) - } - created$id -} - test_that("patch_folder updates name", { - fid <- new_folder_id("patch_folder original") + fid <- make_test_folder("patch_folder original") skip_if_null_response(fid, "create_folder for patch_folder name test") - on.exit(delete_folder(vol_id = 1777, folder_id = fid, vb = FALSE), add = TRUE) result <- patch_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, folder_id = fid, name = "patch_folder renamed", vb = FALSE @@ -28,12 +19,11 @@ test_that("patch_folder updates name", { }) test_that("patch_folder updates source_date with a Date object", { - fid <- new_folder_id("patch_folder source_date Date") + fid <- make_test_folder("patch_folder source_date Date") skip_if_null_response(fid, "create_folder for patch_folder source_date Date") - on.exit(delete_folder(vol_id = 1777, folder_id = fid, vb = FALSE), add = TRUE) result <- patch_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, folder_id = fid, source_date = as.Date("2024-03-15"), vb = FALSE @@ -43,12 +33,12 @@ test_that("patch_folder updates source_date with a Date object", { }) test_that("patch_folder returns NULL when no fields provided", { - expect_null(patch_folder(vol_id = 1777, folder_id = 1, vb = FALSE)) + expect_null(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, vb = FALSE)) }) test_that("patch_folder returns NULL for non-existent folder", { result <- patch_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, folder_id = 999999999, name = "nope", vb = FALSE @@ -57,12 +47,11 @@ test_that("patch_folder returns NULL for non-existent folder", { }) test_that("patch_folder works with verbose mode", { - fid <- new_folder_id("patch_folder vb") + fid <- make_test_folder("patch_folder vb") skip_if_null_response(fid, "create_folder for patch_folder vb") - on.exit(delete_folder(vol_id = 1777, folder_id = fid, vb = FALSE), add = TRUE) result <- patch_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, folder_id = fid, name = "patch_folder vb renamed", vb = TRUE @@ -72,13 +61,12 @@ test_that("patch_folder works with verbose mode", { }) test_that("patch_folder works with custom request object", { - fid <- new_folder_id("patch_folder custom rq") + fid <- make_test_folder("patch_folder custom rq") skip_if_null_response(fid, "create_folder for patch_folder custom rq") - on.exit(delete_folder(vol_id = 1777, folder_id = fid, vb = FALSE), add = TRUE) custom_rq <- databraryr::make_default_request() result <- patch_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, folder_id = fid, name = "patch_folder custom rq renamed", rq = custom_rq, @@ -89,22 +77,22 @@ test_that("patch_folder works with custom request object", { }) test_that("patch_folder rejects invalid name", { - expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = "")) - expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = " ")) - expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = 123)) - expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = c("A", "B"))) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "")) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = " ")) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = 123)) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = c("A", "B"))) }) test_that("patch_folder rejects malformed source_date", { - expect_error(patch_folder(vol_id = 1777, folder_id = 1, source_date = "not-a-date")) - expect_error(patch_folder(vol_id = 1777, folder_id = 1, source_date = "")) - expect_error(patch_folder(vol_id = 1777, folder_id = 1, source_date = 123)) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, source_date = "not-a-date")) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, source_date = "")) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, source_date = 123)) }) test_that("patch_folder rejects invalid release_level", { - expect_error(patch_folder(vol_id = 1777, folder_id = 1, release_level = "")) - expect_error(patch_folder(vol_id = 1777, folder_id = 1, release_level = 1)) - expect_error(patch_folder(vol_id = 1777, folder_id = 1, release_level = c("A", "B"))) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, release_level = "")) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, release_level = 1)) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, release_level = c("A", "B"))) }) test_that("patch_folder rejects invalid vol_id", { @@ -117,23 +105,23 @@ test_that("patch_folder rejects invalid vol_id", { }) test_that("patch_folder rejects invalid folder_id", { - expect_error(patch_folder(vol_id = 1777, folder_id = -1, name = "x")) - expect_error(patch_folder(vol_id = 1777, folder_id = 0, name = "x")) - expect_error(patch_folder(vol_id = 1777, folder_id = "1", name = "x")) - expect_error(patch_folder(vol_id = 1777, folder_id = TRUE, name = "x")) - expect_error(patch_folder(vol_id = 1777, folder_id = c(1, 2), name = "x")) - expect_error(patch_folder(vol_id = 1777, folder_id = 1.5, name = "x")) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = -1, name = "x")) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 0, name = "x")) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = "1", name = "x")) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = TRUE, name = "x")) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = c(1, 2), name = "x")) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1.5, name = "x")) }) test_that("patch_folder rejects invalid vb parameter", { - expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = "x", vb = -1)) - expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = "x", vb = "a")) - expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = "x", vb = c(TRUE, FALSE))) - expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = "x", vb = NULL)) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", vb = -1)) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", vb = "a")) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", vb = NULL)) }) test_that("patch_folder rejects invalid rq parameter", { - expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = "x", rq = "a")) - expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = "x", rq = -1)) - expect_error(patch_folder(vol_id = 1777, folder_id = 1, name = "x", rq = TRUE)) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", rq = "a")) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", rq = -1)) + expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", rq = TRUE)) }) diff --git a/tests/testthat/test-patch_session.R b/tests/testthat/test-patch_session.R index f8b09327..d42fe52d 100644 --- a/tests/testthat/test-patch_session.R +++ b/tests/testthat/test-patch_session.R @@ -6,7 +6,7 @@ test_that("patch_session updates name", { skip_if_null_response(sid, "create_session for patch_session name test") result <- patch_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = sid, name = "patch_session renamed", vb = FALSE @@ -23,7 +23,7 @@ test_that("patch_session updates source_date with a Date object", { skip_if_null_response(sid, "create_session for patch_session source_date Date") result <- patch_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = sid, source_date = as.Date("2024-03-15"), vb = FALSE @@ -33,12 +33,12 @@ test_that("patch_session updates source_date with a Date object", { }) test_that("patch_session returns NULL when no fields provided", { - expect_null(patch_session(vol_id = 1777, session_id = 1, vb = FALSE)) + expect_null(patch_session(vol_id = TEST_VOL_ID, session_id = 1, vb = FALSE)) }) test_that("patch_session returns NULL for non-existent session", { result <- patch_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = 999999999, name = "nope", vb = FALSE @@ -51,7 +51,7 @@ test_that("patch_session works with verbose mode", { skip_if_null_response(sid, "create_session for patch_session vb") result <- patch_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = sid, name = "patch_session vb renamed", vb = TRUE @@ -66,7 +66,7 @@ test_that("patch_session works with custom request object", { custom_rq <- databraryr::make_default_request() result <- patch_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = sid, name = "patch_session custom rq renamed", rq = custom_rq, @@ -77,16 +77,16 @@ test_that("patch_session works with custom request object", { }) test_that("patch_session rejects invalid name", { - expect_error(patch_session(vol_id = 1777, session_id = 1, name = "")) - expect_error(patch_session(vol_id = 1777, session_id = 1, name = " ")) - expect_error(patch_session(vol_id = 1777, session_id = 1, name = 123)) - expect_error(patch_session(vol_id = 1777, session_id = 1, name = c("A", "B"))) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = "")) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = " ")) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = 123)) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = c("A", "B"))) }) test_that("patch_session rejects providing both source_date and date", { expect_error( patch_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = 1, source_date = "2024-03-15", date = list(year = 2024, month = 3, day = 15) @@ -95,33 +95,33 @@ test_that("patch_session rejects providing both source_date and date", { }) test_that("patch_session rejects malformed source_date", { - expect_error(patch_session(vol_id = 1777, session_id = 1, source_date = "not-a-date")) - expect_error(patch_session(vol_id = 1777, session_id = 1, source_date = "")) - expect_error(patch_session(vol_id = 1777, session_id = 1, source_date = 123)) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, source_date = "not-a-date")) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, source_date = "")) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, source_date = 123)) }) test_that("patch_session rejects malformed date", { - expect_error(patch_session(vol_id = 1777, session_id = 1, date = "2024-03-15")) - expect_error(patch_session(vol_id = 1777, session_id = 1, date = list(2024, 3, 15))) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, date = "2024-03-15")) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, date = list(2024, 3, 15))) }) test_that("patch_session rejects invalid release_level", { - expect_error(patch_session(vol_id = 1777, session_id = 1, release_level = "")) - expect_error(patch_session(vol_id = 1777, session_id = 1, release_level = 1)) - expect_error(patch_session(vol_id = 1777, session_id = 1, release_level = c("A", "B"))) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, release_level = "")) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, release_level = 1)) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, release_level = c("A", "B"))) }) test_that("patch_session rejects invalid date_precision", { - expect_error(patch_session(vol_id = 1777, session_id = 1, date_precision = "")) - expect_error(patch_session(vol_id = 1777, session_id = 1, date_precision = 1)) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, date_precision = "")) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, date_precision = 1)) }) test_that("patch_session rejects invalid default_records", { - expect_error(patch_session(vol_id = 1777, session_id = 1, default_records = "1")) - expect_error(patch_session(vol_id = 1777, session_id = 1, default_records = c(1, -2))) - expect_error(patch_session(vol_id = 1777, session_id = 1, default_records = c(1, 0))) - expect_error(patch_session(vol_id = 1777, session_id = 1, default_records = c(1.5, 2))) - expect_error(patch_session(vol_id = 1777, session_id = 1, default_records = integer(0))) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, default_records = "1")) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, default_records = c(1, -2))) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, default_records = c(1, 0))) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, default_records = c(1.5, 2))) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, default_records = integer(0))) }) test_that("patch_session rejects invalid vol_id", { @@ -134,23 +134,23 @@ test_that("patch_session rejects invalid vol_id", { }) test_that("patch_session rejects invalid session_id", { - expect_error(patch_session(vol_id = 1777, session_id = -1, name = "x")) - expect_error(patch_session(vol_id = 1777, session_id = 0, name = "x")) - expect_error(patch_session(vol_id = 1777, session_id = "1", name = "x")) - expect_error(patch_session(vol_id = 1777, session_id = TRUE, name = "x")) - expect_error(patch_session(vol_id = 1777, session_id = c(1, 2), name = "x")) - expect_error(patch_session(vol_id = 1777, session_id = 1.5, name = "x")) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = -1, name = "x")) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 0, name = "x")) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = "1", name = "x")) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = TRUE, name = "x")) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = c(1, 2), name = "x")) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1.5, name = "x")) }) test_that("patch_session rejects invalid vb parameter", { - expect_error(patch_session(vol_id = 1777, session_id = 1, name = "x", vb = -1)) - expect_error(patch_session(vol_id = 1777, session_id = 1, name = "x", vb = "a")) - expect_error(patch_session(vol_id = 1777, session_id = 1, name = "x", vb = c(TRUE, FALSE))) - expect_error(patch_session(vol_id = 1777, session_id = 1, name = "x", vb = NULL)) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", vb = -1)) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", vb = "a")) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", vb = NULL)) }) test_that("patch_session rejects invalid rq parameter", { - expect_error(patch_session(vol_id = 1777, session_id = 1, name = "x", rq = "a")) - expect_error(patch_session(vol_id = 1777, session_id = 1, name = "x", rq = -1)) - expect_error(patch_session(vol_id = 1777, session_id = 1, name = "x", rq = TRUE)) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", rq = "a")) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", rq = -1)) + expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", rq = TRUE)) }) diff --git a/tests/testthat/test-patch_session_file.R b/tests/testthat/test-patch_session_file.R index 679b7de5..9dd94690 100644 --- a/tests/testthat/test-patch_session_file.R +++ b/tests/testthat/test-patch_session_file.R @@ -4,7 +4,7 @@ login_test_account() test_that("patch_session_file returns NULL when no fields provided", { expect_null( patch_session_file( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, vb = FALSE @@ -14,7 +14,7 @@ test_that("patch_session_file returns NULL when no fields provided", { test_that("patch_session_file returns NULL for non-existent file", { result <- patch_session_file( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = 999999999, file_id = 999999999, name = "nope", @@ -24,17 +24,17 @@ test_that("patch_session_file returns NULL for non-existent file", { }) test_that("patch_session_file rejects invalid name", { - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "")) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = " ")) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = 123)) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = c("A", "B"))) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = NA)) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = " ")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = 123)) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = c("A", "B"))) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = NA)) }) test_that("patch_session_file rejects providing both source_date and date", { expect_error( patch_session_file( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, source_date = "2024-03-15", @@ -44,30 +44,30 @@ test_that("patch_session_file rejects providing both source_date and date", { }) test_that("patch_session_file rejects malformed source_date", { - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, source_date = "not-a-date")) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, source_date = "")) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, source_date = 123)) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, source_date = "not-a-date")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, source_date = "")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, source_date = 123)) }) test_that("patch_session_file rejects malformed date", { - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, date = "2024-03-15")) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, date = list(2024, 3, 15))) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, date = "2024-03-15")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, date = list(2024, 3, 15))) }) test_that("patch_session_file rejects invalid release_level", { - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, release_level = "")) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, release_level = 1)) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, release_level = "")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, release_level = 1)) }) test_that("patch_session_file rejects invalid date_precision", { - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, date_precision = "")) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, date_precision = 1)) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, date_precision = "")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, date_precision = 1)) }) test_that("patch_session_file rejects invalid is_estimated", { - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, is_estimated = "yes")) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, is_estimated = c(TRUE, FALSE))) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, is_estimated = 1)) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, is_estimated = "yes")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, is_estimated = c(TRUE, FALSE))) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, is_estimated = 1)) }) test_that("patch_session_file rejects invalid vol_id", { @@ -80,32 +80,32 @@ test_that("patch_session_file rejects invalid vol_id", { }) test_that("patch_session_file rejects invalid session_id", { - expect_error(patch_session_file(vol_id = 1777, session_id = -1, file_id = 1, name = "x")) - expect_error(patch_session_file(vol_id = 1777, session_id = 0, file_id = 1, name = "x")) - expect_error(patch_session_file(vol_id = 1777, session_id = "1", file_id = 1, name = "x")) - expect_error(patch_session_file(vol_id = 1777, session_id = TRUE, file_id = 1, name = "x")) - expect_error(patch_session_file(vol_id = 1777, session_id = c(1, 2), file_id = 1, name = "x")) - expect_error(patch_session_file(vol_id = 1777, session_id = 1.5, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = -1, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 0, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = "1", file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = TRUE, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = c(1, 2), file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1.5, file_id = 1, name = "x")) }) test_that("patch_session_file rejects invalid file_id", { - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = -1, name = "x")) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 0, name = "x")) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = "1", name = "x")) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = TRUE, name = "x")) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = c(1, 2), name = "x")) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1.5, name = "x")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = -1, name = "x")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 0, name = "x")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = "1", name = "x")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = TRUE, name = "x")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = c(1, 2), name = "x")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1.5, name = "x")) }) test_that("patch_session_file rejects invalid vb parameter", { - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", vb = -1)) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", vb = "a")) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", vb = c(TRUE, FALSE))) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", vb = NULL)) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", vb = -1)) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", vb = "a")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", vb = NULL)) }) test_that("patch_session_file rejects invalid rq parameter", { - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", rq = "a")) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", rq = -1)) - expect_error(patch_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", rq = TRUE)) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", rq = "a")) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", rq = -1)) + expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", rq = TRUE)) }) diff --git a/tests/testthat/test-remove_default_record_from_session.R b/tests/testthat/test-remove_default_record_from_session.R index 8d166bd9..363189c3 100644 --- a/tests/testthat/test-remove_default_record_from_session.R +++ b/tests/testthat/test-remove_default_record_from_session.R @@ -1,17 +1,17 @@ # remove_default_record_from_session() ----------------------------------------- login_test_account() -# Create a session + record with the record attached as a default. -# Deferred cleanup is registered on the caller's environment; must be invoked -# from test_that(). +# create_volume_record name metric must be unique per volume; use a random +# suffix so repeated runs / leaked rows do not return HTTP 400 and NULL. setup_attached <- function(name) { envir <- parent.frame() - sid <- make_test_session(paste0(name, " session"), envir = envir) + sfx <- sample(100000L:999999L, 1L) + sid <- make_test_session(sprintf("%s session %d", name, sfx), envir = envir) if (is.null(sid)) { return(NULL) } - rid <- make_test_record(paste0(name, " record"), envir = envir) + rid <- make_test_record(sprintf("%s record %d", name, sfx), envir = envir) if (is.null(rid)) { return(NULL) } @@ -57,10 +57,11 @@ test_that("remove_default_record_from_session detaches a record", { }) test_that("remove_default_record_from_session returns FALSE for unattached record", { - sid <- make_test_session("remove_default_record unattached") + sfx <- sample(100000L:999999L, 1L) + sid <- make_test_session(sprintf("remove_default_record unattached %d", sfx)) skip_if_null_response(sid, "create_session for unattached test") - rid <- make_test_record("remove_default_record unattached record") + rid <- make_test_record(sprintf("remove_default_record unattached record %d", sfx)) skip_if_null_response(rid, "create_volume_record for unattached test") expect_false( @@ -74,7 +75,8 @@ test_that("remove_default_record_from_session returns FALSE for unattached recor }) test_that("remove_default_record_from_session returns FALSE for non-existent record", { - sid <- make_test_session("remove_default_record non-existent record") + sfx <- sample(100000L:999999L, 1L) + sid <- make_test_session(sprintf("remove_default_record non-existent record %d", sfx)) skip_if_null_response(sid, "create_session for non-existent record test") expect_false( @@ -88,7 +90,8 @@ test_that("remove_default_record_from_session returns FALSE for non-existent rec }) test_that("remove_default_record_from_session returns FALSE for non-existent session", { - rid <- make_test_record("remove_default_record non-existent session record") + sfx <- sample(100000L:999999L, 1L) + rid <- make_test_record(sprintf("remove_default_record non-existent session record %d", sfx)) skip_if_null_response(rid, "create_volume_record for non-existent session test") expect_false( diff --git a/tests/testthat/test-search_for_tags.R b/tests/testthat/test-search_for_tags.R index bd3b422e..dc3e007a 100644 --- a/tests/testthat/test-search_for_tags.R +++ b/tests/testthat/test-search_for_tags.R @@ -1,8 +1,9 @@ # search_for_tags() --------------------------------------------------- test_that("search_for_tags returns tagged volumes", { login_test_account() - result <- search_for_tags("ICIS") - skip_if_null_response(result, "search_for_tags(\"ICIS\")") + # Empty tag: backend treats as no tag filter; same broad public-index listing as empty q. + result <- search_for_tags("") + skip_if_null_response(result, "search_for_tags(\"\")") expect_s3_class(result, "tbl_df") expect_gt(nrow(result), 0) }) diff --git a/tests/testthat/test-search_institutions.R b/tests/testthat/test-search_institutions.R index f6347f86..e5fbaf38 100644 --- a/tests/testthat/test-search_institutions.R +++ b/tests/testthat/test-search_institutions.R @@ -2,8 +2,9 @@ test_that("search_institutions returns tibble", { login_test_account() - result <- search_institutions("state") - skip_if_null_response(result, "search_institutions('state')") + # Empty query: no full-text clause; API lists institutions in the search index + result <- search_institutions("") + skip_if_null_response(result, "search_institutions(\"\")") expect_s3_class(result, "tbl_df") expect_gt(nrow(result), 0) expect_true(all(c("institution_id", "score") %in% names(result))) diff --git a/tests/testthat/test-search_users.R b/tests/testthat/test-search_users.R index 70813c60..3d7427c1 100644 --- a/tests/testthat/test-search_users.R +++ b/tests/testthat/test-search_users.R @@ -2,8 +2,9 @@ test_that("search_users returns tibble", { login_test_account() - result <- search_users("gilmore") - skip_if_null_response(result, "search_users('gilmore')") + # Empty query: no full-text clause; API lists users in the search index + result <- search_users("") + skip_if_null_response(result, "search_users(\"\")") expect_s3_class(result, "tbl_df") expect_gt(nrow(result), 0) expect_true(all(c("user_id", "score") %in% names(result))) diff --git a/tests/testthat/test-search_volumes.R b/tests/testthat/test-search_volumes.R index e59911f0..86757654 100644 --- a/tests/testthat/test-search_volumes.R +++ b/tests/testthat/test-search_volumes.R @@ -2,8 +2,9 @@ test_that("search_volumes returns tibble", { login_test_account() - result <- search_volumes("workshop") - skip_if_null_response(result, "search_volumes('workshop')") + # Empty query: no full-text clause; API returns public volumes in the search index + result <- search_volumes("") + skip_if_null_response(result, "search_volumes(\"\")") expect_s3_class(result, "tbl_df") expect_gt(nrow(result), 0) expect_true(all(c("volume_id", "score") %in% names(result))) diff --git a/tests/testthat/test-set_record_measure.R b/tests/testthat/test-set_record_measure.R index 7f4b75c7..b841a15a 100644 --- a/tests/testthat/test-set_record_measure.R +++ b/tests/testthat/test-set_record_measure.R @@ -2,58 +2,34 @@ login_test_account() test_that("set_record_measure sets a text measure", { - # First create a record - create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, - name = "Set measure test", - vb = FALSE - ) - skip_if_null_response(create_result, "create_volume_record for set_measure test") + record_id <- make_test_record("Set measure test") + skip_if_null_response(record_id, "create_volume_record for set_measure test") - record_id <- create_result$record_id - - # Set a text measure (metric 10 is typically a text field for condition category) measure_result <- set_record_measure( - vol_id = 1777, + vol_id = TEST_VOL_ID, record_id = record_id, metric_id = 29, value = "Test value", vb = FALSE ) - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) - skip_if_null_response(measure_result, "set_record_measure") expect_true(!is.null(measure_result)) }) test_that("set_record_measure updates an existing measure", { - # Create a record with a measure - create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, - name = "Initial", - vb = FALSE - ) - skip_if_null_response(create_result, "create_volume_record for set_measure update test") + record_id <- make_test_record("Initial") + skip_if_null_response(record_id, "create_volume_record for set_measure update test") - record_id <- create_result$record_id - - # Update the measure measure_result <- set_record_measure( - vol_id = 1777, + vol_id = TEST_VOL_ID, record_id = record_id, metric_id = 29, value = "Updated", vb = FALSE ) - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) - skip_if_null_response(measure_result, "set_record_measure update") expect_true(!is.null(measure_result)) @@ -61,7 +37,7 @@ test_that("set_record_measure updates an existing measure", { test_that("set_record_measure returns NULL for non-existent record", { result <- set_record_measure( - vol_id = 1777, + vol_id = TEST_VOL_ID, record_id = 999999, metric_id = 29, value = "Test", @@ -71,29 +47,17 @@ test_that("set_record_measure returns NULL for non-existent record", { }) test_that("set_record_measure works with verbose mode", { - # First create a record - create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, - name = "Set measure test", - vb = FALSE - ) - skip_if_null_response(create_result, "create_volume_record for set_measure verbose test") + record_id <- make_test_record("Set measure vb") + skip_if_null_response(record_id, "create_volume_record for set_measure verbose test") - record_id <- create_result$record_id - - # Set measure with verbose measure_result <- set_record_measure( - vol_id = 1777, + vol_id = TEST_VOL_ID, record_id = record_id, metric_id = 29, value = "Test", vb = TRUE ) - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) - skip_if_null_response(measure_result, "set_record_measure with vb = TRUE") expect_true(!is.null(measure_result)) @@ -109,61 +73,49 @@ test_that("set_record_measure rejects invalid vol_id", { }) test_that("set_record_measure rejects invalid record_id", { - expect_error(set_record_measure(vol_id = 1777, record_id = -1, metric_id = 29, value = "test")) - expect_error(set_record_measure(vol_id = 1777, record_id = 0, metric_id = 29, value = "test")) - expect_error(set_record_measure(vol_id = 1777, record_id = "1", metric_id = 29, value = "test")) - expect_error(set_record_measure(vol_id = 1777, record_id = TRUE, metric_id = 29, value = "test")) - expect_error(set_record_measure(vol_id = 1777, record_id = c(1, 2), metric_id = 29, value = "test")) - expect_error(set_record_measure(vol_id = 1777, record_id = 1.5, metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = -1, metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 0, metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = "1", metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = TRUE, metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = c(1, 2), metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1.5, metric_id = 29, value = "test")) }) test_that("set_record_measure rejects invalid metric_id", { - expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = -1, value = "test")) - expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 0, value = "test")) - expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = "1", value = "test")) - expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = TRUE, value = "test")) - expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = c(1, 2), value = "test")) - expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 1.5, value = "test")) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = -1, value = "test")) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 0, value = "test")) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = "1", value = "test")) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = TRUE, value = "test")) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = c(1, 2), value = "test")) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 1.5, value = "test")) }) test_that("set_record_measure rejects invalid vb parameter", { - expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, value = "test", vb = -1)) - expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, value = "test", vb = 3)) - expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, value = "test", vb = "a")) - expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, value = "test", vb = c(TRUE, FALSE))) - expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, value = "test", vb = NULL)) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, value = "test", vb = -1)) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, value = "test", vb = 3)) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, value = "test", vb = "a")) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, value = "test", vb = c(TRUE, FALSE))) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, value = "test", vb = NULL)) }) test_that("set_record_measure rejects invalid rq parameter", { - expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, value = "test", rq = "a")) - expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, value = "test", rq = -1)) - expect_error(set_record_measure(vol_id = 1777, record_id = 1, metric_id = 29, value = "test", rq = TRUE)) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, value = "test", rq = "a")) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, value = "test", rq = -1)) + expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, value = "test", rq = TRUE)) }) test_that("set_record_measure works with numeric values", { - # Create a record - create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, - name = "Numeric measure test", - vb = FALSE - ) - skip_if_null_response(create_result, "create_volume_record for numeric measure test") + record_id <- make_test_record("Numeric measure test") + skip_if_null_response(record_id, "create_volume_record for numeric measure test") - record_id <- create_result$record_id - - # Set a numeric measure measure_result <- set_record_measure( - vol_id = 1777, + vol_id = TEST_VOL_ID, record_id = record_id, metric_id = 29, value = 42.5, vb = FALSE ) - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) - skip_if_null_response(measure_result, "set_record_measure numeric") expect_true(!is.null(measure_result)) diff --git a/tests/testthat/test-unassign_record_from_file.R b/tests/testthat/test-unassign_record_from_file.R index c98aa663..4838aadf 100644 --- a/tests/testthat/test-unassign_record_from_file.R +++ b/tests/testthat/test-unassign_record_from_file.R @@ -2,150 +2,148 @@ login_test_account() test_that("unassign_record_from_file unassigns a record from a file", { - # Create a record (unique name to avoid "already in use" across test runs) + sid <- make_test_session("unassign_record happy session") + skip_if_null_response(sid, "create_session for unassign test") + + asset_name <- sprintf("unassign_probe_%d.txt", sample(100000L:999999L, 1L)) + file_id <- upload_test_session_asset(sid, file_basename = asset_name) + skip_if_null_response(file_id, "upload for unassign test") + create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, name = sprintf("Unassign test %d", sample(100000L:999999L, 1L)), vb = FALSE ) skip_if_null_response(create_result, "create_volume_record for unassign test") record_id <- create_result$record_id - - # Get a session and file - sessions <- list_volume_sessions(vol_id = 1777, vb = FALSE) - skip_if_null_response(sessions, "list_volume_sessions for unassign test") - - if (nrow(sessions) > 0) { - session_id <- sessions$session_id[1] - files <- list_session_assets(vol_id = 1777, session_id = session_id, vb = FALSE) - - if (!is.null(files) && nrow(files) > 0) { - file_id <- files$asset_id[1] - - # Assign first - assign_record_to_file( - vol_id = 1777, - session_id = session_id, - file_id = file_id, - record_id = record_id, - vb = FALSE + withr::defer( + { + try( + unassign_record_from_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ), + silent = TRUE ) - - # Then unassign - unassign_result <- unassign_record_from_file( - vol_id = 1777, - session_id = session_id, - file_id = file_id, - record_id = record_id, - vb = FALSE + try( + delete_volume_record(vol_id = TEST_VOL_ID, record_id = record_id, vb = FALSE), + silent = TRUE ) + }, + envir = parent.frame() + ) - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + assign_record_to_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) - expect_true(unassign_result) - } - } + unassign_result <- unassign_record_from_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + expect_true(unassign_result) }) test_that("unassign_record_from_file returns FALSE for non-assigned record", { - # Create a record (unique name to avoid "already in use" across test runs) + sid <- make_test_session("unassign_record fail session") + skip_if_null_response(sid, "create_session for unassign fail test") + + asset_name <- sprintf("unassign_fail_%d.txt", sample(100000L:999999L, 1L)) + file_id <- upload_test_session_asset(sid, file_basename = asset_name) + skip_if_null_response(file_id, "upload for unassign fail test") + create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, name = sprintf("Unassign fail %d", sample(100000L:999999L, 1L)), vb = FALSE ) skip_if_null_response(create_result, "create_volume_record for unassign fail test") record_id <- create_result$record_id + withr::defer( + try(delete_volume_record(vol_id = TEST_VOL_ID, record_id = record_id, vb = FALSE), silent = TRUE), + envir = parent.frame() + ) - # Get a session and file - sessions <- list_volume_sessions(vol_id = 1777, vb = FALSE) - skip_if_null_response(sessions, "list_volume_sessions for unassign fail test") - - if (nrow(sessions) > 0) { - session_id <- sessions$session_id[1] - files <- list_session_assets(vol_id = 1777, session_id = session_id, vb = FALSE) - - if (!is.null(files) && nrow(files) > 0) { - file_id <- files$asset_id[1] - - # Try to unassign without assigning first - unassign_result <- unassign_record_from_file( - vol_id = 1777, - session_id = session_id, - file_id = file_id, - record_id = record_id, - vb = FALSE - ) - - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) - - expect_false(unassign_result) - } - } + unassign_result <- unassign_record_from_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + expect_false(unassign_result) }) test_that("unassign_record_from_file works with verbose mode", { - # Create a record (unique name to avoid "already in use" across test runs) + sid <- make_test_session("unassign_record verbose session") + skip_if_null_response(sid, "create_session for unassign verbose test") + + asset_name <- sprintf("unassign_verbose_%d.txt", sample(100000L:999999L, 1L)) + file_id <- upload_test_session_asset(sid, file_basename = asset_name) + skip_if_null_response(file_id, "upload for unassign verbose test") + create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, name = sprintf("Unassign verbose %d", sample(100000L:999999L, 1L)), vb = FALSE ) skip_if_null_response(create_result, "create_volume_record for unassign verbose test") record_id <- create_result$record_id - - # Get a session and file - sessions <- list_volume_sessions(vol_id = 1777, vb = FALSE) - skip_if_null_response(sessions, "list_volume_sessions for unassign verbose test") - - if (nrow(sessions) > 0) { - session_id <- sessions$session_id[1] - files <- list_session_assets(vol_id = 1777, session_id = session_id, vb = FALSE) - - if (!is.null(files) && nrow(files) > 0) { - file_id <- files$asset_id[1] - - # Assign first - assign_record_to_file( - vol_id = 1777, - session_id = session_id, - file_id = file_id, - record_id = record_id, - vb = FALSE + withr::defer( + { + try( + unassign_record_from_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ), + silent = TRUE ) - - # Unassign with verbose - unassign_result <- unassign_record_from_file( - vol_id = 1777, - session_id = session_id, - file_id = file_id, - record_id = record_id, - vb = TRUE + try( + delete_volume_record(vol_id = TEST_VOL_ID, record_id = record_id, vb = FALSE), + silent = TRUE ) + }, + envir = parent.frame() + ) - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + assign_record_to_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) - expect_true(unassign_result) - } - } + unassign_result <- unassign_record_from_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = TRUE + ) - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) + expect_true(unassign_result) }) test_that("unassign_record_from_file rejects invalid vol_id", { @@ -158,42 +156,42 @@ test_that("unassign_record_from_file rejects invalid vol_id", { }) test_that("unassign_record_from_file rejects invalid session_id", { - expect_error(unassign_record_from_file(vol_id = 1777, session_id = -1, file_id = 1, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 0, file_id = 1, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = "1", file_id = 1, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = TRUE, file_id = 1, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = c(1, 2), file_id = 1, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1.5, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = -1, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 0, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = "1", file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = TRUE, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = c(1, 2), file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1.5, file_id = 1, record_id = 1)) }) test_that("unassign_record_from_file rejects invalid file_id", { - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = -1, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 0, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = "1", record_id = 1)) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = TRUE, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = c(1, 2), record_id = 1)) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1.5, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = -1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 0, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = "1", record_id = 1)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = TRUE, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = c(1, 2), record_id = 1)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1.5, record_id = 1)) }) test_that("unassign_record_from_file rejects invalid record_id", { - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = -1)) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 0)) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = "1")) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = TRUE)) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = c(1, 2))) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1.5)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = -1)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 0)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = "1")) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = TRUE)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = c(1, 2))) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1.5)) }) test_that("unassign_record_from_file rejects invalid vb parameter", { - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = -1)) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = 3)) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = "a")) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = c(TRUE, FALSE))) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, vb = NULL)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = -1)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = 3)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = "a")) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = NULL)) }) test_that("unassign_record_from_file rejects invalid rq parameter", { - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, rq = "a")) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, rq = -1)) - expect_error(unassign_record_from_file(vol_id = 1777, session_id = 1, file_id = 1, record_id = 1, rq = TRUE)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, rq = "a")) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, rq = -1)) + expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, rq = TRUE)) }) diff --git a/tests/testthat/test-update_folder.R b/tests/testthat/test-update_folder.R index badd8ebf..0cbcb206 100644 --- a/tests/testthat/test-update_folder.R +++ b/tests/testthat/test-update_folder.R @@ -1,21 +1,12 @@ # update_folder() -------------------------------------------------------------- login_test_account() -new_folder_id <- function(name = "update_folder test") { - created <- create_folder(vol_id = 1777, name = name, vb = FALSE) - if (is.null(created)) { - return(NULL) - } - created$id -} - test_that("update_folder replaces name via PUT", { - fid <- new_folder_id("update_folder original") + fid <- make_test_folder("update_folder original") skip_if_null_response(fid, "create_folder for update_folder name test") - on.exit(delete_folder(vol_id = 1777, folder_id = fid, vb = FALSE), add = TRUE) result <- update_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, folder_id = fid, name = "update_folder replaced", vb = FALSE @@ -28,12 +19,11 @@ test_that("update_folder replaces name via PUT", { }) test_that("update_folder replaces source_date with a Date object", { - fid <- new_folder_id("update_folder source_date Date") + fid <- make_test_folder("update_folder source_date Date") skip_if_null_response(fid, "create_folder for update_folder source_date Date") - on.exit(delete_folder(vol_id = 1777, folder_id = fid, vb = FALSE), add = TRUE) result <- update_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, folder_id = fid, name = "update_folder source_date Date", source_date = as.Date("2024-03-15"), @@ -45,7 +35,7 @@ test_that("update_folder replaces source_date with a Date object", { test_that("update_folder returns NULL for non-existent folder", { result <- update_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, folder_id = 999999999, name = "nope", vb = FALSE @@ -54,12 +44,11 @@ test_that("update_folder returns NULL for non-existent folder", { }) test_that("update_folder works with verbose mode", { - fid <- new_folder_id("update_folder vb") + fid <- make_test_folder("update_folder vb") skip_if_null_response(fid, "create_folder for update_folder vb") - on.exit(delete_folder(vol_id = 1777, folder_id = fid, vb = FALSE), add = TRUE) result <- update_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, folder_id = fid, name = "update_folder vb replaced", vb = TRUE @@ -69,13 +58,12 @@ test_that("update_folder works with verbose mode", { }) test_that("update_folder works with custom request object", { - fid <- new_folder_id("update_folder custom rq") + fid <- make_test_folder("update_folder custom rq") skip_if_null_response(fid, "create_folder for update_folder custom rq") - on.exit(delete_folder(vol_id = 1777, folder_id = fid, vb = FALSE), add = TRUE) custom_rq <- databraryr::make_default_request() result <- update_folder( - vol_id = 1777, + vol_id = TEST_VOL_ID, folder_id = fid, name = "update_folder custom rq replaced", rq = custom_rq, @@ -86,24 +74,24 @@ test_that("update_folder works with custom request object", { }) test_that("update_folder rejects missing/invalid name", { - expect_error(update_folder(vol_id = 1777, folder_id = 1)) - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "")) - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = " ")) - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = 123)) - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = c("A", "B"))) - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = NULL)) - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = NA)) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1)) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "")) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = " ")) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = 123)) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = c("A", "B"))) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = NULL)) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = NA)) }) test_that("update_folder rejects malformed source_date", { - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", source_date = "not-a-date")) - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", source_date = "")) - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", source_date = 123)) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", source_date = "not-a-date")) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", source_date = "")) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", source_date = 123)) }) test_that("update_folder rejects invalid release_level", { - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", release_level = "")) - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", release_level = 1)) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", release_level = "")) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", release_level = 1)) }) test_that("update_folder rejects invalid vol_id", { @@ -116,23 +104,23 @@ test_that("update_folder rejects invalid vol_id", { }) test_that("update_folder rejects invalid folder_id", { - expect_error(update_folder(vol_id = 1777, folder_id = -1, name = "x")) - expect_error(update_folder(vol_id = 1777, folder_id = 0, name = "x")) - expect_error(update_folder(vol_id = 1777, folder_id = "1", name = "x")) - expect_error(update_folder(vol_id = 1777, folder_id = TRUE, name = "x")) - expect_error(update_folder(vol_id = 1777, folder_id = c(1, 2), name = "x")) - expect_error(update_folder(vol_id = 1777, folder_id = 1.5, name = "x")) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = -1, name = "x")) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 0, name = "x")) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = "1", name = "x")) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = TRUE, name = "x")) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = c(1, 2), name = "x")) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1.5, name = "x")) }) test_that("update_folder rejects invalid vb parameter", { - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", vb = -1)) - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", vb = "a")) - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", vb = c(TRUE, FALSE))) - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", vb = NULL)) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", vb = -1)) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", vb = "a")) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", vb = NULL)) }) test_that("update_folder rejects invalid rq parameter", { - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", rq = "a")) - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", rq = -1)) - expect_error(update_folder(vol_id = 1777, folder_id = 1, name = "x", rq = TRUE)) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", rq = "a")) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", rq = -1)) + expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", rq = TRUE)) }) diff --git a/tests/testthat/test-update_session.R b/tests/testthat/test-update_session.R index 0879a49c..f92cb462 100644 --- a/tests/testthat/test-update_session.R +++ b/tests/testthat/test-update_session.R @@ -6,7 +6,7 @@ test_that("update_session replaces name via PUT", { skip_if_null_response(sid, "create_session for update_session name test") result <- update_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = sid, name = "update_session replaced", vb = FALSE @@ -23,7 +23,7 @@ test_that("update_session replaces source_date with a Date object", { skip_if_null_response(sid, "create_session for update_session source_date Date") result <- update_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = sid, name = "update_session source_date Date", source_date = as.Date("2024-03-15"), @@ -35,7 +35,7 @@ test_that("update_session replaces source_date with a Date object", { test_that("update_session returns NULL for non-existent session", { result <- update_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = 999999999, name = "nope", vb = FALSE @@ -48,7 +48,7 @@ test_that("update_session works with verbose mode", { skip_if_null_response(sid, "create_session for update_session vb") result <- update_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = sid, name = "update_session vb replaced", vb = TRUE @@ -63,7 +63,7 @@ test_that("update_session works with custom request object", { custom_rq <- databraryr::make_default_request() result <- update_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = sid, name = "update_session custom rq replaced", rq = custom_rq, @@ -74,19 +74,19 @@ test_that("update_session works with custom request object", { }) test_that("update_session rejects missing/invalid name", { - expect_error(update_session(vol_id = 1777, session_id = 1)) - expect_error(update_session(vol_id = 1777, session_id = 1, name = "")) - expect_error(update_session(vol_id = 1777, session_id = 1, name = " ")) - expect_error(update_session(vol_id = 1777, session_id = 1, name = 123)) - expect_error(update_session(vol_id = 1777, session_id = 1, name = c("A", "B"))) - expect_error(update_session(vol_id = 1777, session_id = 1, name = NULL)) - expect_error(update_session(vol_id = 1777, session_id = 1, name = NA)) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1)) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "")) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = " ")) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = 123)) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = c("A", "B"))) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = NULL)) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = NA)) }) test_that("update_session rejects providing both source_date and date", { expect_error( update_session( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = 1, name = "x", source_date = "2024-03-15", @@ -96,32 +96,32 @@ test_that("update_session rejects providing both source_date and date", { }) test_that("update_session rejects malformed source_date", { - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", source_date = "not-a-date")) - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", source_date = "")) - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", source_date = 123)) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", source_date = "not-a-date")) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", source_date = "")) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", source_date = 123)) }) test_that("update_session rejects malformed date", { - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", date = "2024-03-15")) - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", date = list(2024, 3, 15))) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", date = "2024-03-15")) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", date = list(2024, 3, 15))) }) test_that("update_session rejects invalid release_level", { - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", release_level = "")) - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", release_level = 1)) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", release_level = "")) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", release_level = 1)) }) test_that("update_session rejects invalid date_precision", { - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", date_precision = "")) - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", date_precision = 1)) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", date_precision = "")) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", date_precision = 1)) }) test_that("update_session rejects invalid default_records", { - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", default_records = "1")) - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", default_records = c(1, -2))) - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", default_records = c(1, 0))) - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", default_records = c(1.5, 2))) - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", default_records = integer(0))) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", default_records = "1")) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", default_records = c(1, -2))) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", default_records = c(1, 0))) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", default_records = c(1.5, 2))) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", default_records = integer(0))) }) test_that("update_session rejects invalid vol_id", { @@ -134,23 +134,23 @@ test_that("update_session rejects invalid vol_id", { }) test_that("update_session rejects invalid session_id", { - expect_error(update_session(vol_id = 1777, session_id = -1, name = "x")) - expect_error(update_session(vol_id = 1777, session_id = 0, name = "x")) - expect_error(update_session(vol_id = 1777, session_id = "1", name = "x")) - expect_error(update_session(vol_id = 1777, session_id = TRUE, name = "x")) - expect_error(update_session(vol_id = 1777, session_id = c(1, 2), name = "x")) - expect_error(update_session(vol_id = 1777, session_id = 1.5, name = "x")) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = -1, name = "x")) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 0, name = "x")) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = "1", name = "x")) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = TRUE, name = "x")) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = c(1, 2), name = "x")) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1.5, name = "x")) }) test_that("update_session rejects invalid vb parameter", { - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", vb = -1)) - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", vb = "a")) - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", vb = c(TRUE, FALSE))) - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", vb = NULL)) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", vb = -1)) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", vb = "a")) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", vb = NULL)) }) test_that("update_session rejects invalid rq parameter", { - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", rq = "a")) - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", rq = -1)) - expect_error(update_session(vol_id = 1777, session_id = 1, name = "x", rq = TRUE)) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", rq = "a")) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", rq = -1)) + expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", rq = TRUE)) }) diff --git a/tests/testthat/test-update_session_file.R b/tests/testthat/test-update_session_file.R index f90f2c02..ab2daa78 100644 --- a/tests/testthat/test-update_session_file.R +++ b/tests/testthat/test-update_session_file.R @@ -3,7 +3,7 @@ login_test_account() test_that("update_session_file returns NULL for non-existent file", { result <- update_session_file( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = 999999999, file_id = 999999999, name = "nope", @@ -13,19 +13,19 @@ test_that("update_session_file returns NULL for non-existent file", { }) test_that("update_session_file rejects missing/invalid name", { - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1)) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "")) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = " ")) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = 123)) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = c("A", "B"))) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = NULL)) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = NA)) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1)) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = " ")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = 123)) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = c("A", "B"))) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = NULL)) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = NA)) }) test_that("update_session_file rejects providing both source_date and date", { expect_error( update_session_file( - vol_id = 1777, + vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", @@ -36,30 +36,30 @@ test_that("update_session_file rejects providing both source_date and date", { }) test_that("update_session_file rejects malformed source_date", { - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", source_date = "not-a-date")) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", source_date = "")) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", source_date = 123)) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", source_date = "not-a-date")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", source_date = "")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", source_date = 123)) }) test_that("update_session_file rejects malformed date", { - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", date = "2024-03-15")) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", date = list(2024, 3, 15))) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", date = "2024-03-15")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", date = list(2024, 3, 15))) }) test_that("update_session_file rejects invalid release_level", { - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", release_level = "")) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", release_level = 1)) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", release_level = "")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", release_level = 1)) }) test_that("update_session_file rejects invalid date_precision", { - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", date_precision = "")) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", date_precision = 1)) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", date_precision = "")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", date_precision = 1)) }) test_that("update_session_file rejects invalid is_estimated", { - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", is_estimated = "yes")) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", is_estimated = c(TRUE, FALSE))) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", is_estimated = 1)) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", is_estimated = "yes")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", is_estimated = c(TRUE, FALSE))) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", is_estimated = 1)) }) test_that("update_session_file rejects invalid vol_id", { @@ -72,32 +72,32 @@ test_that("update_session_file rejects invalid vol_id", { }) test_that("update_session_file rejects invalid session_id", { - expect_error(update_session_file(vol_id = 1777, session_id = -1, file_id = 1, name = "x")) - expect_error(update_session_file(vol_id = 1777, session_id = 0, file_id = 1, name = "x")) - expect_error(update_session_file(vol_id = 1777, session_id = "1", file_id = 1, name = "x")) - expect_error(update_session_file(vol_id = 1777, session_id = TRUE, file_id = 1, name = "x")) - expect_error(update_session_file(vol_id = 1777, session_id = c(1, 2), file_id = 1, name = "x")) - expect_error(update_session_file(vol_id = 1777, session_id = 1.5, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = -1, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 0, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = "1", file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = TRUE, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = c(1, 2), file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1.5, file_id = 1, name = "x")) }) test_that("update_session_file rejects invalid file_id", { - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = -1, name = "x")) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 0, name = "x")) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = "1", name = "x")) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = TRUE, name = "x")) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = c(1, 2), name = "x")) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1.5, name = "x")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = -1, name = "x")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 0, name = "x")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = "1", name = "x")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = TRUE, name = "x")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = c(1, 2), name = "x")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1.5, name = "x")) }) test_that("update_session_file rejects invalid vb parameter", { - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", vb = -1)) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", vb = "a")) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", vb = c(TRUE, FALSE))) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", vb = NULL)) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", vb = -1)) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", vb = "a")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", vb = NULL)) }) test_that("update_session_file rejects invalid rq parameter", { - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", rq = "a")) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", rq = -1)) - expect_error(update_session_file(vol_id = 1777, session_id = 1, file_id = 1, name = "x", rq = TRUE)) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", rq = "a")) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", rq = -1)) + expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", rq = TRUE)) }) diff --git a/tests/testthat/test-update_volume_record.R b/tests/testthat/test-update_volume_record.R index 13833172..a16c3e28 100644 --- a/tests/testthat/test-update_volume_record.R +++ b/tests/testthat/test-update_volume_record.R @@ -2,28 +2,16 @@ login_test_account() test_that("update_volume_record updates an existing record", { - # First create a record by name - create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, - name = "Initial value", - vb = FALSE - ) - skip_if_null_response(create_result, "create_volume_record for update test") + record_id <- make_test_record("Initial value") + skip_if_null_response(record_id, "create_volume_record for update test") - record_id <- create_result$record_id - - # Update the record update_result <- update_volume_record( - vol_id = 1777, + vol_id = TEST_VOL_ID, record_id = record_id, measures = list("29" = "Updated value"), vb = FALSE ) - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) - skip_if_null_response(update_result, "update_volume_record") expect_type(update_result, "list") @@ -37,7 +25,7 @@ test_that("update_volume_record updates an existing record", { test_that("update_volume_record returns NULL for non-existent record", { result <- update_volume_record( - vol_id = 1777, + vol_id = TEST_VOL_ID, record_id = 999999, measures = list("29" = "Test"), vb = FALSE @@ -46,28 +34,16 @@ test_that("update_volume_record returns NULL for non-existent record", { }) test_that("update_volume_record works with verbose mode", { - # First create a record - create_result <- create_volume_record( - vol_id = 1777, - category_id = 6, - name = "Update verbose test", - vb = FALSE - ) - skip_if_null_response(create_result, "create_volume_record for update verbose test") + record_id <- make_test_record("Update verbose test") + skip_if_null_response(record_id, "create_volume_record for update verbose test") - record_id <- create_result$record_id - - # Update with verbose update_result <- update_volume_record( - vol_id = 1777, + vol_id = TEST_VOL_ID, record_id = record_id, measures = list("29" = "Test"), vb = TRUE ) - # Clean up - delete_volume_record(vol_id = 1777, record_id = record_id, vb = FALSE) - skip_if_null_response(update_result, "update_volume_record with vb = TRUE") expect_type(update_result, "list") @@ -83,30 +59,30 @@ test_that("update_volume_record rejects invalid vol_id", { }) test_that("update_volume_record rejects invalid record_id", { - expect_error(update_volume_record(vol_id = 1777, record_id = -1)) - expect_error(update_volume_record(vol_id = 1777, record_id = 0)) - expect_error(update_volume_record(vol_id = 1777, record_id = "1")) - expect_error(update_volume_record(vol_id = 1777, record_id = TRUE)) - expect_error(update_volume_record(vol_id = 1777, record_id = c(1, 2))) - expect_error(update_volume_record(vol_id = 1777, record_id = 1.5)) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = -1)) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 0)) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = "1")) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = TRUE)) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = c(1, 2))) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1.5)) }) test_that("update_volume_record rejects invalid measures", { - expect_error(update_volume_record(vol_id = 1777, record_id = 1, measures = "text")) - expect_error(update_volume_record(vol_id = 1777, record_id = 1, measures = 123)) - expect_error(update_volume_record(vol_id = 1777, record_id = 1, measures = TRUE)) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, measures = "text")) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, measures = 123)) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, measures = TRUE)) }) test_that("update_volume_record rejects invalid vb parameter", { - expect_error(update_volume_record(vol_id = 1777, record_id = 1, vb = -1)) - expect_error(update_volume_record(vol_id = 1777, record_id = 1, vb = 3)) - expect_error(update_volume_record(vol_id = 1777, record_id = 1, vb = "a")) - expect_error(update_volume_record(vol_id = 1777, record_id = 1, vb = c(TRUE, FALSE))) - expect_error(update_volume_record(vol_id = 1777, record_id = 1, vb = NULL)) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = -1)) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = 3)) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = "a")) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = NULL)) }) test_that("update_volume_record rejects invalid rq parameter", { - expect_error(update_volume_record(vol_id = 1777, record_id = 1, rq = "a")) - expect_error(update_volume_record(vol_id = 1777, record_id = 1, rq = -1)) - expect_error(update_volume_record(vol_id = 1777, record_id = 1, rq = TRUE)) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, rq = "a")) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, rq = -1)) + expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, rq = TRUE)) }) diff --git a/tests/testthat/test-upload_file.R b/tests/testthat/test-upload_file.R index b067ee8a..b08ae4c1 100644 --- a/tests/testthat/test-upload_file.R +++ b/tests/testthat/test-upload_file.R @@ -23,15 +23,15 @@ test_that("upload_file uploads a small file end-to-end", { sid <- make_test_session("upload_file test") skip_if_null_response(sid, "create_session for upload_file") - tmp <- tempfile(fileext = ".bin") + tmp <- tempfile(fileext = ".txt") on.exit(unlink(tmp), add = TRUE) - writeBin(as.raw(seq_len(1024L) %% 256L), tmp) + writeLines(strrep("x", 2048L), tmp, useBytes = FALSE) result <- upload_file( path = tmp, destination_type = "session", object_id = sid, - content_type = "application/octet-stream", + content_type = "text/plain", vb = FALSE ) skip_if_null_response(result, "upload_file end-to-end") diff --git a/tests/testthat/test-volume_categories.R b/tests/testthat/test-volume_categories.R index b9964532..db66c248 100644 --- a/tests/testthat/test-volume_categories.R +++ b/tests/testthat/test-volume_categories.R @@ -96,13 +96,20 @@ test_that("get_volume_enabled_categories returns a list", { }) test_that("enable and disable category round-trip works", { - vol_id <- 1777 + vol_id <- TEST_VOL_ID initial <- get_volume_enabled_categories(vol_id = vol_id, vb = FALSE) skip_if_null_response(initial, "get_volume_enabled_categories for round-trip") initial_ids <- vapply(initial, function(c) as.integer(c$id), integer(1)) - test_cat <- 6L + test_cat <- TEST_CATEGORY_ID + + withr::defer( + set_volume_enabled_categories( + vol_id = vol_id, category_ids = initial_ids, vb = FALSE + ), + envir = parent.frame() + ) if (test_cat %in% initial_ids) { disable_volume_category(vol_id = vol_id, category_id = test_cat, vb = FALSE) @@ -125,8 +132,4 @@ test_that("enable and disable category round-trip works", { after_disable <- get_volume_enabled_categories(vol_id = vol_id, vb = FALSE) disabled_ids <- vapply(after_disable, function(c) as.integer(c$id), integer(1)) expect_false(test_cat %in% disabled_ids) - - set_volume_enabled_categories( - vol_id = vol_id, category_ids = initial_ids, vb = FALSE - ) }) From 127fb59ce2f07f23e0536bbac364c730be919902 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 14 May 2026 14:53:21 +0200 Subject: [PATCH 67/77] chore: update documentation --- man/download_folder_assets_fr_df.Rd | 6 ++---- man/download_session_assets_fr_df.Rd | 8 +++----- 2 files changed, 5 insertions(+), 9 deletions(-) diff --git a/man/download_folder_assets_fr_df.Rd b/man/download_folder_assets_fr_df.Rd index 40094704..aa3a3edc 100644 --- a/man/download_folder_assets_fr_df.Rd +++ b/man/download_folder_assets_fr_df.Rd @@ -5,7 +5,7 @@ \title{Download Multiple Assets From a Folder Data Frame.} \usage{ download_folder_assets_fr_df( - folder_df = NULL, + folder_df = list_folder_assets(vol_id = 1), target_dir = tempdir(), add_folder_subdir = TRUE, overwrite = TRUE, @@ -17,9 +17,7 @@ download_folder_assets_fr_df( } \arguments{ \item{folder_df}{Data frame describing assets. Must include \code{vol_id}, -\code{folder_id}, \code{asset_id}, and \code{asset_name} columns. Defaults to \code{NULL}, in -which case \code{list_folder_assets(vol_id = 1)} is used after other arguments -are validated (so invalid parameters fail without a network call).} +\code{folder_id}, \code{asset_id}, and \code{asset_name} columns.} \item{target_dir}{Character string. Base directory for downloads. Defaults to \code{tempdir()}.} diff --git a/man/download_session_assets_fr_df.Rd b/man/download_session_assets_fr_df.Rd index 39a83d49..661ab45c 100644 --- a/man/download_session_assets_fr_df.Rd +++ b/man/download_session_assets_fr_df.Rd @@ -5,7 +5,7 @@ \title{Download Multiple Assets From a Session Data Frame.} \usage{ download_session_assets_fr_df( - session_df = NULL, + session_df = list_session_assets(session_id = 9224, vol_id = 1), target_dir = tempdir(), add_session_subdir = TRUE, overwrite = TRUE, @@ -17,10 +17,8 @@ download_session_assets_fr_df( } \arguments{ \item{session_df}{Data frame describing assets. Must include \code{vol_id}, -\code{session_id}, \code{asset_id}, and \code{asset_name} columns. Defaults to \code{NULL}, -in which case \code{list_session_assets(session_id = 9224, vol_id = 1)} is -used after other arguments are validated (so invalid parameters such as -\code{target_dir = 3} fail without a network call).} +\code{session_id}, \code{asset_id}, and \code{asset_name} columns. Default is the result +\code{download_session_assets_fr_df(session_id = assets, vol_id = 1)}.} \item{target_dir}{Character string. Base directory for downloads. Defaults to \code{tempdir()}.} From 74835508168f2d2fdfd5d1c99750d07daa2c7876 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 14 May 2026 15:54:41 +0200 Subject: [PATCH 68/77] refactor: replace hardcoded IDs with constants in tests for improved maintainability and clarity --- tests/testthat/helper-fixtures.R | 5 +- .../test-add_default_record_to_session.R | 4 +- tests/testthat/test-assign_record_to_file.R | 54 +++---- .../test-check_duplicate_files_in_folder.R | 2 +- .../test-check_duplicate_files_in_session.R | 2 +- tests/testthat/test-create_folder.R | 48 +++--- tests/testthat/test-create_session.R | 70 ++++----- tests/testthat/test-create_volume_record.R | 74 ++++----- tests/testthat/test-delete_folder.R | 42 ++--- tests/testthat/test-delete_record_measure.R | 66 ++++---- tests/testthat/test-delete_session.R | 42 ++--- tests/testthat/test-delete_session_file.R | 62 ++++---- tests/testthat/test-delete_volume_record.R | 44 +++--- tests/testthat/test-get_category_by_id.R | 3 +- tests/testthat/test-get_funder_by_id.R | 3 +- tests/testthat/test-get_institution_avatar.R | 3 +- tests/testthat/test-get_tag_by_id.R | 3 +- tests/testthat/test-get_user_avatar.R | 2 +- .../test-get_volume_collaborator_by_id.R | 6 +- tests/testthat/test-get_volume_record_by_id.R | 145 ++++++++++-------- tests/testthat/test-initiate_upload.R | 2 +- tests/testthat/test-list_volume_records.R | 79 +++++----- tests/testthat/test-patch_folder.R | 48 +++--- tests/testthat/test-patch_session.R | 68 ++++---- tests/testthat/test-patch_session_file.R | 78 +++++----- .../test-remove_default_record_from_session.R | 4 +- .../testthat/test-session_record_lifecycle.R | 4 +- tests/testthat/test-set_record_measure.R | 64 ++++---- .../testthat/test-unassign_record_from_file.R | 54 +++---- tests/testthat/test-update_folder.R | 52 +++---- tests/testthat/test-update_session.R | 72 ++++----- tests/testthat/test-update_session_file.R | 82 +++++----- tests/testthat/test-update_volume_record.R | 38 ++--- 33 files changed, 675 insertions(+), 650 deletions(-) diff --git a/tests/testthat/helper-fixtures.R b/tests/testthat/helper-fixtures.R index 6d027046..433f0b1e 100644 --- a/tests/testthat/helper-fixtures.R +++ b/tests/testthat/helper-fixtures.R @@ -1,6 +1,9 @@ -# Shared sandbox IDs for live API integration tests (staging volume 1777). +# Shared sandbox IDs for live API integration tests TEST_VOL_ID <- 1777L TEST_CATEGORY_ID <- 6L +TEST_MISSING_ID <- 999999999L +TEST_METRIC_ID <- 29L +TEST_METRIC_ID_EXTRA <- 30L # create_session, then schedule delete_session on `envir` via withr::defer. # Default `envir = parent.frame()`: call from test_that() so cleanup runs when diff --git a/tests/testthat/test-add_default_record_to_session.R b/tests/testthat/test-add_default_record_to_session.R index 1f3d44c9..1b3d826e 100644 --- a/tests/testthat/test-add_default_record_to_session.R +++ b/tests/testthat/test-add_default_record_to_session.R @@ -38,7 +38,7 @@ test_that("add_default_record_to_session returns FALSE for non-existent record", add_default_record_to_session( vol_id = TEST_VOL_ID, session_id = sid, - record_id = 999999999, + record_id = TEST_MISSING_ID, vb = FALSE ) ) @@ -51,7 +51,7 @@ test_that("add_default_record_to_session returns FALSE for non-existent session" expect_false( add_default_record_to_session( vol_id = TEST_VOL_ID, - session_id = 999999999, + session_id = TEST_MISSING_ID, record_id = rid, vb = FALSE ) diff --git a/tests/testthat/test-assign_record_to_file.R b/tests/testthat/test-assign_record_to_file.R index c5015bed..716c99ac 100644 --- a/tests/testthat/test-assign_record_to_file.R +++ b/tests/testthat/test-assign_record_to_file.R @@ -114,46 +114,46 @@ test_that("assign_record_to_file rejects invalid vol_id", { expect_error(assign_record_to_file(vol_id = "1", session_id = 1, file_id = 1, record_id = 1)) expect_error(assign_record_to_file(vol_id = TRUE, session_id = 1, file_id = 1, record_id = 1)) expect_error(assign_record_to_file(vol_id = c(1, 2), session_id = 1, file_id = 1, record_id = 1)) - expect_error(assign_record_to_file(vol_id = 1777.5, session_id = 1, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1.5, session_id = 1, file_id = 1, record_id = 1)) }) test_that("assign_record_to_file rejects invalid session_id", { - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = -1, file_id = 1, record_id = 1)) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 0, file_id = 1, record_id = 1)) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = "1", file_id = 1, record_id = 1)) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = TRUE, file_id = 1, record_id = 1)) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = c(1, 2), file_id = 1, record_id = 1)) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1.5, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = -1, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 0, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = "1", file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = TRUE, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = c(1, 2), file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1.5, file_id = 1, record_id = 1)) }) test_that("assign_record_to_file rejects invalid file_id", { - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = -1, record_id = 1)) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 0, record_id = 1)) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = "1", record_id = 1)) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = TRUE, record_id = 1)) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = c(1, 2), record_id = 1)) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1.5, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = -1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 0, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = "1", record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = TRUE, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = c(1, 2), record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1.5, record_id = 1)) }) test_that("assign_record_to_file rejects invalid record_id", { - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = -1)) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 0)) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = "1")) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = TRUE)) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = c(1, 2))) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1.5)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = -1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 0)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = "1")) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = TRUE)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = c(1, 2))) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1.5)) }) test_that("assign_record_to_file rejects invalid vb parameter", { - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = -1)) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = 3)) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = "a")) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = c(TRUE, FALSE))) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = NULL)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = -1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = 3)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = "a")) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = NULL)) }) test_that("assign_record_to_file rejects invalid rq parameter", { - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, rq = "a")) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, rq = -1)) - expect_error(assign_record_to_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, rq = TRUE)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, rq = "a")) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, rq = -1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, rq = TRUE)) }) diff --git a/tests/testthat/test-check_duplicate_files_in_folder.R b/tests/testthat/test-check_duplicate_files_in_folder.R index ca198771..b946afa2 100644 --- a/tests/testthat/test-check_duplicate_files_in_folder.R +++ b/tests/testthat/test-check_duplicate_files_in_folder.R @@ -58,7 +58,7 @@ test_that("check_duplicate_files_in_folder works with a single filename", { test_that("check_duplicate_files_in_folder treats missing folder like empty (all not found)", { result <- check_duplicate_files_in_folder( vol_id = TEST_VOL_ID, - folder_id = 999999999, + folder_id = TEST_MISSING_ID, filenames = c("a.mp4"), vb = FALSE ) diff --git a/tests/testthat/test-check_duplicate_files_in_session.R b/tests/testthat/test-check_duplicate_files_in_session.R index b28961ea..db2e9ec8 100644 --- a/tests/testthat/test-check_duplicate_files_in_session.R +++ b/tests/testthat/test-check_duplicate_files_in_session.R @@ -59,7 +59,7 @@ test_that("check_duplicate_files_in_session treats missing session like empty (a # Backend does not require the session to exist; it queries files by session_id only. result <- check_duplicate_files_in_session( vol_id = TEST_VOL_ID, - session_id = 999999999, + session_id = TEST_MISSING_ID, filenames = c("a.mp4"), vb = FALSE ) diff --git a/tests/testthat/test-create_folder.R b/tests/testthat/test-create_folder.R index 7ef987d4..34d970e4 100644 --- a/tests/testthat/test-create_folder.R +++ b/tests/testthat/test-create_folder.R @@ -108,25 +108,25 @@ test_that("create_folder works with custom request object", { }) test_that("create_folder returns NULL for non-existent volume", { - expect_null(create_folder(vol_id = 999999999, name = "Test", vb = FALSE)) + expect_null(create_folder(vol_id = TEST_MISSING_ID, name = "Test", vb = FALSE)) }) test_that("create_folder rejects invalid name", { - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "")) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = " ")) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = 123)) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = c("A", "B"))) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = NULL)) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = NA)) + expect_error(create_folder(vol_id = 1, name = "")) + expect_error(create_folder(vol_id = 1, name = " ")) + expect_error(create_folder(vol_id = 1, name = 123)) + expect_error(create_folder(vol_id = 1, name = c("A", "B"))) + expect_error(create_folder(vol_id = 1, name = NULL)) + expect_error(create_folder(vol_id = 1, name = NA)) }) test_that("create_folder rejects malformed source_date", { - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", source_date = "not-a-date")) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", source_date = "")) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", source_date = 123)) + expect_error(create_folder(vol_id = 1, name = "Test", source_date = "not-a-date")) + expect_error(create_folder(vol_id = 1, name = "Test", source_date = "")) + expect_error(create_folder(vol_id = 1, name = "Test", source_date = 123)) expect_error( create_folder( - vol_id = TEST_VOL_ID, + vol_id = 1, name = "Test", source_date = as.Date(c("2024-01-01", "2024-02-01")) ) @@ -134,9 +134,9 @@ test_that("create_folder rejects malformed source_date", { }) test_that("create_folder rejects invalid release_level", { - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", release_level = "")) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", release_level = 1)) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", release_level = c("A", "B"))) + expect_error(create_folder(vol_id = 1, name = "Test", release_level = "")) + expect_error(create_folder(vol_id = 1, name = "Test", release_level = 1)) + expect_error(create_folder(vol_id = 1, name = "Test", release_level = c("A", "B"))) }) test_that("create_folder rejects invalid vol_id", { @@ -150,17 +150,17 @@ test_that("create_folder rejects invalid vol_id", { }) test_that("create_folder rejects invalid vb parameter", { - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", vb = -1)) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", vb = "a")) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", vb = list(a = 1))) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", vb = c(TRUE, FALSE))) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", vb = NULL)) + expect_error(create_folder(vol_id = 1, name = "Test", vb = -1)) + expect_error(create_folder(vol_id = 1, name = "Test", vb = "a")) + expect_error(create_folder(vol_id = 1, name = "Test", vb = list(a = 1))) + expect_error(create_folder(vol_id = 1, name = "Test", vb = c(TRUE, FALSE))) + expect_error(create_folder(vol_id = 1, name = "Test", vb = NULL)) }) test_that("create_folder rejects invalid rq parameter", { - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", rq = "a")) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", rq = -1)) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", rq = c(2, 3))) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", rq = list(a = 1))) - expect_error(create_folder(vol_id = TEST_VOL_ID, name = "Test", rq = TRUE)) + expect_error(create_folder(vol_id = 1, name = "Test", rq = "a")) + expect_error(create_folder(vol_id = 1, name = "Test", rq = -1)) + expect_error(create_folder(vol_id = 1, name = "Test", rq = c(2, 3))) + expect_error(create_folder(vol_id = 1, name = "Test", rq = list(a = 1))) + expect_error(create_folder(vol_id = 1, name = "Test", rq = TRUE)) }) diff --git a/tests/testthat/test-create_session.R b/tests/testthat/test-create_session.R index 6f7dec66..4a1ab8d0 100644 --- a/tests/testthat/test-create_session.R +++ b/tests/testthat/test-create_session.R @@ -82,22 +82,22 @@ test_that("create_session works with custom request object", { }) test_that("create_session returns NULL for non-existent volume", { - expect_null(create_session(vol_id = 999999999, name = "Test", vb = FALSE)) + expect_null(create_session(vol_id = TEST_MISSING_ID, name = "Test", vb = FALSE)) }) test_that("create_session rejects invalid name", { - expect_error(create_session(vol_id = TEST_VOL_ID, name = "")) - expect_error(create_session(vol_id = TEST_VOL_ID, name = " ")) - expect_error(create_session(vol_id = TEST_VOL_ID, name = 123)) - expect_error(create_session(vol_id = TEST_VOL_ID, name = c("A", "B"))) - expect_error(create_session(vol_id = TEST_VOL_ID, name = NULL)) - expect_error(create_session(vol_id = TEST_VOL_ID, name = NA)) + expect_error(create_session(vol_id = 1, name = "")) + expect_error(create_session(vol_id = 1, name = " ")) + expect_error(create_session(vol_id = 1, name = 123)) + expect_error(create_session(vol_id = 1, name = c("A", "B"))) + expect_error(create_session(vol_id = 1, name = NULL)) + expect_error(create_session(vol_id = 1, name = NA)) }) test_that("create_session rejects providing both source_date and date", { expect_error( create_session( - vol_id = TEST_VOL_ID, + vol_id = 1, name = "Test", source_date = "2024-03-15", date = list(year = 2024, month = 3, day = 15) @@ -106,12 +106,12 @@ test_that("create_session rejects providing both source_date and date", { }) test_that("create_session rejects malformed source_date", { - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", source_date = "not-a-date")) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", source_date = "")) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", source_date = 123)) + expect_error(create_session(vol_id = 1, name = "Test", source_date = "not-a-date")) + expect_error(create_session(vol_id = 1, name = "Test", source_date = "")) + expect_error(create_session(vol_id = 1, name = "Test", source_date = 123)) expect_error( create_session( - vol_id = TEST_VOL_ID, + vol_id = 1, name = "Test", source_date = as.Date(c("2024-01-01", "2024-02-01")) ) @@ -119,28 +119,28 @@ test_that("create_session rejects malformed source_date", { }) test_that("create_session rejects malformed date list", { - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", date = "2024-03-15")) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", date = list(2024, 3, 15))) + expect_error(create_session(vol_id = 1, name = "Test", date = "2024-03-15")) + expect_error(create_session(vol_id = 1, name = "Test", date = list(2024, 3, 15))) }) test_that("create_session rejects invalid release_level", { - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", release_level = "")) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", release_level = 1)) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", release_level = c("A", "B"))) + expect_error(create_session(vol_id = 1, name = "Test", release_level = "")) + expect_error(create_session(vol_id = 1, name = "Test", release_level = 1)) + expect_error(create_session(vol_id = 1, name = "Test", release_level = c("A", "B"))) }) test_that("create_session rejects invalid date_precision", { - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", date_precision = "")) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", date_precision = 1)) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", date_precision = c("FULL", "YEAR"))) + expect_error(create_session(vol_id = 1, name = "Test", date_precision = "")) + expect_error(create_session(vol_id = 1, name = "Test", date_precision = 1)) + expect_error(create_session(vol_id = 1, name = "Test", date_precision = c("FULL", "YEAR"))) }) test_that("create_session rejects invalid default_records", { - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", default_records = "1")) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", default_records = c(1, -2))) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", default_records = c(1, 0))) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", default_records = c(1.5, 2))) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", default_records = integer(0))) + expect_error(create_session(vol_id = 1, name = "Test", default_records = "1")) + expect_error(create_session(vol_id = 1, name = "Test", default_records = c(1, -2))) + expect_error(create_session(vol_id = 1, name = "Test", default_records = c(1, 0))) + expect_error(create_session(vol_id = 1, name = "Test", default_records = c(1.5, 2))) + expect_error(create_session(vol_id = 1, name = "Test", default_records = integer(0))) }) test_that("create_session rejects invalid vol_id", { @@ -154,17 +154,17 @@ test_that("create_session rejects invalid vol_id", { }) test_that("create_session rejects invalid vb parameter", { - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", vb = -1)) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", vb = "a")) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", vb = list(a = 1))) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", vb = c(TRUE, FALSE))) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", vb = NULL)) + expect_error(create_session(vol_id = 1, name = "Test", vb = -1)) + expect_error(create_session(vol_id = 1, name = "Test", vb = "a")) + expect_error(create_session(vol_id = 1, name = "Test", vb = list(a = 1))) + expect_error(create_session(vol_id = 1, name = "Test", vb = c(TRUE, FALSE))) + expect_error(create_session(vol_id = 1, name = "Test", vb = NULL)) }) test_that("create_session rejects invalid rq parameter", { - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", rq = "a")) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", rq = -1)) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", rq = c(2, 3))) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", rq = list(a = 1))) - expect_error(create_session(vol_id = TEST_VOL_ID, name = "Test", rq = TRUE)) + expect_error(create_session(vol_id = 1, name = "Test", rq = "a")) + expect_error(create_session(vol_id = 1, name = "Test", rq = -1)) + expect_error(create_session(vol_id = 1, name = "Test", rq = c(2, 3))) + expect_error(create_session(vol_id = 1, name = "Test", rq = list(a = 1))) + expect_error(create_session(vol_id = 1, name = "Test", rq = TRUE)) }) diff --git a/tests/testthat/test-create_volume_record.R b/tests/testthat/test-create_volume_record.R index e04e02f6..5b38057d 100644 --- a/tests/testthat/test-create_volume_record.R +++ b/tests/testthat/test-create_volume_record.R @@ -42,12 +42,12 @@ test_that("create_volume_record creates a record with measures", { }) test_that("create_volume_record creates a record with name and additional measures", { - # Task category (6) in vol 1777 has optional metric 30 + # Optional metric TEST_METRIC_ID_EXTRA on TEST_CATEGORY_ID in TEST_VOL_ID (see create_volume_record tests). result <- create_volume_record( vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Task with extra measures", - measures = list("30" = "Extra value"), + measures = stats::setNames(list("Extra value"), as.character(TEST_METRIC_ID_EXTRA)), vb = FALSE ) skip_if_null_response(result, "create_volume_record with name and measures") @@ -60,15 +60,15 @@ test_that("create_volume_record creates a record with name and additional measur }) test_that("create_volume_record rejects invalid name", { - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "")) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = " ")) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = 123)) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = c("A", "B"))) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "")) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = " ")) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = 123)) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = c("A", "B"))) }) test_that("create_volume_record returns NULL for non-existent volume", { result <- create_volume_record( - vol_id = 999999, + vol_id = TEST_MISSING_ID, category_id = TEST_CATEGORY_ID, name = "Test", vb = FALSE @@ -93,68 +93,68 @@ test_that("create_volume_record works with verbose mode", { test_that("create_volume_record rejects invalid vol_id", { # Negative ID - expect_error(create_volume_record(vol_id = -1, category_id = TEST_CATEGORY_ID, name = "Test")) + expect_error(create_volume_record(vol_id = -1, category_id = 1, name = "Test")) # Zero ID - expect_error(create_volume_record(vol_id = 0, category_id = TEST_CATEGORY_ID, name = "Test")) + expect_error(create_volume_record(vol_id = 0, category_id = 1, name = "Test")) # Non-numeric ID - expect_error(create_volume_record(vol_id = "1", category_id = TEST_CATEGORY_ID, name = "Test")) - expect_error(create_volume_record(vol_id = TRUE, category_id = TEST_CATEGORY_ID, name = "Test")) - expect_error(create_volume_record(vol_id = list(a = 1), category_id = TEST_CATEGORY_ID, name = "Test")) + expect_error(create_volume_record(vol_id = "1", category_id = 1, name = "Test")) + expect_error(create_volume_record(vol_id = TRUE, category_id = 1, name = "Test")) + expect_error(create_volume_record(vol_id = list(a = 1), category_id = 1, name = "Test")) # Multiple values - expect_error(create_volume_record(vol_id = c(1, 2), category_id = TEST_CATEGORY_ID, name = "Test")) + expect_error(create_volume_record(vol_id = c(1, 2), category_id = 1, name = "Test")) # Decimal/non-integer - expect_error(create_volume_record(vol_id = 1777.5, category_id = TEST_CATEGORY_ID, name = "Test")) + expect_error(create_volume_record(vol_id = 1.5, category_id = 1, name = "Test")) }) test_that("create_volume_record rejects invalid category_id", { # Negative ID - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = -1, name = "Test")) + expect_error(create_volume_record(vol_id = 1, category_id = -1, name = "Test")) # Zero ID - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = 0, name = "Test")) + expect_error(create_volume_record(vol_id = 1, category_id = 0, name = "Test")) # Non-numeric ID - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = "1", name = "Test")) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TRUE, name = "Test")) + expect_error(create_volume_record(vol_id = 1, category_id = "1", name = "Test")) + expect_error(create_volume_record(vol_id = 1, category_id = TRUE, name = "Test")) # Multiple values - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = c(1, 2), name = "Test")) + expect_error(create_volume_record(vol_id = 1, category_id = c(1, 2), name = "Test")) # Decimal/non-integer - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = 1.5, name = "Test")) + expect_error(create_volume_record(vol_id = 1, category_id = 1.5, name = "Test")) }) test_that("create_volume_record rejects invalid measures", { - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", measures = "text")) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", measures = 123)) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", measures = TRUE)) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", measures = "text")) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", measures = 123)) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", measures = TRUE)) }) test_that("create_volume_record rejects invalid participant", { - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = 1, name = "Test", participant = "text")) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = 1, name = "Test", participant = 123)) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = 1, name = "Test", participant = TRUE)) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", participant = "text")) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", participant = 123)) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", participant = TRUE)) }) test_that("create_volume_record rejects invalid vb parameter", { - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", vb = -1)) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", vb = 3)) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", vb = "a")) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", vb = list(a = 1))) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", vb = c(TRUE, FALSE))) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", vb = NULL)) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", vb = -1)) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", vb = 3)) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", vb = "a")) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", vb = list(a = 1))) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", vb = c(TRUE, FALSE))) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", vb = NULL)) }) test_that("create_volume_record rejects invalid rq parameter", { - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", rq = "a")) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", rq = -1)) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", rq = c(2, 3))) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", rq = list(a = 1))) - expect_error(create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = "Test", rq = TRUE)) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", rq = "a")) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", rq = -1)) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", rq = c(2, 3))) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", rq = list(a = 1))) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", rq = TRUE)) }) test_that("create_volume_record works with custom request object", { diff --git a/tests/testthat/test-delete_folder.R b/tests/testthat/test-delete_folder.R index 7a0e46ef..9853904f 100644 --- a/tests/testthat/test-delete_folder.R +++ b/tests/testthat/test-delete_folder.R @@ -20,7 +20,7 @@ test_that("delete_folder deletes an existing folder", { }) test_that("delete_folder returns FALSE for non-existent folder", { - expect_false(delete_folder(vol_id = TEST_VOL_ID, folder_id = 999999999, vb = FALSE)) + expect_false(delete_folder(vol_id = TEST_VOL_ID, folder_id = TEST_MISSING_ID, vb = FALSE)) }) test_that("delete_folder works with verbose mode", { @@ -72,30 +72,30 @@ test_that("delete_folder rejects invalid vol_id", { }) test_that("delete_folder rejects invalid folder_id", { - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = -1)) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 0)) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = "1")) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = TRUE)) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = list(a = 1))) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = c(1, 2))) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1.5)) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = NULL)) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = NA)) + expect_error(delete_folder(vol_id = 1, folder_id = -1)) + expect_error(delete_folder(vol_id = 1, folder_id = 0)) + expect_error(delete_folder(vol_id = 1, folder_id = "1")) + expect_error(delete_folder(vol_id = 1, folder_id = TRUE)) + expect_error(delete_folder(vol_id = 1, folder_id = list(a = 1))) + expect_error(delete_folder(vol_id = 1, folder_id = c(1, 2))) + expect_error(delete_folder(vol_id = 1, folder_id = 1.5)) + expect_error(delete_folder(vol_id = 1, folder_id = NULL)) + expect_error(delete_folder(vol_id = 1, folder_id = NA)) }) test_that("delete_folder rejects invalid vb parameter", { - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, vb = -1)) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, vb = 3)) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, vb = "a")) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, vb = list(a = 1))) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, vb = c(TRUE, FALSE))) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, vb = NULL)) + expect_error(delete_folder(vol_id = 1, folder_id = 1, vb = -1)) + expect_error(delete_folder(vol_id = 1, folder_id = 1, vb = 3)) + expect_error(delete_folder(vol_id = 1, folder_id = 1, vb = "a")) + expect_error(delete_folder(vol_id = 1, folder_id = 1, vb = list(a = 1))) + expect_error(delete_folder(vol_id = 1, folder_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_folder(vol_id = 1, folder_id = 1, vb = NULL)) }) test_that("delete_folder rejects invalid rq parameter", { - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, rq = "a")) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, rq = -1)) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, rq = c(2, 3))) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, rq = list(a = 1))) - expect_error(delete_folder(vol_id = TEST_VOL_ID, folder_id = 1, rq = TRUE)) + expect_error(delete_folder(vol_id = 1, folder_id = 1, rq = "a")) + expect_error(delete_folder(vol_id = 1, folder_id = 1, rq = -1)) + expect_error(delete_folder(vol_id = 1, folder_id = 1, rq = c(2, 3))) + expect_error(delete_folder(vol_id = 1, folder_id = 1, rq = list(a = 1))) + expect_error(delete_folder(vol_id = 1, folder_id = 1, rq = TRUE)) }) diff --git a/tests/testthat/test-delete_record_measure.R b/tests/testthat/test-delete_record_measure.R index 1de75118..95b93cc3 100644 --- a/tests/testthat/test-delete_record_measure.R +++ b/tests/testthat/test-delete_record_measure.R @@ -5,12 +5,12 @@ test_that("delete_record_measure deletes a measure", { record_id <- make_test_record("Delete measure test") skip_if_null_response(record_id, "create_volume_record for delete_measure test") - set_record_measure(vol_id = TEST_VOL_ID, record_id = record_id, metric_id = 30, value = "temp", vb = FALSE) + set_record_measure(vol_id = TEST_VOL_ID, record_id = record_id, metric_id = TEST_METRIC_ID_EXTRA, value = "temp", vb = FALSE) delete_result <- delete_record_measure( vol_id = TEST_VOL_ID, record_id = record_id, - metric_id = 30, + metric_id = TEST_METRIC_ID_EXTRA, vb = FALSE ) @@ -24,7 +24,7 @@ test_that("delete_record_measure returns FALSE for non-existent measure", { delete_result <- delete_record_measure( vol_id = TEST_VOL_ID, record_id = record_id, - metric_id = 29, + metric_id = TEST_METRIC_ID, vb = FALSE ) @@ -34,12 +34,12 @@ test_that("delete_record_measure returns FALSE for non-existent measure", { test_that("delete_record_measure works with verbose mode", { record_id <- make_test_record("Delete verbose test") skip_if_null_response(record_id, "create_volume_record for delete_measure verbose test") - set_record_measure(vol_id = TEST_VOL_ID, record_id = record_id, metric_id = 30, value = "temp", vb = FALSE) + set_record_measure(vol_id = TEST_VOL_ID, record_id = record_id, metric_id = TEST_METRIC_ID_EXTRA, value = "temp", vb = FALSE) delete_result <- delete_record_measure( vol_id = TEST_VOL_ID, record_id = record_id, - metric_id = 30, + metric_id = TEST_METRIC_ID_EXTRA, vb = TRUE ) @@ -47,56 +47,56 @@ test_that("delete_record_measure works with verbose mode", { }) test_that("delete_record_measure rejects invalid vol_id", { - expect_error(delete_record_measure(vol_id = -1, record_id = 1, metric_id = 29)) - expect_error(delete_record_measure(vol_id = 0, record_id = 1, metric_id = 29)) - expect_error(delete_record_measure(vol_id = "1", record_id = 1, metric_id = 29)) - expect_error(delete_record_measure(vol_id = TRUE, record_id = 1, metric_id = 29)) - expect_error(delete_record_measure(vol_id = c(1, 2), record_id = 1, metric_id = 29)) - expect_error(delete_record_measure(vol_id = 1777.5, record_id = 1, metric_id = 29)) + expect_error(delete_record_measure(vol_id = -1, record_id = 1, metric_id = 1)) + expect_error(delete_record_measure(vol_id = 0, record_id = 1, metric_id = 1)) + expect_error(delete_record_measure(vol_id = "1", record_id = 1, metric_id = 1)) + expect_error(delete_record_measure(vol_id = TRUE, record_id = 1, metric_id = 1)) + expect_error(delete_record_measure(vol_id = c(1, 2), record_id = 1, metric_id = 1)) + expect_error(delete_record_measure(vol_id = 1.5, record_id = 1, metric_id = 1)) }) test_that("delete_record_measure rejects invalid record_id", { - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = -1, metric_id = 29)) - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 0, metric_id = 29)) - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = "1", metric_id = 29)) - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = TRUE, metric_id = 29)) - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = c(1, 2), metric_id = 29)) - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1.5, metric_id = 29)) + expect_error(delete_record_measure(vol_id = 1, record_id = -1, metric_id = 1)) + expect_error(delete_record_measure(vol_id = 1, record_id = 0, metric_id = 1)) + expect_error(delete_record_measure(vol_id = 1, record_id = "1", metric_id = 1)) + expect_error(delete_record_measure(vol_id = 1, record_id = TRUE, metric_id = 1)) + expect_error(delete_record_measure(vol_id = 1, record_id = c(1, 2), metric_id = 1)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1.5, metric_id = 1)) }) test_that("delete_record_measure rejects invalid metric_id", { - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = -1)) - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 0)) - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = "1")) - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = TRUE)) - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = c(1, 2))) - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 1.5)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = -1)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 0)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = "1")) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = TRUE)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = c(1, 2))) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1.5)) }) test_that("delete_record_measure rejects invalid vb parameter", { - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, vb = -1)) - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, vb = 3)) - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, vb = "a")) - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, vb = c(TRUE, FALSE))) - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, vb = NULL)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1, vb = -1)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1, vb = 3)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1, vb = "a")) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1, vb = NULL)) }) test_that("delete_record_measure rejects invalid rq parameter", { - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, rq = "a")) - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, rq = -1)) - expect_error(delete_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, rq = TRUE)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1, rq = "a")) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1, rq = -1)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1, rq = TRUE)) }) test_that("delete_record_measure works with custom request object", { record_id <- make_test_record("Delete custom rq test") skip_if_null_response(record_id, "create_volume_record for delete_measure custom rq test") - set_record_measure(vol_id = TEST_VOL_ID, record_id = record_id, metric_id = 30, value = "temp", vb = FALSE) + set_record_measure(vol_id = TEST_VOL_ID, record_id = record_id, metric_id = TEST_METRIC_ID_EXTRA, value = "temp", vb = FALSE) custom_rq <- databraryr::make_default_request() delete_result <- delete_record_measure( vol_id = TEST_VOL_ID, record_id = record_id, - metric_id = 30, + metric_id = TEST_METRIC_ID_EXTRA, rq = custom_rq, vb = FALSE ) diff --git a/tests/testthat/test-delete_session.R b/tests/testthat/test-delete_session.R index 8dbb19ca..b06c1c49 100644 --- a/tests/testthat/test-delete_session.R +++ b/tests/testthat/test-delete_session.R @@ -19,7 +19,7 @@ test_that("delete_session deletes an existing session", { }) test_that("delete_session returns FALSE for non-existent session", { - expect_false(delete_session(vol_id = TEST_VOL_ID, session_id = 999999999, vb = FALSE)) + expect_false(delete_session(vol_id = TEST_VOL_ID, session_id = TEST_MISSING_ID, vb = FALSE)) }) test_that("delete_session works with verbose mode", { @@ -71,30 +71,30 @@ test_that("delete_session rejects invalid vol_id", { }) test_that("delete_session rejects invalid session_id", { - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = -1)) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 0)) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = "1")) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = TRUE)) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = list(a = 1))) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = c(1, 2))) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1.5)) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = NULL)) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = NA)) + expect_error(delete_session(vol_id = 1, session_id = -1)) + expect_error(delete_session(vol_id = 1, session_id = 0)) + expect_error(delete_session(vol_id = 1, session_id = "1")) + expect_error(delete_session(vol_id = 1, session_id = TRUE)) + expect_error(delete_session(vol_id = 1, session_id = list(a = 1))) + expect_error(delete_session(vol_id = 1, session_id = c(1, 2))) + expect_error(delete_session(vol_id = 1, session_id = 1.5)) + expect_error(delete_session(vol_id = 1, session_id = NULL)) + expect_error(delete_session(vol_id = 1, session_id = NA)) }) test_that("delete_session rejects invalid vb parameter", { - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, vb = -1)) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, vb = 3)) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, vb = "a")) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, vb = list(a = 1))) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, vb = c(TRUE, FALSE))) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, vb = NULL)) + expect_error(delete_session(vol_id = 1, session_id = 1, vb = -1)) + expect_error(delete_session(vol_id = 1, session_id = 1, vb = 3)) + expect_error(delete_session(vol_id = 1, session_id = 1, vb = "a")) + expect_error(delete_session(vol_id = 1, session_id = 1, vb = list(a = 1))) + expect_error(delete_session(vol_id = 1, session_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_session(vol_id = 1, session_id = 1, vb = NULL)) }) test_that("delete_session rejects invalid rq parameter", { - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, rq = "a")) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, rq = -1)) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, rq = c(2, 3))) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, rq = list(a = 1))) - expect_error(delete_session(vol_id = TEST_VOL_ID, session_id = 1, rq = TRUE)) + expect_error(delete_session(vol_id = 1, session_id = 1, rq = "a")) + expect_error(delete_session(vol_id = 1, session_id = 1, rq = -1)) + expect_error(delete_session(vol_id = 1, session_id = 1, rq = c(2, 3))) + expect_error(delete_session(vol_id = 1, session_id = 1, rq = list(a = 1))) + expect_error(delete_session(vol_id = 1, session_id = 1, rq = TRUE)) }) diff --git a/tests/testthat/test-delete_session_file.R b/tests/testthat/test-delete_session_file.R index add6e514..0bbed45a 100644 --- a/tests/testthat/test-delete_session_file.R +++ b/tests/testthat/test-delete_session_file.R @@ -5,8 +5,8 @@ test_that("delete_session_file returns FALSE for non-existent file", { expect_false( delete_session_file( vol_id = TEST_VOL_ID, - session_id = 999999999, - file_id = 999999999, + session_id = TEST_MISSING_ID, + file_id = TEST_MISSING_ID, vb = FALSE ) ) @@ -25,42 +25,42 @@ test_that("delete_session_file rejects invalid vol_id", { }) test_that("delete_session_file rejects invalid session_id", { - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = -1, file_id = 1)) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 0, file_id = 1)) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = "1", file_id = 1)) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = TRUE, file_id = 1)) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = list(a = 1), file_id = 1)) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = c(1, 2), file_id = 1)) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1.5, file_id = 1)) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = NULL, file_id = 1)) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = NA, file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = -1, file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = 0, file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = "1", file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = TRUE, file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = list(a = 1), file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = c(1, 2), file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = 1.5, file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = NULL, file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = NA, file_id = 1)) }) test_that("delete_session_file rejects invalid file_id", { - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = -1)) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 0)) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = "1")) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = TRUE)) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = list(a = 1))) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = c(1, 2))) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1.5)) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = NULL)) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = NA)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = -1)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 0)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = "1")) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = TRUE)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = list(a = 1))) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = c(1, 2))) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1.5)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = NULL)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = NA)) }) test_that("delete_session_file rejects invalid vb parameter", { - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, vb = -1)) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, vb = 3)) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, vb = "a")) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, vb = list(a = 1))) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, vb = c(TRUE, FALSE))) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, vb = NULL)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, vb = -1)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, vb = 3)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, vb = "a")) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, vb = list(a = 1))) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, vb = NULL)) }) test_that("delete_session_file rejects invalid rq parameter", { - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, rq = "a")) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, rq = -1)) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, rq = c(2, 3))) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, rq = list(a = 1))) - expect_error(delete_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, rq = TRUE)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, rq = "a")) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, rq = -1)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, rq = c(2, 3))) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, rq = list(a = 1))) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, rq = TRUE)) }) diff --git a/tests/testthat/test-delete_volume_record.R b/tests/testthat/test-delete_volume_record.R index e83590d2..f014e7ca 100644 --- a/tests/testthat/test-delete_volume_record.R +++ b/tests/testthat/test-delete_volume_record.R @@ -24,7 +24,7 @@ test_that("delete_volume_record deletes an existing record", { test_that("delete_volume_record returns FALSE for non-existent record", { result <- delete_volume_record( vol_id = TEST_VOL_ID, - record_id = 999999, + record_id = TEST_MISSING_ID, vb = FALSE ) expect_false(result) @@ -50,38 +50,38 @@ test_that("delete_volume_record rejects invalid vol_id", { expect_error(delete_volume_record(vol_id = TRUE, record_id = 1)) expect_error(delete_volume_record(vol_id = list(a = 1), record_id = 1)) expect_error(delete_volume_record(vol_id = c(1, 2), record_id = 1)) - expect_error(delete_volume_record(vol_id = 1777.5, record_id = 1)) + expect_error(delete_volume_record(vol_id = 1.5, record_id = 1)) expect_error(delete_volume_record(vol_id = NULL, record_id = 1)) expect_error(delete_volume_record(vol_id = NA, record_id = 1)) }) test_that("delete_volume_record rejects invalid record_id", { - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = -1)) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 0)) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = "1")) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = TRUE)) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = list(a = 1))) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = c(1, 2))) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1.5)) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = NULL)) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = NA)) + expect_error(delete_volume_record(vol_id = 1, record_id = -1)) + expect_error(delete_volume_record(vol_id = 1, record_id = 0)) + expect_error(delete_volume_record(vol_id = 1, record_id = "1")) + expect_error(delete_volume_record(vol_id = 1, record_id = TRUE)) + expect_error(delete_volume_record(vol_id = 1, record_id = list(a = 1))) + expect_error(delete_volume_record(vol_id = 1, record_id = c(1, 2))) + expect_error(delete_volume_record(vol_id = 1, record_id = 1.5)) + expect_error(delete_volume_record(vol_id = 1, record_id = NULL)) + expect_error(delete_volume_record(vol_id = 1, record_id = NA)) }) test_that("delete_volume_record rejects invalid vb parameter", { - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = -1)) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = 3)) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = "a")) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = list(a = 1, b = 2))) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = c(TRUE, FALSE))) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = NULL)) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, vb = -1)) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, vb = 3)) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, vb = "a")) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, vb = list(a = 1, b = 2))) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, vb = NULL)) }) test_that("delete_volume_record rejects invalid rq parameter", { - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, rq = "a")) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, rq = -1)) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, rq = c(2, 3))) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, rq = list(a = 1, b = 2))) - expect_error(delete_volume_record(vol_id = TEST_VOL_ID, record_id = 1, rq = TRUE)) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, rq = "a")) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, rq = -1)) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, rq = c(2, 3))) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, rq = list(a = 1, b = 2))) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, rq = TRUE)) }) test_that("delete_volume_record works with custom request object", { diff --git a/tests/testthat/test-get_category_by_id.R b/tests/testthat/test-get_category_by_id.R index 2b29034e..c010cf7a 100644 --- a/tests/testthat/test-get_category_by_id.R +++ b/tests/testthat/test-get_category_by_id.R @@ -15,7 +15,7 @@ test_that("get_category_by_id retrieves valid category", { test_that("get_category_by_id returns NULL for non-existent category", { # Use a very large ID that likely doesn't exist - result <- get_category_by_id(category_id = 999999, vb = FALSE) + result <- get_category_by_id(category_id = TEST_MISSING_ID, vb = FALSE) expect_null(result) }) @@ -44,7 +44,6 @@ test_that("get_category_by_id rejects invalid category_id", { # Decimal/non-integer expect_error(get_category_by_id(category_id = 1.5)) - expect_error(get_category_by_id(category_id = 2.7)) # NULL expect_error(get_category_by_id(category_id = NULL)) diff --git a/tests/testthat/test-get_funder_by_id.R b/tests/testthat/test-get_funder_by_id.R index 95fe7cd4..09f32339 100644 --- a/tests/testthat/test-get_funder_by_id.R +++ b/tests/testthat/test-get_funder_by_id.R @@ -15,7 +15,7 @@ test_that("get_funder_by_id retrieves valid funder", { test_that("get_funder_by_id returns NULL for non-existent funder", { # Use a very large ID that likely doesn't exist - result <- get_funder_by_id(funder_id = 999999, vb = FALSE) + result <- get_funder_by_id(funder_id = TEST_MISSING_ID, vb = FALSE) expect_null(result) }) @@ -44,7 +44,6 @@ test_that("get_funder_by_id rejects invalid funder_id", { # Decimal/non-integer expect_error(get_funder_by_id(funder_id = 1.5)) - expect_error(get_funder_by_id(funder_id = 2.7)) # NULL expect_error(get_funder_by_id(funder_id = NULL)) diff --git a/tests/testthat/test-get_institution_avatar.R b/tests/testthat/test-get_institution_avatar.R index f04e4684..929b2b0a 100644 --- a/tests/testthat/test-get_institution_avatar.R +++ b/tests/testthat/test-get_institution_avatar.R @@ -30,7 +30,7 @@ test_that("get_institution_avatar saves to file when dest_path is provided", { }) test_that("get_institution_avatar returns NULL for non-existent institution", { - result <- get_institution_avatar(institution_id = 999999, vb = FALSE) + result <- get_institution_avatar(institution_id = TEST_MISSING_ID, vb = FALSE) expect_null(result) }) @@ -68,7 +68,6 @@ test_that("get_institution_avatar rejects invalid institution_id", { # Decimal/non-integer expect_error(get_institution_avatar(institution_id = 1.5)) - expect_error(get_institution_avatar(institution_id = 2.7)) # NULL expect_error(get_institution_avatar(institution_id = NULL)) diff --git a/tests/testthat/test-get_tag_by_id.R b/tests/testthat/test-get_tag_by_id.R index 4008c665..5d4b340b 100644 --- a/tests/testthat/test-get_tag_by_id.R +++ b/tests/testthat/test-get_tag_by_id.R @@ -15,7 +15,7 @@ test_that("get_tag_by_id retrieves valid tag", { test_that("get_tag_by_id returns NULL for non-existent tag", { # Use a very large ID that likely doesn't exist - result <- get_tag_by_id(tag_id = 999999, vb = FALSE) + result <- get_tag_by_id(tag_id = TEST_MISSING_ID, vb = FALSE) expect_null(result) }) @@ -44,7 +44,6 @@ test_that("get_tag_by_id rejects invalid tag_id", { # Decimal/non-integer expect_error(get_tag_by_id(tag_id = 1.5)) - expect_error(get_tag_by_id(tag_id = 2.7)) # NULL expect_error(get_tag_by_id(tag_id = NULL)) diff --git a/tests/testthat/test-get_user_avatar.R b/tests/testthat/test-get_user_avatar.R index 08fe7fe5..90ee6cf3 100644 --- a/tests/testthat/test-get_user_avatar.R +++ b/tests/testthat/test-get_user_avatar.R @@ -50,7 +50,7 @@ test_that("get_user_avatar creates parent directories if needed", { }) test_that("get_user_avatar returns NULL for non-existent user", { - result <- get_user_avatar(user_id = 999999, vb = FALSE) + result <- get_user_avatar(user_id = TEST_MISSING_ID, vb = FALSE) expect_null(result) }) diff --git a/tests/testthat/test-get_volume_collaborator_by_id.R b/tests/testthat/test-get_volume_collaborator_by_id.R index 48f14c3d..0d591920 100644 --- a/tests/testthat/test-get_volume_collaborator_by_id.R +++ b/tests/testthat/test-get_volume_collaborator_by_id.R @@ -29,12 +29,12 @@ test_that("get_volume_collaborator_by_id retrieves valid collaborator", { test_that("get_volume_collaborator_by_id returns NULL for non-existent collaborator", { # Use a very large ID that likely doesn't exist - result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 999999, vb = FALSE) + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = TEST_MISSING_ID, vb = FALSE) expect_null(result) }) test_that("get_volume_collaborator_by_id returns NULL for non-existent volume", { - result <- get_volume_collaborator_by_id(vol_id = 999999, collaborator_id = 1, vb = FALSE) + result <- get_volume_collaborator_by_id(vol_id = TEST_MISSING_ID, collaborator_id = 1, vb = FALSE) expect_null(result) }) @@ -69,7 +69,6 @@ test_that("get_volume_collaborator_by_id rejects invalid vol_id", { # Decimal/non-integer expect_error(get_volume_collaborator_by_id(vol_id = 1.5, collaborator_id = 1)) - expect_error(get_volume_collaborator_by_id(vol_id = 2.7, collaborator_id = 1)) # NULL expect_error(get_volume_collaborator_by_id(vol_id = NULL, collaborator_id = 1)) @@ -95,7 +94,6 @@ test_that("get_volume_collaborator_by_id rejects invalid collaborator_id", { # Decimal/non-integer expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 1.5)) - expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = 2.7)) # NULL expect_error(get_volume_collaborator_by_id(vol_id = 1, collaborator_id = NULL)) diff --git a/tests/testthat/test-get_volume_record_by_id.R b/tests/testthat/test-get_volume_record_by_id.R index 648f2e76..fb8d5476 100644 --- a/tests/testthat/test-get_volume_record_by_id.R +++ b/tests/testthat/test-get_volume_record_by_id.R @@ -1,17 +1,20 @@ # get_volume_record_by_id() -------------------------------------------------- login_test_account() -records_vol_1777 <- list_volume_records(vol_id = 1777, vb = FALSE) +records_test_vol <- list_volume_records(vol_id = TEST_VOL_ID, vb = FALSE) test_that("get_volume_record_by_id retrieves valid record", { - records <- records_vol_1777 - skip_if_null_response(records, "list_volume_records(vol_id = 1777)") + records <- records_test_vol + skip_if_null_response(records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) if (nrow(records) > 0) { test_record_id <- records$record_id[1] - result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id) - skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", test_record_id)) + result <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = test_record_id) + skip_if_null_response( + result, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d)", TEST_VOL_ID, test_record_id) + ) expect_type(result, "list") expect_named(result, c( @@ -28,23 +31,26 @@ test_that("get_volume_record_by_id retrieves valid record", { test_that("get_volume_record_by_id returns NULL for non-existent record", { # Use a very large ID that likely doesn't exist - result <- get_volume_record_by_id(vol_id = 1777, record_id = 999999, vb = FALSE) + result <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = TEST_MISSING_ID, vb = FALSE) expect_null(result) }) test_that("get_volume_record_by_id returns NULL for non-existent volume", { - result <- get_volume_record_by_id(vol_id = 999999, record_id = 1, vb = FALSE) + result <- get_volume_record_by_id(vol_id = TEST_MISSING_ID, record_id = 1, vb = FALSE) expect_null(result) }) test_that("get_volume_record_by_id works with verbose mode", { - records <- records_vol_1777 - skip_if_null_response(records, "list_volume_records(vol_id = 1777)") + records <- records_test_vol + skip_if_null_response(records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) if (nrow(records) > 0) { test_record_id <- records$record_id[1] - result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id, vb = TRUE) - skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d, vb = TRUE)", test_record_id)) + result <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = test_record_id, vb = TRUE) + skip_if_null_response( + result, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d, vb = TRUE)", TEST_VOL_ID, test_record_id) + ) expect_type(result, "list") expect_true(!is.null(result$record_id)) @@ -67,8 +73,7 @@ test_that("get_volume_record_by_id rejects invalid vol_id", { expect_error(get_volume_record_by_id(vol_id = c(1, 2), record_id = 1)) # Decimal/non-integer - expect_error(get_volume_record_by_id(vol_id = 1777.5, record_id = 1)) - expect_error(get_volume_record_by_id(vol_id = 2.7, record_id = 1)) + expect_error(get_volume_record_by_id(vol_id = 1.5, record_id = 1)) # NULL expect_error(get_volume_record_by_id(vol_id = NULL, record_id = 1)) @@ -79,55 +84,57 @@ test_that("get_volume_record_by_id rejects invalid vol_id", { test_that("get_volume_record_by_id rejects invalid record_id", { # Negative ID - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = -1)) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = -1)) # Zero ID - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 0)) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 0)) # Non-numeric ID - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = "1")) - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = TRUE)) - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = list(a = 1))) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = "1")) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = TRUE)) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = list(a = 1))) # Multiple values - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = c(1, 2))) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = c(1, 2))) # Decimal/non-integer - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1.5)) - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 2.7)) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1.5)) # NULL - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = NULL)) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = NULL)) # NA - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = NA)) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = NA)) }) test_that("get_volume_record_by_id rejects invalid vb parameter", { - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, vb = -1)) - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, vb = 3)) - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, vb = "a")) - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, vb = list(a = 1, b = 2))) - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, vb = c(TRUE, FALSE))) - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, vb = NULL)) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = -1)) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = 3)) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = "a")) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = list(a = 1, b = 2))) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, vb = NULL)) }) test_that("get_volume_record_by_id rejects invalid rq parameter", { - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, rq = "a")) - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, rq = -1)) - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, rq = c(2, 3))) - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, rq = list(a = 1, b = 2))) - expect_error(get_volume_record_by_id(vol_id = 1777, record_id = 1, rq = TRUE)) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, rq = "a")) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, rq = -1)) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, rq = c(2, 3))) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, rq = list(a = 1, b = 2))) + expect_error(get_volume_record_by_id(vol_id = 1, record_id = 1, rq = TRUE)) }) test_that("get_volume_record_by_id result structure is consistent", { - records <- records_vol_1777 - skip_if_null_response(records, "list_volume_records(vol_id = 1777)") + records <- records_test_vol + skip_if_null_response(records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) if (nrow(records) > 0) { test_record_id <- records$record_id[1] - result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id) - skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", test_record_id)) + result <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = test_record_id) + skip_if_null_response( + result, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d)", TEST_VOL_ID, test_record_id) + ) # Check that all expected fields exist expect_true(all(c( @@ -153,16 +160,19 @@ test_that("get_volume_record_by_id result structure is consistent", { }) test_that("get_volume_record_by_id handles age structure correctly", { - records <- records_vol_1777 - skip_if_null_response(records, "list_volume_records(vol_id = 1777)") + records <- records_test_vol + skip_if_null_response(records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) if (nrow(records) == 0) { testthat::skip("No records on volume; cannot validate age structure") } test_record_id <- records$record_id[1] - result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id) - skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", test_record_id)) + result <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = test_record_id) + skip_if_null_response( + result, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d)", TEST_VOL_ID, test_record_id) + ) if (is.null(result$age)) { expect_null(result$age) @@ -174,13 +184,16 @@ test_that("get_volume_record_by_id handles age structure correctly", { }) test_that("get_volume_record_by_id handles measures correctly", { - records <- records_vol_1777 - skip_if_null_response(records, "list_volume_records(vol_id = 1777)") + records <- records_test_vol + skip_if_null_response(records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) if (nrow(records) > 0) { test_record_id <- records$record_id[1] - result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id) - skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", test_record_id)) + result <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = test_record_id) + skip_if_null_response( + result, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d)", TEST_VOL_ID, test_record_id) + ) # Measures should be a list (can be empty) expect_true(is.list(result$measures) || is.null(result$measures)) @@ -188,14 +201,17 @@ test_that("get_volume_record_by_id handles measures correctly", { }) test_that("get_volume_record_by_id works with custom request object", { - records <- records_vol_1777 - skip_if_null_response(records, "list_volume_records(vol_id = 1777)") + records <- records_test_vol + skip_if_null_response(records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) if (nrow(records) > 0) { test_record_id <- records$record_id[1] custom_rq <- databraryr::make_default_request() - result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id, rq = custom_rq) - skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d, rq = custom_rq)", test_record_id)) + result <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = test_record_id, rq = custom_rq) + skip_if_null_response( + result, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d, rq = custom_rq)", TEST_VOL_ID, test_record_id) + ) expect_type(result, "list") expect_equal(result$record_id, test_record_id) @@ -203,8 +219,8 @@ test_that("get_volume_record_by_id works with custom request object", { }) test_that("get_volume_record_by_id can retrieve multiple different records", { - records <- records_vol_1777 - skip_if_null_response(records, "list_volume_records(vol_id = 1777)") + records <- records_test_vol + skip_if_null_response(records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) unique_ids <- unique(records$record_id) if (length(unique_ids) < 2) { @@ -214,11 +230,17 @@ test_that("get_volume_record_by_id can retrieve multiple different records", { record_id_1 <- unique_ids[1] record_id_2 <- unique_ids[2] - result1 <- get_volume_record_by_id(vol_id = 1777, record_id = record_id_1, vb = FALSE) - result2 <- get_volume_record_by_id(vol_id = 1777, record_id = record_id_2, vb = FALSE) + result1 <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = record_id_1, vb = FALSE) + result2 <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = record_id_2, vb = FALSE) - skip_if_null_response(result1, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", record_id_1)) - skip_if_null_response(result2, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", record_id_2)) + skip_if_null_response( + result1, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d)", TEST_VOL_ID, record_id_1) + ) + skip_if_null_response( + result2, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d)", TEST_VOL_ID, record_id_2) + ) expect_false(identical(result1$record_id, result2$record_id)) expect_equal(as.integer(result1$record_id), as.integer(record_id_1)) @@ -226,13 +248,16 @@ test_that("get_volume_record_by_id can retrieve multiple different records", { }) test_that("get_volume_record_by_id returns complete structure with all fields", { - records <- records_vol_1777 - skip_if_null_response(records, "list_volume_records(vol_id = 1777)") + records <- records_test_vol + skip_if_null_response(records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) if (nrow(records) > 0) { test_record_id <- records$record_id[1] - result <- get_volume_record_by_id(vol_id = 1777, record_id = test_record_id) - skip_if_null_response(result, sprintf("get_volume_record_by_id(vol_id = 1777, record_id = %d)", test_record_id)) + result <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = test_record_id) + skip_if_null_response( + result, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d)", TEST_VOL_ID, test_record_id) + ) # Record should have all expected fields (parity with RecordSerializer read-only output) expect_length(result, 9) diff --git a/tests/testthat/test-initiate_upload.R b/tests/testthat/test-initiate_upload.R index ef3d5e26..fe06db29 100644 --- a/tests/testthat/test-initiate_upload.R +++ b/tests/testthat/test-initiate_upload.R @@ -99,7 +99,7 @@ test_that("initiate_upload returns NULL for nonexistent destination", { expect_null(initiate_upload( filename = "test.mp4", destination_type = "session", - object_id = 999999999, + object_id = TEST_MISSING_ID, file_size = 1024L, vb = FALSE )) diff --git a/tests/testthat/test-list_volume_records.R b/tests/testthat/test-list_volume_records.R index 3f65df54..49ee7d77 100644 --- a/tests/testthat/test-list_volume_records.R +++ b/tests/testthat/test-list_volume_records.R @@ -1,11 +1,11 @@ # list_volume_records --------------------------------------------------------- login_test_account() -records_1777 <- list_volume_records(vol_id = 1777, vb = FALSE) +records_test_vol <- list_volume_records(vol_id = TEST_VOL_ID, vb = FALSE) test_that("list_volume_records returns tibble given valid vol_id", { - result <- records_1777 - skip_if_null_response(result, "list_volume_records(vol_id = 1777)") + result <- records_test_vol + skip_if_null_response(result, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) expect_s3_class(result, "tbl_df") expect_gt(nrow(result), 0) @@ -16,8 +16,8 @@ test_that("list_volume_records returns tibble given valid vol_id", { }) test_that("list_volume_records returns valid record structure", { - result <- records_1777 - skip_if_null_response(result, "list_volume_records(vol_id = 1777)") + result <- records_test_vol + skip_if_null_response(result, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) # Check column types expect_true(is.numeric(result$record_id) || is.integer(result$record_id)) @@ -35,21 +35,24 @@ test_that("list_volume_records returns valid record structure", { }) test_that("list_volume_records returns NULL for non-existent volume", { - result <- list_volume_records(vol_id = 999999, vb = FALSE) + result <- list_volume_records(vol_id = TEST_MISSING_ID, vb = FALSE) expect_null(result) }) test_that("list_volume_records works with category_id filter", { - all_records <- records_1777 - skip_if_null_response(all_records, "list_volume_records(vol_id = 1777)") + all_records <- records_test_vol + skip_if_null_response(all_records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) if (nrow(all_records) > 0) { # Get unique category_id from results test_category <- all_records$record_category_id[1] # Filter by that category - filtered_records <- list_volume_records(vol_id = 1777, category_id = test_category, vb = FALSE) - skip_if_null_response(filtered_records, sprintf("list_volume_records(vol_id = 1777, category_id = %d)", test_category)) + filtered_records <- list_volume_records(vol_id = TEST_VOL_ID, category_id = test_category, vb = FALSE) + skip_if_null_response( + filtered_records, + sprintf("list_volume_records(vol_id = %d, category_id = %d)", TEST_VOL_ID, test_category) + ) # All records should have the specified category_id expect_true(all(filtered_records$record_category_id == test_category)) @@ -57,8 +60,8 @@ test_that("list_volume_records works with category_id filter", { }) test_that("list_volume_records works with verbose mode", { - result <- list_volume_records(vol_id = 1777, vb = TRUE) - skip_if_null_response(result, "list_volume_records(vol_id = 1777, vb = TRUE)") + result <- list_volume_records(vol_id = TEST_VOL_ID, vb = TRUE) + skip_if_null_response(result, sprintf("list_volume_records(vol_id = %d, vb = TRUE)", TEST_VOL_ID)) expect_s3_class(result, "tbl_df") expect_gt(nrow(result), 0) @@ -80,47 +83,47 @@ test_that("list_volume_records rejects invalid vol_id", { expect_error(list_volume_records(vol_id = c(1, 2))) # Decimal/non-integer - expect_error(list_volume_records(vol_id = 1777.5)) + expect_error(list_volume_records(vol_id = 1.5)) }) test_that("list_volume_records rejects invalid category_id", { # Negative ID - expect_error(list_volume_records(vol_id = 1777, category_id = -1)) + expect_error(list_volume_records(vol_id = 1, category_id = -1)) # Zero ID - expect_error(list_volume_records(vol_id = 1777, category_id = 0)) + expect_error(list_volume_records(vol_id = 1, category_id = 0)) # Non-numeric ID - expect_error(list_volume_records(vol_id = 1777, category_id = "1")) - expect_error(list_volume_records(vol_id = 1777, category_id = TRUE)) + expect_error(list_volume_records(vol_id = 1, category_id = "1")) + expect_error(list_volume_records(vol_id = 1, category_id = TRUE)) # Multiple values - expect_error(list_volume_records(vol_id = 1777, category_id = c(1, 2))) + expect_error(list_volume_records(vol_id = 1, category_id = c(1, 2))) # Decimal/non-integer - expect_error(list_volume_records(vol_id = 1777, category_id = 1.5)) + expect_error(list_volume_records(vol_id = 1, category_id = 1.5)) }) test_that("list_volume_records rejects invalid vb parameter", { - expect_error(list_volume_records(vol_id = 1777, vb = -1)) - expect_error(list_volume_records(vol_id = 1777, vb = 3)) - expect_error(list_volume_records(vol_id = 1777, vb = "a")) - expect_error(list_volume_records(vol_id = 1777, vb = list(a = 1, b = 2))) - expect_error(list_volume_records(vol_id = 1777, vb = c(TRUE, FALSE))) - expect_error(list_volume_records(vol_id = 1777, vb = NULL)) + expect_error(list_volume_records(vol_id = 1, vb = -1)) + expect_error(list_volume_records(vol_id = 1, vb = 3)) + expect_error(list_volume_records(vol_id = 1, vb = "a")) + expect_error(list_volume_records(vol_id = 1, vb = list(a = 1, b = 2))) + expect_error(list_volume_records(vol_id = 1, vb = c(TRUE, FALSE))) + expect_error(list_volume_records(vol_id = 1, vb = NULL)) }) test_that("list_volume_records rejects invalid rq parameter", { - expect_error(list_volume_records(vol_id = 1777, rq = "a")) - expect_error(list_volume_records(vol_id = 1777, rq = -1)) - expect_error(list_volume_records(vol_id = 1777, rq = c(2, 3))) - expect_error(list_volume_records(vol_id = 1777, rq = list(a = 1, b = 2))) - expect_error(list_volume_records(vol_id = 1777, rq = TRUE)) + expect_error(list_volume_records(vol_id = 1, rq = "a")) + expect_error(list_volume_records(vol_id = 1, rq = -1)) + expect_error(list_volume_records(vol_id = 1, rq = c(2, 3))) + expect_error(list_volume_records(vol_id = 1, rq = list(a = 1, b = 2))) + expect_error(list_volume_records(vol_id = 1, rq = TRUE)) }) test_that("list_volume_records includes age fields", { - result <- records_1777 - skip_if_null_response(result, "list_volume_records(vol_id = 1777)") + result <- records_test_vol + skip_if_null_response(result, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) # Check that age fields exist age_fields <- c("age_years", "age_months", "age_days", "age_total_days", @@ -129,8 +132,8 @@ test_that("list_volume_records includes age fields", { }) test_that("list_volume_records includes measures as list column", { - result <- records_1777 - skip_if_null_response(result, "list_volume_records(vol_id = 1777)") + result <- records_test_vol + skip_if_null_response(result, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) # Check that measures column is a list expect_true("record_measures" %in% names(result)) @@ -139,16 +142,16 @@ test_that("list_volume_records includes measures as list column", { test_that("list_volume_records works with custom request object", { custom_rq <- databraryr::make_default_request() - result <- list_volume_records(vol_id = 1777, rq = custom_rq) - skip_if_null_response(result, "list_volume_records(vol_id = 1777, rq = custom_rq)") + result <- list_volume_records(vol_id = TEST_VOL_ID, rq = custom_rq) + skip_if_null_response(result, sprintf("list_volume_records(vol_id = %d, rq = custom_rq)", TEST_VOL_ID)) expect_s3_class(result, "tbl_df") expect_gt(nrow(result), 0) }) test_that("list_volume_records returns for different volumes", { - result1 <- records_1777 - skip_if_null_response(result1, "list_volume_records(vol_id = 1777)") + result1 <- records_test_vol + skip_if_null_response(result1, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) result2 <- list_volume_records(vol_id = 2, vb = FALSE) skip_if_null_response(result2, "list_volume_records(vol_id = 2)") diff --git a/tests/testthat/test-patch_folder.R b/tests/testthat/test-patch_folder.R index b39c958a..2f8fc42f 100644 --- a/tests/testthat/test-patch_folder.R +++ b/tests/testthat/test-patch_folder.R @@ -39,7 +39,7 @@ test_that("patch_folder returns NULL when no fields provided", { test_that("patch_folder returns NULL for non-existent folder", { result <- patch_folder( vol_id = TEST_VOL_ID, - folder_id = 999999999, + folder_id = TEST_MISSING_ID, name = "nope", vb = FALSE ) @@ -77,22 +77,22 @@ test_that("patch_folder works with custom request object", { }) test_that("patch_folder rejects invalid name", { - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "")) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = " ")) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = 123)) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = c("A", "B"))) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = "")) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = " ")) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = 123)) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = c("A", "B"))) }) test_that("patch_folder rejects malformed source_date", { - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, source_date = "not-a-date")) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, source_date = "")) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, source_date = 123)) + expect_error(patch_folder(vol_id = 1, folder_id = 1, source_date = "not-a-date")) + expect_error(patch_folder(vol_id = 1, folder_id = 1, source_date = "")) + expect_error(patch_folder(vol_id = 1, folder_id = 1, source_date = 123)) }) test_that("patch_folder rejects invalid release_level", { - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, release_level = "")) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, release_level = 1)) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, release_level = c("A", "B"))) + expect_error(patch_folder(vol_id = 1, folder_id = 1, release_level = "")) + expect_error(patch_folder(vol_id = 1, folder_id = 1, release_level = 1)) + expect_error(patch_folder(vol_id = 1, folder_id = 1, release_level = c("A", "B"))) }) test_that("patch_folder rejects invalid vol_id", { @@ -105,23 +105,23 @@ test_that("patch_folder rejects invalid vol_id", { }) test_that("patch_folder rejects invalid folder_id", { - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = -1, name = "x")) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 0, name = "x")) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = "1", name = "x")) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = TRUE, name = "x")) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = c(1, 2), name = "x")) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1.5, name = "x")) + expect_error(patch_folder(vol_id = 1, folder_id = -1, name = "x")) + expect_error(patch_folder(vol_id = 1, folder_id = 0, name = "x")) + expect_error(patch_folder(vol_id = 1, folder_id = "1", name = "x")) + expect_error(patch_folder(vol_id = 1, folder_id = TRUE, name = "x")) + expect_error(patch_folder(vol_id = 1, folder_id = c(1, 2), name = "x")) + expect_error(patch_folder(vol_id = 1, folder_id = 1.5, name = "x")) }) test_that("patch_folder rejects invalid vb parameter", { - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", vb = -1)) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", vb = "a")) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", vb = c(TRUE, FALSE))) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", vb = NULL)) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = "x", vb = -1)) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = "x", vb = "a")) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = "x", vb = NULL)) }) test_that("patch_folder rejects invalid rq parameter", { - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", rq = "a")) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", rq = -1)) - expect_error(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", rq = TRUE)) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = "x", rq = "a")) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = "x", rq = -1)) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = "x", rq = TRUE)) }) diff --git a/tests/testthat/test-patch_session.R b/tests/testthat/test-patch_session.R index d42fe52d..189d4a72 100644 --- a/tests/testthat/test-patch_session.R +++ b/tests/testthat/test-patch_session.R @@ -39,7 +39,7 @@ test_that("patch_session returns NULL when no fields provided", { test_that("patch_session returns NULL for non-existent session", { result <- patch_session( vol_id = TEST_VOL_ID, - session_id = 999999999, + session_id = TEST_MISSING_ID, name = "nope", vb = FALSE ) @@ -77,16 +77,16 @@ test_that("patch_session works with custom request object", { }) test_that("patch_session rejects invalid name", { - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = "")) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = " ")) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = 123)) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = c("A", "B"))) + expect_error(patch_session(vol_id = 1, session_id = 1, name = "")) + expect_error(patch_session(vol_id = 1, session_id = 1, name = " ")) + expect_error(patch_session(vol_id = 1, session_id = 1, name = 123)) + expect_error(patch_session(vol_id = 1, session_id = 1, name = c("A", "B"))) }) test_that("patch_session rejects providing both source_date and date", { expect_error( patch_session( - vol_id = TEST_VOL_ID, + vol_id = 1, session_id = 1, source_date = "2024-03-15", date = list(year = 2024, month = 3, day = 15) @@ -95,33 +95,33 @@ test_that("patch_session rejects providing both source_date and date", { }) test_that("patch_session rejects malformed source_date", { - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, source_date = "not-a-date")) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, source_date = "")) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, source_date = 123)) + expect_error(patch_session(vol_id = 1, session_id = 1, source_date = "not-a-date")) + expect_error(patch_session(vol_id = 1, session_id = 1, source_date = "")) + expect_error(patch_session(vol_id = 1, session_id = 1, source_date = 123)) }) test_that("patch_session rejects malformed date", { - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, date = "2024-03-15")) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, date = list(2024, 3, 15))) + expect_error(patch_session(vol_id = 1, session_id = 1, date = "2024-03-15")) + expect_error(patch_session(vol_id = 1, session_id = 1, date = list(2024, 3, 15))) }) test_that("patch_session rejects invalid release_level", { - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, release_level = "")) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, release_level = 1)) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, release_level = c("A", "B"))) + expect_error(patch_session(vol_id = 1, session_id = 1, release_level = "")) + expect_error(patch_session(vol_id = 1, session_id = 1, release_level = 1)) + expect_error(patch_session(vol_id = 1, session_id = 1, release_level = c("A", "B"))) }) test_that("patch_session rejects invalid date_precision", { - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, date_precision = "")) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, date_precision = 1)) + expect_error(patch_session(vol_id = 1, session_id = 1, date_precision = "")) + expect_error(patch_session(vol_id = 1, session_id = 1, date_precision = 1)) }) test_that("patch_session rejects invalid default_records", { - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, default_records = "1")) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, default_records = c(1, -2))) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, default_records = c(1, 0))) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, default_records = c(1.5, 2))) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, default_records = integer(0))) + expect_error(patch_session(vol_id = 1, session_id = 1, default_records = "1")) + expect_error(patch_session(vol_id = 1, session_id = 1, default_records = c(1, -2))) + expect_error(patch_session(vol_id = 1, session_id = 1, default_records = c(1, 0))) + expect_error(patch_session(vol_id = 1, session_id = 1, default_records = c(1.5, 2))) + expect_error(patch_session(vol_id = 1, session_id = 1, default_records = integer(0))) }) test_that("patch_session rejects invalid vol_id", { @@ -134,23 +134,23 @@ test_that("patch_session rejects invalid vol_id", { }) test_that("patch_session rejects invalid session_id", { - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = -1, name = "x")) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 0, name = "x")) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = "1", name = "x")) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = TRUE, name = "x")) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = c(1, 2), name = "x")) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1.5, name = "x")) + expect_error(patch_session(vol_id = 1, session_id = -1, name = "x")) + expect_error(patch_session(vol_id = 1, session_id = 0, name = "x")) + expect_error(patch_session(vol_id = 1, session_id = "1", name = "x")) + expect_error(patch_session(vol_id = 1, session_id = TRUE, name = "x")) + expect_error(patch_session(vol_id = 1, session_id = c(1, 2), name = "x")) + expect_error(patch_session(vol_id = 1, session_id = 1.5, name = "x")) }) test_that("patch_session rejects invalid vb parameter", { - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", vb = -1)) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", vb = "a")) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", vb = c(TRUE, FALSE))) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", vb = NULL)) + expect_error(patch_session(vol_id = 1, session_id = 1, name = "x", vb = -1)) + expect_error(patch_session(vol_id = 1, session_id = 1, name = "x", vb = "a")) + expect_error(patch_session(vol_id = 1, session_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(patch_session(vol_id = 1, session_id = 1, name = "x", vb = NULL)) }) test_that("patch_session rejects invalid rq parameter", { - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", rq = "a")) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", rq = -1)) - expect_error(patch_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", rq = TRUE)) + expect_error(patch_session(vol_id = 1, session_id = 1, name = "x", rq = "a")) + expect_error(patch_session(vol_id = 1, session_id = 1, name = "x", rq = -1)) + expect_error(patch_session(vol_id = 1, session_id = 1, name = "x", rq = TRUE)) }) diff --git a/tests/testthat/test-patch_session_file.R b/tests/testthat/test-patch_session_file.R index 9dd94690..f08d85c6 100644 --- a/tests/testthat/test-patch_session_file.R +++ b/tests/testthat/test-patch_session_file.R @@ -15,8 +15,8 @@ test_that("patch_session_file returns NULL when no fields provided", { test_that("patch_session_file returns NULL for non-existent file", { result <- patch_session_file( vol_id = TEST_VOL_ID, - session_id = 999999999, - file_id = 999999999, + session_id = TEST_MISSING_ID, + file_id = TEST_MISSING_ID, name = "nope", vb = FALSE ) @@ -24,17 +24,17 @@ test_that("patch_session_file returns NULL for non-existent file", { }) test_that("patch_session_file rejects invalid name", { - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = " ")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = 123)) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = c("A", "B"))) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = NA)) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = " ")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = 123)) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = c("A", "B"))) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = NA)) }) test_that("patch_session_file rejects providing both source_date and date", { expect_error( patch_session_file( - vol_id = TEST_VOL_ID, + vol_id = 1, session_id = 1, file_id = 1, source_date = "2024-03-15", @@ -44,30 +44,30 @@ test_that("patch_session_file rejects providing both source_date and date", { }) test_that("patch_session_file rejects malformed source_date", { - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, source_date = "not-a-date")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, source_date = "")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, source_date = 123)) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, source_date = "not-a-date")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, source_date = "")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, source_date = 123)) }) test_that("patch_session_file rejects malformed date", { - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, date = "2024-03-15")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, date = list(2024, 3, 15))) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, date = "2024-03-15")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, date = list(2024, 3, 15))) }) test_that("patch_session_file rejects invalid release_level", { - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, release_level = "")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, release_level = 1)) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, release_level = "")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, release_level = 1)) }) test_that("patch_session_file rejects invalid date_precision", { - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, date_precision = "")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, date_precision = 1)) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, date_precision = "")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, date_precision = 1)) }) test_that("patch_session_file rejects invalid is_estimated", { - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, is_estimated = "yes")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, is_estimated = c(TRUE, FALSE))) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, is_estimated = 1)) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, is_estimated = "yes")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, is_estimated = c(TRUE, FALSE))) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, is_estimated = 1)) }) test_that("patch_session_file rejects invalid vol_id", { @@ -80,32 +80,32 @@ test_that("patch_session_file rejects invalid vol_id", { }) test_that("patch_session_file rejects invalid session_id", { - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = -1, file_id = 1, name = "x")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 0, file_id = 1, name = "x")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = "1", file_id = 1, name = "x")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = TRUE, file_id = 1, name = "x")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = c(1, 2), file_id = 1, name = "x")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1.5, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = -1, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = 0, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = "1", file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = TRUE, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = c(1, 2), file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = 1.5, file_id = 1, name = "x")) }) test_that("patch_session_file rejects invalid file_id", { - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = -1, name = "x")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 0, name = "x")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = "1", name = "x")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = TRUE, name = "x")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = c(1, 2), name = "x")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1.5, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = -1, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 0, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = "1", name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = TRUE, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = c(1, 2), name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1.5, name = "x")) }) test_that("patch_session_file rejects invalid vb parameter", { - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", vb = -1)) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", vb = "a")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", vb = c(TRUE, FALSE))) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", vb = NULL)) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", vb = -1)) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", vb = "a")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", vb = NULL)) }) test_that("patch_session_file rejects invalid rq parameter", { - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", rq = "a")) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", rq = -1)) - expect_error(patch_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", rq = TRUE)) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", rq = "a")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", rq = -1)) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", rq = TRUE)) }) diff --git a/tests/testthat/test-remove_default_record_from_session.R b/tests/testthat/test-remove_default_record_from_session.R index 363189c3..9d000e17 100644 --- a/tests/testthat/test-remove_default_record_from_session.R +++ b/tests/testthat/test-remove_default_record_from_session.R @@ -83,7 +83,7 @@ test_that("remove_default_record_from_session returns FALSE for non-existent rec remove_default_record_from_session( vol_id = TEST_VOL_ID, session_id = sid, - record_id = 999999999, + record_id = TEST_MISSING_ID, vb = FALSE ) ) @@ -97,7 +97,7 @@ test_that("remove_default_record_from_session returns FALSE for non-existent ses expect_false( remove_default_record_from_session( vol_id = TEST_VOL_ID, - session_id = 999999999, + session_id = TEST_MISSING_ID, record_id = rid, vb = FALSE ) diff --git a/tests/testthat/test-session_record_lifecycle.R b/tests/testthat/test-session_record_lifecycle.R index c8b53b35..44125203 100644 --- a/tests/testthat/test-session_record_lifecycle.R +++ b/tests/testthat/test-session_record_lifecycle.R @@ -17,11 +17,11 @@ test_that("full session and record lifecycle roundtrip", { rid <- make_test_record("session_record lifecycle record") skip_if_null_response(rid, "create_volume_record for lifecycle") - # Optional metric 30 on category 6 in sandbox volume 1777 (see create_volume_record tests). + # Optional metric TEST_METRIC_ID_EXTRA on TEST_CATEGORY_ID / TEST_VOL_ID (see create_volume_record tests). measure_result <- set_record_measure( vol_id = TEST_VOL_ID, record_id = rid, - metric_id = 30L, + metric_id = TEST_METRIC_ID_EXTRA, value = "Lifecycle measure value", vb = FALSE ) diff --git a/tests/testthat/test-set_record_measure.R b/tests/testthat/test-set_record_measure.R index b841a15a..d4aad3fe 100644 --- a/tests/testthat/test-set_record_measure.R +++ b/tests/testthat/test-set_record_measure.R @@ -8,7 +8,7 @@ test_that("set_record_measure sets a text measure", { measure_result <- set_record_measure( vol_id = TEST_VOL_ID, record_id = record_id, - metric_id = 29, + metric_id = TEST_METRIC_ID, value = "Test value", vb = FALSE ) @@ -25,7 +25,7 @@ test_that("set_record_measure updates an existing measure", { measure_result <- set_record_measure( vol_id = TEST_VOL_ID, record_id = record_id, - metric_id = 29, + metric_id = TEST_METRIC_ID, value = "Updated", vb = FALSE ) @@ -38,8 +38,8 @@ test_that("set_record_measure updates an existing measure", { test_that("set_record_measure returns NULL for non-existent record", { result <- set_record_measure( vol_id = TEST_VOL_ID, - record_id = 999999, - metric_id = 29, + record_id = TEST_MISSING_ID, + metric_id = TEST_METRIC_ID, value = "Test", vb = FALSE ) @@ -53,7 +53,7 @@ test_that("set_record_measure works with verbose mode", { measure_result <- set_record_measure( vol_id = TEST_VOL_ID, record_id = record_id, - metric_id = 29, + metric_id = TEST_METRIC_ID, value = "Test", vb = TRUE ) @@ -64,44 +64,44 @@ test_that("set_record_measure works with verbose mode", { }) test_that("set_record_measure rejects invalid vol_id", { - expect_error(set_record_measure(vol_id = -1, record_id = 1, metric_id = 29, value = "test")) - expect_error(set_record_measure(vol_id = 0, record_id = 1, metric_id = 29, value = "test")) - expect_error(set_record_measure(vol_id = "1", record_id = 1, metric_id = 29, value = "test")) - expect_error(set_record_measure(vol_id = TRUE, record_id = 1, metric_id = 29, value = "test")) - expect_error(set_record_measure(vol_id = c(1, 2), record_id = 1, metric_id = 29, value = "test")) - expect_error(set_record_measure(vol_id = 1777.5, record_id = 1, metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = -1, record_id = 1, metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = 0, record_id = 1, metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = "1", record_id = 1, metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = TRUE, record_id = 1, metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = c(1, 2), record_id = 1, metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = 1.5, record_id = 1, metric_id = 1, value = "test")) }) test_that("set_record_measure rejects invalid record_id", { - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = -1, metric_id = 29, value = "test")) - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 0, metric_id = 29, value = "test")) - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = "1", metric_id = 29, value = "test")) - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = TRUE, metric_id = 29, value = "test")) - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = c(1, 2), metric_id = 29, value = "test")) - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1.5, metric_id = 29, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = -1, metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = 0, metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = "1", metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = TRUE, metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = c(1, 2), metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = 1.5, metric_id = 1, value = "test")) }) test_that("set_record_measure rejects invalid metric_id", { - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = -1, value = "test")) - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 0, value = "test")) - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = "1", value = "test")) - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = TRUE, value = "test")) - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = c(1, 2), value = "test")) - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 1.5, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = -1, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 0, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = "1", value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = TRUE, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = c(1, 2), value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1.5, value = "test")) }) test_that("set_record_measure rejects invalid vb parameter", { - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, value = "test", vb = -1)) - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, value = "test", vb = 3)) - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, value = "test", vb = "a")) - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, value = "test", vb = c(TRUE, FALSE))) - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, value = "test", vb = NULL)) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1, value = "test", vb = -1)) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1, value = "test", vb = 3)) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1, value = "test", vb = "a")) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1, value = "test", vb = c(TRUE, FALSE))) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1, value = "test", vb = NULL)) }) test_that("set_record_measure rejects invalid rq parameter", { - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, value = "test", rq = "a")) - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, value = "test", rq = -1)) - expect_error(set_record_measure(vol_id = TEST_VOL_ID, record_id = 1, metric_id = 29, value = "test", rq = TRUE)) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1, value = "test", rq = "a")) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1, value = "test", rq = -1)) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1, value = "test", rq = TRUE)) }) test_that("set_record_measure works with numeric values", { @@ -111,7 +111,7 @@ test_that("set_record_measure works with numeric values", { measure_result <- set_record_measure( vol_id = TEST_VOL_ID, record_id = record_id, - metric_id = 29, + metric_id = TEST_METRIC_ID, value = 42.5, vb = FALSE ) diff --git a/tests/testthat/test-unassign_record_from_file.R b/tests/testthat/test-unassign_record_from_file.R index 4838aadf..1c577742 100644 --- a/tests/testthat/test-unassign_record_from_file.R +++ b/tests/testthat/test-unassign_record_from_file.R @@ -152,46 +152,46 @@ test_that("unassign_record_from_file rejects invalid vol_id", { expect_error(unassign_record_from_file(vol_id = "1", session_id = 1, file_id = 1, record_id = 1)) expect_error(unassign_record_from_file(vol_id = TRUE, session_id = 1, file_id = 1, record_id = 1)) expect_error(unassign_record_from_file(vol_id = c(1, 2), session_id = 1, file_id = 1, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = 1777.5, session_id = 1, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1.5, session_id = 1, file_id = 1, record_id = 1)) }) test_that("unassign_record_from_file rejects invalid session_id", { - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = -1, file_id = 1, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 0, file_id = 1, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = "1", file_id = 1, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = TRUE, file_id = 1, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = c(1, 2), file_id = 1, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1.5, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = -1, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 0, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = "1", file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = TRUE, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = c(1, 2), file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1.5, file_id = 1, record_id = 1)) }) test_that("unassign_record_from_file rejects invalid file_id", { - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = -1, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 0, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = "1", record_id = 1)) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = TRUE, record_id = 1)) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = c(1, 2), record_id = 1)) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1.5, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = -1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 0, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = "1", record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = TRUE, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = c(1, 2), record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1.5, record_id = 1)) }) test_that("unassign_record_from_file rejects invalid record_id", { - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = -1)) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 0)) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = "1")) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = TRUE)) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = c(1, 2))) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1.5)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = -1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 0)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = "1")) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = TRUE)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = c(1, 2))) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1.5)) }) test_that("unassign_record_from_file rejects invalid vb parameter", { - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = -1)) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = 3)) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = "a")) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = c(TRUE, FALSE))) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, vb = NULL)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = -1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = 3)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = "a")) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = NULL)) }) test_that("unassign_record_from_file rejects invalid rq parameter", { - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, rq = "a")) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, rq = -1)) - expect_error(unassign_record_from_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, record_id = 1, rq = TRUE)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, rq = "a")) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, rq = -1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, rq = TRUE)) }) diff --git a/tests/testthat/test-update_folder.R b/tests/testthat/test-update_folder.R index 0cbcb206..51eca4bf 100644 --- a/tests/testthat/test-update_folder.R +++ b/tests/testthat/test-update_folder.R @@ -36,7 +36,7 @@ test_that("update_folder replaces source_date with a Date object", { test_that("update_folder returns NULL for non-existent folder", { result <- update_folder( vol_id = TEST_VOL_ID, - folder_id = 999999999, + folder_id = TEST_MISSING_ID, name = "nope", vb = FALSE ) @@ -74,24 +74,24 @@ test_that("update_folder works with custom request object", { }) test_that("update_folder rejects missing/invalid name", { - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1)) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "")) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = " ")) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = 123)) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = c("A", "B"))) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = NULL)) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = NA)) + expect_error(update_folder(vol_id = 1, folder_id = 1)) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "")) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = " ")) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = 123)) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = c("A", "B"))) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = NULL)) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = NA)) }) test_that("update_folder rejects malformed source_date", { - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", source_date = "not-a-date")) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", source_date = "")) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", source_date = 123)) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", source_date = "not-a-date")) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", source_date = "")) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", source_date = 123)) }) test_that("update_folder rejects invalid release_level", { - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", release_level = "")) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", release_level = 1)) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", release_level = "")) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", release_level = 1)) }) test_that("update_folder rejects invalid vol_id", { @@ -104,23 +104,23 @@ test_that("update_folder rejects invalid vol_id", { }) test_that("update_folder rejects invalid folder_id", { - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = -1, name = "x")) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 0, name = "x")) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = "1", name = "x")) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = TRUE, name = "x")) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = c(1, 2), name = "x")) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1.5, name = "x")) + expect_error(update_folder(vol_id = 1, folder_id = -1, name = "x")) + expect_error(update_folder(vol_id = 1, folder_id = 0, name = "x")) + expect_error(update_folder(vol_id = 1, folder_id = "1", name = "x")) + expect_error(update_folder(vol_id = 1, folder_id = TRUE, name = "x")) + expect_error(update_folder(vol_id = 1, folder_id = c(1, 2), name = "x")) + expect_error(update_folder(vol_id = 1, folder_id = 1.5, name = "x")) }) test_that("update_folder rejects invalid vb parameter", { - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", vb = -1)) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", vb = "a")) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", vb = c(TRUE, FALSE))) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", vb = NULL)) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", vb = -1)) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", vb = "a")) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", vb = NULL)) }) test_that("update_folder rejects invalid rq parameter", { - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", rq = "a")) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", rq = -1)) - expect_error(update_folder(vol_id = TEST_VOL_ID, folder_id = 1, name = "x", rq = TRUE)) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", rq = "a")) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", rq = -1)) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", rq = TRUE)) }) diff --git a/tests/testthat/test-update_session.R b/tests/testthat/test-update_session.R index f92cb462..d4818c49 100644 --- a/tests/testthat/test-update_session.R +++ b/tests/testthat/test-update_session.R @@ -36,7 +36,7 @@ test_that("update_session replaces source_date with a Date object", { test_that("update_session returns NULL for non-existent session", { result <- update_session( vol_id = TEST_VOL_ID, - session_id = 999999999, + session_id = TEST_MISSING_ID, name = "nope", vb = FALSE ) @@ -74,19 +74,19 @@ test_that("update_session works with custom request object", { }) test_that("update_session rejects missing/invalid name", { - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1)) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "")) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = " ")) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = 123)) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = c("A", "B"))) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = NULL)) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = NA)) + expect_error(update_session(vol_id = 1, session_id = 1)) + expect_error(update_session(vol_id = 1, session_id = 1, name = "")) + expect_error(update_session(vol_id = 1, session_id = 1, name = " ")) + expect_error(update_session(vol_id = 1, session_id = 1, name = 123)) + expect_error(update_session(vol_id = 1, session_id = 1, name = c("A", "B"))) + expect_error(update_session(vol_id = 1, session_id = 1, name = NULL)) + expect_error(update_session(vol_id = 1, session_id = 1, name = NA)) }) test_that("update_session rejects providing both source_date and date", { expect_error( update_session( - vol_id = TEST_VOL_ID, + vol_id = 1, session_id = 1, name = "x", source_date = "2024-03-15", @@ -96,32 +96,32 @@ test_that("update_session rejects providing both source_date and date", { }) test_that("update_session rejects malformed source_date", { - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", source_date = "not-a-date")) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", source_date = "")) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", source_date = 123)) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", source_date = "not-a-date")) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", source_date = "")) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", source_date = 123)) }) test_that("update_session rejects malformed date", { - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", date = "2024-03-15")) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", date = list(2024, 3, 15))) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", date = "2024-03-15")) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", date = list(2024, 3, 15))) }) test_that("update_session rejects invalid release_level", { - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", release_level = "")) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", release_level = 1)) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", release_level = "")) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", release_level = 1)) }) test_that("update_session rejects invalid date_precision", { - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", date_precision = "")) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", date_precision = 1)) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", date_precision = "")) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", date_precision = 1)) }) test_that("update_session rejects invalid default_records", { - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", default_records = "1")) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", default_records = c(1, -2))) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", default_records = c(1, 0))) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", default_records = c(1.5, 2))) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", default_records = integer(0))) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", default_records = "1")) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", default_records = c(1, -2))) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", default_records = c(1, 0))) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", default_records = c(1.5, 2))) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", default_records = integer(0))) }) test_that("update_session rejects invalid vol_id", { @@ -134,23 +134,23 @@ test_that("update_session rejects invalid vol_id", { }) test_that("update_session rejects invalid session_id", { - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = -1, name = "x")) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 0, name = "x")) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = "1", name = "x")) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = TRUE, name = "x")) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = c(1, 2), name = "x")) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1.5, name = "x")) + expect_error(update_session(vol_id = 1, session_id = -1, name = "x")) + expect_error(update_session(vol_id = 1, session_id = 0, name = "x")) + expect_error(update_session(vol_id = 1, session_id = "1", name = "x")) + expect_error(update_session(vol_id = 1, session_id = TRUE, name = "x")) + expect_error(update_session(vol_id = 1, session_id = c(1, 2), name = "x")) + expect_error(update_session(vol_id = 1, session_id = 1.5, name = "x")) }) test_that("update_session rejects invalid vb parameter", { - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", vb = -1)) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", vb = "a")) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", vb = c(TRUE, FALSE))) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", vb = NULL)) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", vb = -1)) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", vb = "a")) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", vb = NULL)) }) test_that("update_session rejects invalid rq parameter", { - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", rq = "a")) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", rq = -1)) - expect_error(update_session(vol_id = TEST_VOL_ID, session_id = 1, name = "x", rq = TRUE)) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", rq = "a")) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", rq = -1)) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", rq = TRUE)) }) diff --git a/tests/testthat/test-update_session_file.R b/tests/testthat/test-update_session_file.R index ab2daa78..3212563c 100644 --- a/tests/testthat/test-update_session_file.R +++ b/tests/testthat/test-update_session_file.R @@ -4,8 +4,8 @@ login_test_account() test_that("update_session_file returns NULL for non-existent file", { result <- update_session_file( vol_id = TEST_VOL_ID, - session_id = 999999999, - file_id = 999999999, + session_id = TEST_MISSING_ID, + file_id = TEST_MISSING_ID, name = "nope", vb = FALSE ) @@ -13,19 +13,19 @@ test_that("update_session_file returns NULL for non-existent file", { }) test_that("update_session_file rejects missing/invalid name", { - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1)) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = " ")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = 123)) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = c("A", "B"))) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = NULL)) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = NA)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = " ")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = 123)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = c("A", "B"))) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = NULL)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = NA)) }) test_that("update_session_file rejects providing both source_date and date", { expect_error( update_session_file( - vol_id = TEST_VOL_ID, + vol_id = 1, session_id = 1, file_id = 1, name = "x", @@ -36,30 +36,30 @@ test_that("update_session_file rejects providing both source_date and date", { }) test_that("update_session_file rejects malformed source_date", { - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", source_date = "not-a-date")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", source_date = "")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", source_date = 123)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", source_date = "not-a-date")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", source_date = "")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", source_date = 123)) }) test_that("update_session_file rejects malformed date", { - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", date = "2024-03-15")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", date = list(2024, 3, 15))) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", date = "2024-03-15")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", date = list(2024, 3, 15))) }) test_that("update_session_file rejects invalid release_level", { - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", release_level = "")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", release_level = 1)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", release_level = "")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", release_level = 1)) }) test_that("update_session_file rejects invalid date_precision", { - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", date_precision = "")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", date_precision = 1)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", date_precision = "")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", date_precision = 1)) }) test_that("update_session_file rejects invalid is_estimated", { - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", is_estimated = "yes")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", is_estimated = c(TRUE, FALSE))) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", is_estimated = 1)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", is_estimated = "yes")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", is_estimated = c(TRUE, FALSE))) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", is_estimated = 1)) }) test_that("update_session_file rejects invalid vol_id", { @@ -72,32 +72,32 @@ test_that("update_session_file rejects invalid vol_id", { }) test_that("update_session_file rejects invalid session_id", { - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = -1, file_id = 1, name = "x")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 0, file_id = 1, name = "x")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = "1", file_id = 1, name = "x")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = TRUE, file_id = 1, name = "x")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = c(1, 2), file_id = 1, name = "x")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1.5, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = -1, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = 0, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = "1", file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = TRUE, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = c(1, 2), file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = 1.5, file_id = 1, name = "x")) }) test_that("update_session_file rejects invalid file_id", { - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = -1, name = "x")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 0, name = "x")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = "1", name = "x")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = TRUE, name = "x")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = c(1, 2), name = "x")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1.5, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = -1, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 0, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = "1", name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = TRUE, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = c(1, 2), name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1.5, name = "x")) }) test_that("update_session_file rejects invalid vb parameter", { - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", vb = -1)) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", vb = "a")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", vb = c(TRUE, FALSE))) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", vb = NULL)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", vb = -1)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", vb = "a")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", vb = NULL)) }) test_that("update_session_file rejects invalid rq parameter", { - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", rq = "a")) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", rq = -1)) - expect_error(update_session_file(vol_id = TEST_VOL_ID, session_id = 1, file_id = 1, name = "x", rq = TRUE)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", rq = "a")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", rq = -1)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", rq = TRUE)) }) diff --git a/tests/testthat/test-update_volume_record.R b/tests/testthat/test-update_volume_record.R index a16c3e28..ce315eec 100644 --- a/tests/testthat/test-update_volume_record.R +++ b/tests/testthat/test-update_volume_record.R @@ -26,7 +26,7 @@ test_that("update_volume_record updates an existing record", { test_that("update_volume_record returns NULL for non-existent record", { result <- update_volume_record( vol_id = TEST_VOL_ID, - record_id = 999999, + record_id = TEST_MISSING_ID, measures = list("29" = "Test"), vb = FALSE ) @@ -55,34 +55,34 @@ test_that("update_volume_record rejects invalid vol_id", { expect_error(update_volume_record(vol_id = "1", record_id = 1)) expect_error(update_volume_record(vol_id = TRUE, record_id = 1)) expect_error(update_volume_record(vol_id = c(1, 2), record_id = 1)) - expect_error(update_volume_record(vol_id = 1777.5, record_id = 1)) + expect_error(update_volume_record(vol_id = 1.5, record_id = 1)) }) test_that("update_volume_record rejects invalid record_id", { - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = -1)) - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 0)) - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = "1")) - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = TRUE)) - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = c(1, 2))) - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1.5)) + expect_error(update_volume_record(vol_id = 1, record_id = -1)) + expect_error(update_volume_record(vol_id = 1, record_id = 0)) + expect_error(update_volume_record(vol_id = 1, record_id = "1")) + expect_error(update_volume_record(vol_id = 1, record_id = TRUE)) + expect_error(update_volume_record(vol_id = 1, record_id = c(1, 2))) + expect_error(update_volume_record(vol_id = 1, record_id = 1.5)) }) test_that("update_volume_record rejects invalid measures", { - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, measures = "text")) - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, measures = 123)) - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, measures = TRUE)) + expect_error(update_volume_record(vol_id = 1, record_id = 1, measures = "text")) + expect_error(update_volume_record(vol_id = 1, record_id = 1, measures = 123)) + expect_error(update_volume_record(vol_id = 1, record_id = 1, measures = TRUE)) }) test_that("update_volume_record rejects invalid vb parameter", { - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = -1)) - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = 3)) - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = "a")) - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = c(TRUE, FALSE))) - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, vb = NULL)) + expect_error(update_volume_record(vol_id = 1, record_id = 1, vb = -1)) + expect_error(update_volume_record(vol_id = 1, record_id = 1, vb = 3)) + expect_error(update_volume_record(vol_id = 1, record_id = 1, vb = "a")) + expect_error(update_volume_record(vol_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(update_volume_record(vol_id = 1, record_id = 1, vb = NULL)) }) test_that("update_volume_record rejects invalid rq parameter", { - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, rq = "a")) - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, rq = -1)) - expect_error(update_volume_record(vol_id = TEST_VOL_ID, record_id = 1, rq = TRUE)) + expect_error(update_volume_record(vol_id = 1, record_id = 1, rq = "a")) + expect_error(update_volume_record(vol_id = 1, record_id = 1, rq = -1)) + expect_error(update_volume_record(vol_id = 1, record_id = 1, rq = TRUE)) }) From ac3ad3a9a760d199e6428922d87cb45dba7917f4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Thu, 14 May 2026 16:00:13 +0200 Subject: [PATCH 69/77] docs: update parameter descriptions in download functions --- R/download_folder_assets_fr_df.R | 6 ++++-- R/download_session_assets_fr_df.R | 9 ++++++--- man/download_folder_assets_fr_df.Rd | 4 +++- man/download_session_assets_fr_df.Rd | 5 +++-- 4 files changed, 16 insertions(+), 8 deletions(-) diff --git a/R/download_folder_assets_fr_df.R b/R/download_folder_assets_fr_df.R index 6552b97d..e5083386 100644 --- a/R/download_folder_assets_fr_df.R +++ b/R/download_folder_assets_fr_df.R @@ -11,7 +11,9 @@ NULL #' `list_folder_assets()` output. #' #' @param folder_df Data frame describing assets. Must include `vol_id`, -#' `folder_id`, `asset_id`, and `asset_name` columns. +#' `folder_id`, `asset_id`, and `asset_name` columns. Defaults to the result +#' of `list_folder_assets(vol_id = 1)`. Explicit `NULL` triggers the same +#' call using the current `vb` and `rq`. #' @param target_dir Character string. Base directory for downloads. Defaults to #' `tempdir()`. #' @param add_folder_subdir Logical. When `TRUE`, creates a subdirectory per @@ -71,7 +73,7 @@ download_folder_assets_fr_df <- ("httr2_request" %in% class(rq))) if (is.null(folder_df)) { - folder_df <- list_folder_assets(vol_id = 1) + folder_df <- list_folder_assets(vol_id = 1, vb = vb, rq = rq) } assertthat::assert_that(is.data.frame(folder_df)) diff --git a/R/download_session_assets_fr_df.R b/R/download_session_assets_fr_df.R index fde7f6c6..00c3a141 100644 --- a/R/download_session_assets_fr_df.R +++ b/R/download_session_assets_fr_df.R @@ -11,8 +11,9 @@ NULL #' `list_session_assets()` or `list_volume_session_assets()` output. #' #' @param session_df Data frame describing assets. Must include `vol_id`, -#' `session_id`, `asset_id`, and `asset_name` columns. Default is the result -#' `download_session_assets_fr_df(session_id = assets, vol_id = 1)`. +#' `session_id`, `asset_id`, and `asset_name` columns. Defaults to the result +#' of `list_session_assets(session_id = 9224, vol_id = 1)`. Explicit `NULL` +#' triggers the same call using the current `vb` and `rq`. #' @param target_dir Character string. Base directory for downloads. Defaults to #' `tempdir()`. #' @param add_session_subdir Logical. When `TRUE`, creates a subdirectory per @@ -73,7 +74,9 @@ download_session_assets_fr_df <- if (is.null(session_df)) { session_df <- list_session_assets(session_id = 9224, - vol_id = 1) + vol_id = 1, + vb = vb, + rq = rq) } assertthat::assert_that(is.data.frame(session_df)) diff --git a/man/download_folder_assets_fr_df.Rd b/man/download_folder_assets_fr_df.Rd index aa3a3edc..3dba7e00 100644 --- a/man/download_folder_assets_fr_df.Rd +++ b/man/download_folder_assets_fr_df.Rd @@ -17,7 +17,9 @@ download_folder_assets_fr_df( } \arguments{ \item{folder_df}{Data frame describing assets. Must include \code{vol_id}, -\code{folder_id}, \code{asset_id}, and \code{asset_name} columns.} +\code{folder_id}, \code{asset_id}, and \code{asset_name} columns. Defaults to the result +of \code{list_folder_assets(vol_id = 1)}. Explicit \code{NULL} triggers the same +call using the current \code{vb} and \code{rq}.} \item{target_dir}{Character string. Base directory for downloads. Defaults to \code{tempdir()}.} diff --git a/man/download_session_assets_fr_df.Rd b/man/download_session_assets_fr_df.Rd index 661ab45c..edfcb2e4 100644 --- a/man/download_session_assets_fr_df.Rd +++ b/man/download_session_assets_fr_df.Rd @@ -17,8 +17,9 @@ download_session_assets_fr_df( } \arguments{ \item{session_df}{Data frame describing assets. Must include \code{vol_id}, -\code{session_id}, \code{asset_id}, and \code{asset_name} columns. Default is the result -\code{download_session_assets_fr_df(session_id = assets, vol_id = 1)}.} +\code{session_id}, \code{asset_id}, and \code{asset_name} columns. Defaults to the result +of \code{list_session_assets(session_id = 9224, vol_id = 1)}. Explicit \code{NULL} +triggers the same call using the current \code{vb} and \code{rq}.} \item{target_dir}{Character string. Base directory for downloads. Defaults to \code{tempdir()}.} From af4fff8549f058ffb0306c5e96978658e67254be Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Fri, 15 May 2026 10:09:43 +0200 Subject: [PATCH 70/77] refactor: enhance list_volume_funding and get_supported_file_types functions for improved error handling and output validation --- R/list_volume_funding.R | 7 ++++++- R/utils.R | 13 ++++++++++++- 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/R/list_volume_funding.R b/R/list_volume_funding.R index a5c9d64f..b251525a 100644 --- a/R/list_volume_funding.R +++ b/R/list_volume_funding.R @@ -44,7 +44,7 @@ list_volume_funding <- function(vol_id = 1, if (vb) message("Summarizing funding for n=", length(vol_id), " volumes.") - purrr::map(vol_id, function(id) { + out <- purrr::map(vol_id, function(id) { fundings <- perform_api_get( path = sprintf(API_VOLUME_FUNDINGS, id), rq = rq, @@ -70,4 +70,9 @@ list_volume_funding <- function(vol_id = 1, rows }) %>% purrr::list_rbind() + + if (is.null(out) || nrow(out) == 0L) { + return(NULL) + } + tibble::as_tibble(out) } diff --git a/R/utils.R b/R/utils.R index de817007..deff08f6 100644 --- a/R/utils.R +++ b/R/utils.R @@ -93,7 +93,18 @@ get_release_levels <- function(vb = options::opt("vb")) { get_supported_file_types <- function(vb = options::opt("vb")) { validate_flag(vb, "vb") constants <- assign_constants(vb = vb) - constants$format_df |> + if (is.null(constants)) { + return(NULL) + } + df <- constants$format_df + if (is.null(df) || !is.data.frame(df)) { + return(NULL) + } + req_names <- c("name", "id", "category") + if (length(setdiff(req_names, names(df))) > 0L) { + return(NULL) + } + df |> dplyr::rename( asset_type = name, asset_type_id = id, From 72a06f6527a077a7f19eb89a29e1aaf2e08f3c73 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Fri, 15 May 2026 12:04:28 +0200 Subject: [PATCH 71/77] refactor: update environment variable handling for Databrary API URLs --- R/CONSTANTS.R | 6 ++---- R/aaa.R | 14 ++++++++++++++ R/whoami.R | 19 ++++++++++++------- 3 files changed, 28 insertions(+), 11 deletions(-) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 558574ca..a066a13b 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -1,10 +1,8 @@ #' Load Package-wide Constants into Local Environment #' #' -DATABRARY_BASE_URL <- Sys.getenv( - "DATABRARY_BASE_URL", - "https://api.databrary.org" -) +# Default; overridden at load time by .onLoad from DATABRARY_BASE_URL env var +DATABRARY_BASE_URL <- "https://api.databrary.org" API_ACTIVITY_SUMMARY <- "/statistics/summary/" API_GROUPED_FORMATS <- "/grouped-formats/" diff --git a/R/aaa.R b/R/aaa.R index fda75f48..102faff8 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -19,6 +19,20 @@ NULL toset <- !(names(op.devtools) %in% names(op)) if (any(toset)) options(op.devtools[toset]) + base_url <- Sys.getenv("DATABRARY_BASE_URL", "https://api.databrary.org") + ns <- asNamespace(pkgname) + + for (nm in c("DATABRARY_BASE_URL", "OAUTH_TOKEN_URL", "OAUTH_TEST_URL", "LOGIN")) { + unlockBinding(nm, ns) + } + assign("DATABRARY_BASE_URL", base_url, envir = ns) + assign("OAUTH_TOKEN_URL", sprintf("%s/o/token/", base_url), envir = ns) + assign("OAUTH_TEST_URL", sprintf("%s/oauth2/test/", base_url), envir = ns) + assign("LOGIN", sprintf("%s/login/", base_url), envir = ns) + for (nm in c("DATABRARY_BASE_URL", "OAUTH_TOKEN_URL", "OAUTH_TEST_URL", "LOGIN")) { + lockBinding(nm, ns) + } + invisible() } diff --git a/R/whoami.R b/R/whoami.R index 766a56e8..5c513488 100644 --- a/R/whoami.R +++ b/R/whoami.R @@ -46,13 +46,18 @@ whoami <- function(refresh = TRUE, if (vb) { message("whoami request failed: ", conditionMessage(err)) message("whoami -> request url: ", OAUTH_TEST_URL) - message( - "whoami -> authorization header: ", - if (!is.null(req$headers$Authorization)) - req$headers$Authorization - else - "" - ) + bundle <- get_token_bundle() + token <- if (is.null(bundle) || is.null(bundle$access_token)) { + "" + } else { + bundle$access_token + } + auth_desc <- if (nzchar(token)) { + paste0("Bearer ", substr(token, 1L, 8L), "...") + } else { + "" + } + message("whoami -> authorization header: ", auth_desc) } NULL } From 31bbc5fa1dda340624aad450611a731e80b35665 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Mon, 18 May 2026 12:32:59 +0200 Subject: [PATCH 72/77] feat: add bulk operations for managing records, folders, and sessions in Databrary --- NAMESPACE | 14 + R/bulk_apply_internals.R | 242 ++++++++++++++ R/bulk_files.R | 262 +++++++++++++++ R/bulk_folders.R | 207 ++++++++++++ R/bulk_records.R | 259 +++++++++++++++ R/bulk_resume.R | 103 ++++++ R/bulk_sessions.R | 212 ++++++++++++ R/check_duplicate_files_in_folder.R | 2 +- R/check_duplicate_files_in_session.R | 2 +- man/bulk_assign_records.Rd | 53 +++ man/bulk_create_folders.Rd | 60 ++++ man/bulk_create_records.Rd | 60 ++++ man/bulk_create_sessions.Rd | 61 ++++ man/bulk_delete_files.Rd | 51 +++ man/bulk_delete_folders.Rd | 48 +++ man/bulk_delete_records.Rd | 49 +++ man/bulk_delete_sessions.Rd | 51 +++ man/bulk_rename_files.Rd | 63 ++++ man/bulk_rename_folders.Rd | 59 ++++ man/bulk_rename_sessions.Rd | 60 ++++ man/bulk_unassign_records.Rd | 53 +++ man/bulk_upload_files.Rd | 85 +++++ man/check_duplicate_files_in_folder.Rd | 2 +- man/check_duplicate_files_in_session.Rd | 2 +- man/resume_bulk.Rd | 62 ++++ tests/testthat/test-bulk_assign_records.R | 90 ++++++ tests/testthat/test-bulk_create_folders.R | 50 +++ tests/testthat/test-bulk_create_records.R | 51 +++ tests/testthat/test-bulk_create_sessions.R | 50 +++ tests/testthat/test-bulk_delete_files.R | 52 +++ tests/testthat/test-bulk_delete_folders.R | 53 +++ tests/testthat/test-bulk_delete_records.R | 89 +++++ tests/testthat/test-bulk_delete_sessions.R | 105 ++++++ tests/testthat/test-bulk_rename_files.R | 123 +++++++ tests/testthat/test-bulk_rename_folders.R | 122 +++++++ tests/testthat/test-bulk_rename_sessions.R | 122 +++++++ tests/testthat/test-bulk_unassign_records.R | 102 ++++++ tests/testthat/test-bulk_upload_files.R | 339 ++++++++++++++++++++ 38 files changed, 3466 insertions(+), 4 deletions(-) create mode 100644 R/bulk_apply_internals.R create mode 100644 R/bulk_files.R create mode 100644 R/bulk_folders.R create mode 100644 R/bulk_records.R create mode 100644 R/bulk_resume.R create mode 100644 R/bulk_sessions.R create mode 100644 man/bulk_assign_records.Rd create mode 100644 man/bulk_create_folders.Rd create mode 100644 man/bulk_create_records.Rd create mode 100644 man/bulk_create_sessions.Rd create mode 100644 man/bulk_delete_files.Rd create mode 100644 man/bulk_delete_folders.Rd create mode 100644 man/bulk_delete_records.Rd create mode 100644 man/bulk_delete_sessions.Rd create mode 100644 man/bulk_rename_files.Rd create mode 100644 man/bulk_rename_folders.Rd create mode 100644 man/bulk_rename_sessions.Rd create mode 100644 man/bulk_unassign_records.Rd create mode 100644 man/bulk_upload_files.Rd create mode 100644 man/resume_bulk.Rd create mode 100644 tests/testthat/test-bulk_assign_records.R create mode 100644 tests/testthat/test-bulk_create_folders.R create mode 100644 tests/testthat/test-bulk_create_records.R create mode 100644 tests/testthat/test-bulk_create_sessions.R create mode 100644 tests/testthat/test-bulk_delete_files.R create mode 100644 tests/testthat/test-bulk_delete_folders.R create mode 100644 tests/testthat/test-bulk_delete_records.R create mode 100644 tests/testthat/test-bulk_delete_sessions.R create mode 100644 tests/testthat/test-bulk_rename_files.R create mode 100644 tests/testthat/test-bulk_rename_folders.R create mode 100644 tests/testthat/test-bulk_rename_sessions.R create mode 100644 tests/testthat/test-bulk_unassign_records.R create mode 100644 tests/testthat/test-bulk_upload_files.R diff --git a/NAMESPACE b/NAMESPACE index a267d97b..dad1795e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,19 @@ export(HHMMSSmmm_to_ms) export(add_default_record_to_session) export(assign_constants) export(assign_record_to_file) +export(bulk_assign_records) +export(bulk_create_folders) +export(bulk_create_records) +export(bulk_create_sessions) +export(bulk_delete_files) +export(bulk_delete_folders) +export(bulk_delete_records) +export(bulk_delete_sessions) +export(bulk_rename_files) +export(bulk_rename_folders) +export(bulk_rename_sessions) +export(bulk_unassign_records) +export(bulk_upload_files) export(check_duplicate_files_in_folder) export(check_duplicate_files_in_session) export(check_ssl_certs) @@ -86,6 +99,7 @@ export(patch_folder) export(patch_session) export(patch_session_file) export(remove_default_record_from_session) +export(resume_bulk) export(search_for_funder) export(search_for_tags) export(search_institutions) diff --git a/R/bulk_apply_internals.R b/R/bulk_apply_internals.R new file mode 100644 index 00000000..bd5b2795 --- /dev/null +++ b/R/bulk_apply_internals.R @@ -0,0 +1,242 @@ +# Internal helpers shared by bulk_* functions. This file is named +# bulk_apply_internals.R so it loads before other bulk_*.R files (ASCII order). + +# Internal: condition constructor for fast-fail with resumable partial state. +#' @noRd +databraryr_bulk_error <- function(message, partial, failed_input) { + structure( + class = c("databraryr_bulk_error", "error", "condition"), + list( + message = message, + partial = partial, + failed_input = failed_input, + call = sys.call(-1) + ) + ) +} + +# Internal: initialise the result tibble with one row per input. +#' @noRd +init_bulk_tibble <- function(inputs) { + tibble::tibble( + input = inputs, + status = rep("pending", length(inputs)), + result = vector("list", length(inputs)), + error = rep(NA_character_, length(inputs)), + reason = rep(NA_character_, length(inputs)) + ) +} + +# Internal: shared iteration engine. Each pending row runs `fn` with optional +# retries. On failure: `on_error = "stop"` throws `databraryr_bulk_error`; +# `on_error = "collect"` marks the row failed and continues. +# +# `fn` is invoked on each pending input. `is_failure(res)` decides whether the +# returned value (rather than a thrown error) should be treated as a failure. +#' @noRd +bulk_apply <- function(inputs, fn, + is_failure = function(res) is.null(res), + preflight = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0) { + on_error <- match.arg(on_error) + assertthat::assert_that( + is.numeric(max_retries), + length(max_retries) == 1L, + max_retries >= 0, + max_retries == floor(max_retries), + msg = "max_retries must be a single non-negative integer" + ) + assertthat::assert_that( + is.numeric(retry_delay), + length(retry_delay) == 1L, + retry_delay >= 0, + msg = "retry_delay must be a single non-negative number (seconds)" + ) + + state <- init_bulk_tibble(inputs) + + if (!is.null(preflight)) { + state <- preflight(state) + } + + pending_idx <- which(state$status == "pending") + max_retries <- as.integer(max_retries) + + for (i in pending_idx) { + attempt <- 0L + repeat { + res <- tryCatch(fn(state$input[[i]]), error = function(e) e) + failed <- inherits(res, "error") || isTRUE(is_failure(res)) + + if (!failed) { + state$status[i] <- "success" + state$result[[i]] <- res + break + } + + msg <- if (inherits(res, "error")) { + conditionMessage(res) + } else { + "operation returned a failure value (NULL or FALSE)" + } + + if (attempt >= max_retries) { + state$status[i] <- "failed" + state$error[i] <- msg + if (on_error == "stop") { + stop(databraryr_bulk_error( + message = sprintf( + "Bulk operation failed at input '%s': %s", + format(state$input[[i]]), msg + ), + partial = state, + failed_input = state$input[[i]] + )) + } + break + } + + attempt <- attempt + 1L + if (retry_delay > 0) { + Sys.sleep(as.numeric(retry_delay)) + } + } + } + + state +} + +# Internal: mark inputs whose basenames already exist in the session as +# "skipped" with reason "duplicate". Returns the updated state tibble. +#' @noRd +preflight_session_duplicates <- function(state, vol_id, session_id, vb, rq) { + filenames <- basename(state$input) + dupes <- check_duplicate_files_in_session( + vol_id = vol_id, + session_id = session_id, + filenames = filenames, + vb = vb, + rq = rq + ) + if (is.null(dupes)) { + return(state) + } + + exists_lookup <- stats::setNames(dupes$exists, dupes$filename) + is_dupe <- !is.na(exists_lookup[filenames]) & + unname(exists_lookup[filenames]) + is_dupe[is.na(is_dupe)] <- FALSE + + state$status[is_dupe] <- "skipped" + state$reason[is_dupe] <- "duplicate" + state +} + +# Internal: duplicate filenames in folder preflight (mirrors session). +#' @noRd +preflight_folder_duplicates <- function(state, vol_id, folder_id, vb, rq) { + filenames <- basename(state$input) + dupes <- check_duplicate_files_in_folder( + vol_id = vol_id, + folder_id = folder_id, + filenames = filenames, + vb = vb, + rq = rq + ) + if (is.null(dupes)) { + return(state) + } + + exists_lookup <- stats::setNames(dupes$exists, dupes$filename) + is_dupe <- !is.na(exists_lookup[filenames]) & + unname(exists_lookup[filenames]) + is_dupe[is.na(is_dupe)] <- FALSE + + state$status[is_dupe] <- "skipped" + state$reason[is_dupe] <- "duplicate" + state +} + +# Internal: argument validation ----------------------------------------------- + +#' @noRd +assert_recyclable <- function(x, n, name = "argument") { + if (is.null(x)) { + return(invisible(x)) + } + assertthat::assert_that( + length(x) %in% c(1L, n), + msg = sprintf("%s must be NULL, length 1, or length %d", name, n) + ) + invisible(x) +} + +#' @noRd +recycle_i <- function(x, i) { + if (is.null(x)) { + return(NULL) + } + if (length(x) == 1L) { + x[[1L]] + } else { + x[[i]] + } +} + +#' @noRd +assert_bulk_names <- function(names_vec, label = "names") { + assertthat::assert_that( + is.character(names_vec), + length(names_vec) >= 1L, + msg = paste(label, "must be a non-empty character vector") + ) + assertthat::assert_that( + !any(is.na(names_vec)), + msg = paste(label, "must not contain NA") + ) + trimmed <- trimws(names_vec) + assertthat::assert_that( + all(nzchar(trimmed)), + msg = paste(label, "must not contain empty or whitespace-only names") + ) + invisible(trimmed) +} + +#' @noRd +assert_file_paths <- function(file_paths) { + assertthat::assert_that( + is.character(file_paths), + length(file_paths) >= 1, + msg = "file_paths must be a non-empty character vector" + ) + assertthat::assert_that( + !any(is.na(file_paths)), + all(nzchar(file_paths)), + msg = "file_paths must not contain NA or empty strings" + ) + missing_files <- file_paths[!file.exists(file_paths)] + assertthat::assert_that( + length(missing_files) == 0, + msg = paste0( + "file_paths point to non-existent files: ", + paste(missing_files, collapse = ", ") + ) + ) +} + +#' @noRd +assert_positive_integer_vec <- function(x, name = deparse(substitute(x))) { + assertthat::assert_that( + is.numeric(x), + length(x) >= 1, + msg = paste(name, "must be a non-empty numeric vector") + ) + assertthat::assert_that( + !any(is.na(x)), + all(x >= 1), + all(x == floor(x)), + msg = paste(name, "must contain only positive integers") + ) +} diff --git a/R/bulk_files.R b/R/bulk_files.R new file mode 100644 index 00000000..aa693d74 --- /dev/null +++ b/R/bulk_files.R @@ -0,0 +1,262 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Bulk Upload Files to a Databrary Session or Folder +#' +#' @description Upload many files sequentially to a single session or a single +#' folder. Optionally runs a preflight check for duplicate basenames and skips +#' those uploads. With \code{on_error = "stop"} (default), fails fast on the +#' first error and throws \code{databraryr_bulk_error} with a partial tibble for +#' \code{\link{resume_bulk}}. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Session id when uploading to a session. Exactly one of +#' \code{session_id} and \code{folder_id} must be non-\code{NULL}. +#' @param file_paths Character vector of local file paths to upload. Each must +#' point to an existing file. +#' @param folder_id Folder id when uploading to a folder. Exactly one of +#' \code{session_id} and \code{folder_id} must be non-\code{NULL}. +#' @param preflight Logical; if \code{TRUE} (default), skip files whose basename +#' already exists in the target session or folder (via +#' \code{\link{check_duplicate_files_in_session}} or +#' \code{\link{check_duplicate_files_in_folder}}). +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} (default) throws \code{databraryr_bulk_error} +#' on first failure after retries; \code{"collect"} marks failed rows and +#' continues. +#' @param max_retries Non-negative integer: extra attempts per input after the +#' first failure (default \code{0}). +#' @param retry_delay Seconds to sleep between retries (default \code{0}). +#' +#' @return A \code{tibble} with one row per input file and columns: +#' \code{input} (path), \code{status} (\code{"success"}, \code{"failed"}, +#' \code{"skipped"}, or \code{"pending"}), \code{result} (list-column with +#' the per-file API response or \code{NULL}), \code{error} (character +#' message on failure), and \code{reason} (e.g. \code{"duplicate"}). +#' +#' @seealso \code{\link{upload_file}}, +#' \code{\link{check_duplicate_files_in_session}}, +#' \code{\link{check_duplicate_files_in_folder}}, +#' \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' result <- bulk_upload_files( +#' vol_id = 1, +#' session_id = 42, +#' file_paths = c("/tmp/a.mp4", "/tmp/b.mp4") +#' ) +#' result <- bulk_upload_files( +#' vol_id = 1, +#' file_paths = c("/tmp/a.mp4", "/tmp/b.mp4"), +#' folder_id = 7 +#' ) +#' } +#' } +#' @export +bulk_upload_files <- function( + vol_id = 1, + session_id = NULL, + file_paths, + folder_id = NULL, + preflight = TRUE, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + has_session <- !is.null(session_id) + has_folder <- !is.null(folder_id) + assertthat::assert_that( + xor(has_session, has_folder), + msg = "Exactly one of session_id and folder_id must be non-NULL" + ) + if (has_session) { + assert_positive_integer(session_id, "session_id") + } else { + assert_positive_integer(folder_id, "folder_id") + } + assert_file_paths(file_paths) + assertthat::assert_that(is.logical(preflight), length(preflight) == 1) + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + dest_type <- if (has_session) "session" else "folder" + dest_id <- if (has_session) session_id else folder_id + + preflight_fn <- if (preflight) { + if (has_session) { + function(state) { + preflight_session_duplicates(state, vol_id, session_id, vb, rq) + } + } else { + function(state) { + preflight_folder_duplicates(state, vol_id, folder_id, vb, rq) + } + } + } else { + NULL + } + + bulk_apply( + inputs = file_paths, + fn = function(p) { + upload_file( + path = p, + destination_type = dest_type, + object_id = dest_id, + vb = vb, + rq = rq + ) + }, + is_failure = function(res) is.null(res), + preflight = preflight_fn, + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Delete Files from a Databrary Session +#' +#' @description Soft-delete many files from a single session sequentially. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param file_ids Numeric vector of file identifiers. Must be positive +#' integers. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}. +#' +#' @seealso \code{\link{delete_session_file}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_delete_files(vol_id = 1, session_id = 42, file_ids = c(1001, 1002)) +#' } +#' } +#' @export +bulk_delete_files <- function( + vol_id = 1, + session_id, + file_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer_vec(file_ids, "file_ids") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = file_ids, + fn = function(id) { + delete_session_file( + vol_id = vol_id, session_id = session_id, file_id = id, + vb = vb, rq = rq + ) + }, + is_failure = function(res) is.null(res) || isFALSE(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Rename Files in a Databrary Session +#' +#' @description Rename many session files sequentially via +#' \code{\link{patch_session_file}} (\code{name} only). \code{file_ids} must be +#' unique. Folder assets are not supported here (no folder file PATCH helper). +#' With \code{\link{resume_bulk}}, pass \code{new_names} aligned to incomplete +#' rows. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier containing the files. +#' @param file_ids Numeric vector of file identifiers (unique positive integers). +#' @param new_names Character vector of new names, same length as \code{file_ids}. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +#' \code{input} is each file id. +#' +#' @seealso \code{\link{patch_session_file}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_rename_files( +#' vol_id = 1, +#' session_id = 42, +#' file_ids = c(1001, 1002), +#' new_names = c("clip_a.mp4", "clip_b.mp4") +#' ) +#' } +#' } +#' @export +bulk_rename_files <- function( + vol_id = 1, + session_id, + file_ids, + new_names, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer_vec(file_ids, "file_ids") + trimmed_names <- assert_bulk_names(new_names, "new_names") + assertthat::assert_that( + length(trimmed_names) == length(file_ids), + msg = "new_names must have the same length as file_ids" + ) + assertthat::assert_that( + !anyDuplicated(file_ids), + msg = "file_ids must be unique for bulk_rename_files()" + ) + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = file_ids, + fn = function(id) { + i <- match(id, file_ids) + patch_session_file( + vol_id = vol_id, + session_id = session_id, + file_id = id, + name = trimmed_names[[i]], + vb = vb, + rq = rq + ) + }, + is_failure = function(res) is.null(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} diff --git a/R/bulk_folders.R b/R/bulk_folders.R new file mode 100644 index 00000000..3b7adce5 --- /dev/null +++ b/R/bulk_folders.R @@ -0,0 +1,207 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Bulk Delete Folders from a Databrary Volume +#' +#' @description Soft-delete many folders from a single volume sequentially. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param folder_ids Numeric vector of folder identifiers. Must be positive +#' integers. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}. +#' +#' @seealso \code{\link{delete_folder}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_delete_folders(vol_id = 1, folder_ids = c(11, 12, 13)) +#' } +#' } +#' @export +bulk_delete_folders <- function( + vol_id = 1, + folder_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer_vec(folder_ids, "folder_ids") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = folder_ids, + fn = function(id) { + delete_folder(vol_id = vol_id, folder_id = id, vb = vb, rq = rq) + }, + is_failure = function(res) is.null(res) || isFALSE(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Rename Folders in a Databrary Volume +#' +#' @description Rename many folders sequentially via \code{\link{patch_folder}} +#' (\code{name} only). \code{folder_ids} must be unique. With +#' \code{\link{resume_bulk}}, pass \code{new_names} aligned to incomplete rows. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param folder_ids Numeric vector of folder identifiers (unique positive +#' integers). +#' @param new_names Character vector of new names, same length as +#' \code{folder_ids}. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +#' \code{input} is each folder id. +#' +#' @seealso \code{\link{patch_folder}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_rename_folders( +#' vol_id = 1, +#' folder_ids = c(11, 12), +#' new_names = c("Stimuli", "Protocols") +#' ) +#' } +#' } +#' @export +bulk_rename_folders <- function( + vol_id = 1, + folder_ids, + new_names, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer_vec(folder_ids, "folder_ids") + trimmed_names <- assert_bulk_names(new_names, "new_names") + assertthat::assert_that( + length(trimmed_names) == length(folder_ids), + msg = "new_names must have the same length as folder_ids" + ) + assertthat::assert_that( + !anyDuplicated(folder_ids), + msg = "folder_ids must be unique for bulk_rename_folders()" + ) + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = folder_ids, + fn = function(id) { + i <- match(id, folder_ids) + patch_folder( + vol_id = vol_id, + folder_id = id, + name = trimmed_names[[i]], + vb = vb, + rq = rq + ) + }, + is_failure = function(res) is.null(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Create Folders in a Databrary Volume +#' +#' @description Create many folders sequentially. \code{input} in the result +#' tibble is the folder name for that row (after trimming). \code{folder_names} +#' must be unique. Optional fields are recycled: length 1 or same length as +#' \code{folder_names}. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param folder_names Non-empty character vector of folder names (trimmed; +#' none may be empty after trimming). +#' @param release_level Optional character vector (length 1 or +#' \code{length(folder_names)}), passed per row to \code{\link{create_folder}}. +#' @param source_date Optional \code{Date}, ISO string, or vector thereof +#' (length 1 or \code{length(folder_names)}). +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}, +#' with \code{input} equal to the trimmed folder name for each row. +#' +#' @seealso \code{\link{create_folder}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_create_folders(vol_id = 1, folder_names = c("A", "B", "C")) +#' } +#' } +#' @export +bulk_create_folders <- function( + vol_id = 1, + folder_names, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + trimmed <- assert_bulk_names(folder_names, "folder_names") + n <- length(trimmed) + assertthat::assert_that( + !anyDuplicated(trimmed), + msg = "folder_names must be unique for bulk_create_folders() (required for resume_bulk)" + ) + assert_recyclable(release_level, n, "release_level") + assert_recyclable(source_date, n, "source_date") + + assert_positive_integer(vol_id, "vol_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = trimmed, + fn = function(nm) { + i <- match(nm, trimmed) + create_folder( + vol_id = vol_id, + name = nm, + release_level = recycle_i(release_level, i), + source_date = recycle_i(source_date, i), + vb = vb, + rq = rq + ) + }, + is_failure = function(res) is.null(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} diff --git a/R/bulk_records.R b/R/bulk_records.R new file mode 100644 index 00000000..4b8516ea --- /dev/null +++ b/R/bulk_records.R @@ -0,0 +1,259 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Bulk Create Records in a Databrary Volume +#' +#' @description Create many records sequentially via +#' \code{\link{create_volume_record}} with empty \code{measures} aside from the +#' resolved name metric. \code{record_names} must be unique (for +#' \code{\link{resume_bulk}}). \code{category_id} may be length 1 or match +#' \code{record_names}. Per-row \code{measures} / \code{participant} are not +#' supported; call \code{\link{create_volume_record}} for those cases. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param record_names Non-empty character vector of record display names (trimmed). +#' @param category_id Numeric category id(s); length 1 or \code{length(record_names)}. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +#' \code{input} is each trimmed record name. +#' +#' @seealso \code{\link{create_volume_record}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_create_records( +#' vol_id = 1, +#' record_names = c("P101", "P102"), +#' category_id = 6 +#' ) +#' } +#' } +#' @export +bulk_create_records <- function( + vol_id = 1, + record_names, + category_id, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + trimmed <- assert_bulk_names(record_names, "record_names") + n <- length(trimmed) + assertthat::assert_that( + !anyDuplicated(trimmed), + msg = "record_names must be unique for bulk_create_records() (required for resume_bulk)" + ) + if (length(category_id) == 1L) { + assert_positive_integer(category_id, "category_id") + } else { + assert_positive_integer_vec(category_id, "category_id") + } + assert_recyclable(category_id, n, "category_id") + + assert_positive_integer(vol_id, "vol_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = trimmed, + fn = function(nm) { + i <- match(nm, trimmed) + create_volume_record( + vol_id = vol_id, + category_id = recycle_i(category_id, i), + name = nm, + measures = list(), + participant = NULL, + vb = vb, + rq = rq + ) + }, + is_failure = function(res) is.null(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Delete Records from a Databrary Volume +#' +#' @description Soft-delete many volume records sequentially via +#' \code{\link{delete_volume_record}}. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param record_ids Numeric vector of record identifiers (positive integers). +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +#' \code{input} is each record id. +#' +#' @seealso \code{\link{delete_volume_record}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_delete_records(vol_id = 1, record_ids = c(101, 102)) +#' } +#' } +#' @export +bulk_delete_records <- function( + vol_id = 1, + record_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer_vec(record_ids, "record_ids") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = record_ids, + fn = function(id) { + delete_volume_record(vol_id = vol_id, record_id = id, vb = vb, rq = rq) + }, + is_failure = function(res) is.null(res) || isFALSE(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Assign Default Records to a Session +#' +#' @description For each record id, call \code{\link{add_default_record_to_session}} +#' so the record becomes a session default. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. +#' @param record_ids Numeric vector of record identifiers. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +#' \code{input} is each record id. +#' +#' @seealso \code{\link{add_default_record_to_session}}, +#' \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_assign_records(vol_id = 1, session_id = 42, record_ids = c(101, 102)) +#' } +#' } +#' @export +bulk_assign_records <- function( + vol_id = 1, + session_id, + record_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer_vec(record_ids, "record_ids") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = record_ids, + fn = function(id) { + add_default_record_to_session( + vol_id = vol_id, + session_id = session_id, + record_id = id, + vb = vb, + rq = rq + ) + }, + is_failure = function(res) isFALSE(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Unassign Default Records from a Session +#' +#' @description For each record id, call +#' \code{\link{remove_default_record_from_session}}. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. +#' @param record_ids Numeric vector of record identifiers. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +#' \code{input} is each record id. +#' +#' @seealso \code{\link{remove_default_record_from_session}}, +#' \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_unassign_records(vol_id = 1, session_id = 42, record_ids = c(101, 102)) +#' } +#' } +#' @export +bulk_unassign_records <- function( + vol_id = 1, + session_id, + record_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer_vec(record_ids, "record_ids") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = record_ids, + fn = function(id) { + remove_default_record_from_session( + vol_id = vol_id, + session_id = session_id, + record_id = id, + vb = vb, + rq = rq + ) + }, + is_failure = function(res) isFALSE(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} diff --git a/R/bulk_resume.R b/R/bulk_resume.R new file mode 100644 index 00000000..a054d567 --- /dev/null +++ b/R/bulk_resume.R @@ -0,0 +1,103 @@ +#' Resume a Bulk Operation After a Failure +#' +#' @description When a \code{bulk_*} run ends with incomplete rows (either +#' because \code{on_error = "stop"} threw \code{databraryr_bulk_error} or +#' because \code{on_error = "collect"} left \code{"failed"} / \code{"pending"} +#' rows), \code{resume_bulk()} re-runs the supplied bulk function on those rows +#' and merges the result, preserving original input order. +#' +#' @param partial A tibble produced by a previous \code{bulk_*} call (typically +#' extracted from a \code{databraryr_bulk_error} condition via +#' \code{conditionMessage} / direct access to \code{cond$partial}). +#' @param fn The bulk function to re-invoke (e.g. \code{bulk_upload_files}). +#' @param ... Additional arguments forwarded to \code{fn} (for example +#' \code{vol_id}, \code{session_id}, \code{vb}, \code{rq}). The remaining +#' inputs are passed as the function's input vector argument under the name +#' \code{input_arg} (default: auto-detected from the function's formals). +#' @param input_arg Optional name of the input argument of \code{fn}. If +#' \code{NULL} (default), it is inferred as the first formal of \code{fn} +#' matching one of \code{file_paths}, \code{session_ids}, \code{folder_ids}, +#' \code{file_ids}, \code{session_names}, \code{folder_names}, +#' \code{record_ids}, \code{record_names}. +#' +#' @return A tibble of the same shape as \code{partial}, with rows from the +#' resumed run substituted in for previously incomplete rows. +#' +#' @seealso \code{\link{bulk_upload_files}}, \code{\link{bulk_delete_sessions}}, +#' \code{\link{bulk_delete_folders}}, \code{\link{bulk_delete_files}}, +#' \code{\link{bulk_create_sessions}}, \code{\link{bulk_create_folders}}, +#' \code{\link{bulk_rename_sessions}}, \code{\link{bulk_rename_folders}}, +#' \code{\link{bulk_rename_files}}, \code{\link{bulk_create_records}}, +#' \code{\link{bulk_delete_records}}, \code{\link{bulk_assign_records}}, +#' \code{\link{bulk_unassign_records}} +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' result <- tryCatch( +#' bulk_upload_files( +#' vol_id = 1, session_id = 42, +#' file_paths = c("/tmp/a.mp4", "/tmp/b.mp4") +#' ), +#' databraryr_bulk_error = function(e) e$partial +#' ) +#' # ... fix the failing file, then: +#' result <- resume_bulk(result, bulk_upload_files, +#' vol_id = 1, session_id = 42) +#' } +#' } +#' @export +resume_bulk <- function(partial, fn, ..., input_arg = NULL) { + assertthat::assert_that( + inherits(partial, "tbl_df"), + all(c("input", "status") %in% names(partial)), + msg = "partial must be a tibble produced by a bulk_* function" + ) + assertthat::assert_that(is.function(fn)) + + to_redo <- partial$status %in% c("pending", "failed") + if (!any(to_redo)) { + return(partial) + } + + if (is.null(input_arg)) { + input_arg <- detect_input_arg(fn) + } + + remaining <- partial$input[to_redo] + args <- list(...) + args[[input_arg]] <- remaining + + new_rows <- do.call(fn, args) + + # Splice new rows back into the original order. + out <- partial + redo_idx <- which(to_redo) + for (k in seq_along(redo_idx)) { + i <- redo_idx[k] + out$status[i] <- new_rows$status[k] + out$result[i] <- new_rows$result[k] + out$error[i] <- new_rows$error[k] + out$reason[i] <- new_rows$reason[k] + } + out +} + +# Internal: infer which formal of a bulk_* function takes the vector of inputs. +#' @noRd +detect_input_arg <- function(fn) { + candidates <- c( + "file_paths", "session_ids", "folder_ids", "file_ids", + "session_names", "folder_names", + "record_ids", "record_names" + ) + hit <- intersect(names(formals(fn)), candidates) + assertthat::assert_that( + length(hit) == 1, + msg = paste0( + "Could not infer input argument of fn; pass `input_arg` explicitly. ", + "Looked for one of: ", paste(candidates, collapse = ", ") + ) + ) + hit +} diff --git a/R/bulk_sessions.R b/R/bulk_sessions.R new file mode 100644 index 00000000..7f66b982 --- /dev/null +++ b/R/bulk_sessions.R @@ -0,0 +1,212 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Bulk Delete Sessions from a Databrary Volume +#' +#' @description Soft-delete many sessions from a single volume sequentially. +#' With \code{on_error = "stop"} (default), fails fast and throws +#' \code{databraryr_bulk_error}; with \code{"collect"}, marks failed rows and +#' continues. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_ids Numeric vector of session identifiers. Must be positive +#' integers. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}. +#' +#' @seealso \code{\link{delete_session}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_delete_sessions(vol_id = 1, session_ids = c(101, 102, 103)) +#' } +#' } +#' @export +bulk_delete_sessions <- function( + vol_id = 1, + session_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer_vec(session_ids, "session_ids") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = session_ids, + fn = function(id) { + delete_session(vol_id = vol_id, session_id = id, vb = vb, rq = rq) + }, + is_failure = function(res) is.null(res) || isFALSE(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Rename Sessions in a Databrary Volume +#' +#' @description Rename many sessions sequentially via \code{\link{patch_session}} +#' (\code{name} only). \code{session_ids} must be unique so each row maps to one +#' name. With \code{\link{resume_bulk}}, pass \code{new_names} aligned to the +#' subset of ids being retried (same order as incomplete rows). +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_ids Numeric vector of session identifiers (unique positive +#' integers). +#' @param new_names Character vector of new names, same length as +#' \code{session_ids}. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +#' \code{input} is each session id. +#' +#' @seealso \code{\link{patch_session}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_rename_sessions( +#' vol_id = 1, +#' session_ids = c(101, 102), +#' new_names = c("Lab visit A", "Lab visit B") +#' ) +#' } +#' } +#' @export +bulk_rename_sessions <- function( + vol_id = 1, + session_ids, + new_names, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer_vec(session_ids, "session_ids") + trimmed_names <- assert_bulk_names(new_names, "new_names") + assertthat::assert_that( + length(trimmed_names) == length(session_ids), + msg = "new_names must have the same length as session_ids" + ) + assertthat::assert_that( + !anyDuplicated(session_ids), + msg = "session_ids must be unique for bulk_rename_sessions()" + ) + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = session_ids, + fn = function(id) { + i <- match(id, session_ids) + patch_session( + vol_id = vol_id, + session_id = id, + name = trimmed_names[[i]], + vb = vb, + rq = rq + ) + }, + is_failure = function(res) is.null(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Create Sessions in a Databrary Volume +#' +#' @description Create many sessions sequentially. \code{input} in the result +#' tibble is the session name for that row (after trimming). \code{session_names} +#' must be unique. Optional fields are recycled. Structured \code{date}, +#' \code{date_precision}, and +#' \code{default_records} are not supported here; use \code{\link{create_session}} +#' per row if you need them. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_names Non-empty character vector of session names. +#' @param release_level Optional character vector (length 1 or +#' \code{length(session_names)}). +#' @param source_date Optional \code{Date}, ISO string, or vector thereof +#' (length 1 or \code{length(session_names)}). +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}, +#' with \code{input} equal to the trimmed session name for each row. +#' +#' @seealso \code{\link{create_session}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_create_sessions(vol_id = 1, session_names = c("S1", "S2")) +#' } +#' } +#' @export +bulk_create_sessions <- function( + vol_id = 1, + session_names, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + trimmed <- assert_bulk_names(session_names, "session_names") + n <- length(trimmed) + assertthat::assert_that( + !anyDuplicated(trimmed), + msg = "session_names must be unique for bulk_create_sessions() (required for resume_bulk)" + ) + assert_recyclable(release_level, n, "release_level") + assert_recyclable(source_date, n, "source_date") + + assert_positive_integer(vol_id, "vol_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = trimmed, + fn = function(nm) { + i <- match(nm, trimmed) + create_session( + vol_id = vol_id, + name = nm, + release_level = recycle_i(release_level, i), + source_date = recycle_i(source_date, i), + vb = vb, + rq = rq + ) + }, + is_failure = function(res) is.null(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} diff --git a/R/check_duplicate_files_in_folder.R b/R/check_duplicate_files_in_folder.R index c31e8658..15a7797e 100644 --- a/R/check_duplicate_files_in_folder.R +++ b/R/check_duplicate_files_in_folder.R @@ -6,7 +6,7 @@ NULL #' Check Whether Filenames Already Exist in a Folder #' #' @description Ask the server which of the supplied filenames already -#' exist as files in the given folder. Useful before uploading multiple files to detect +#' exist as files in the given folder. Useful before bulk uploads to detect #' name collisions in advance. #' #' @param vol_id Target volume number. Must be a positive integer. diff --git a/R/check_duplicate_files_in_session.R b/R/check_duplicate_files_in_session.R index e6e3d688..a535bbc2 100644 --- a/R/check_duplicate_files_in_session.R +++ b/R/check_duplicate_files_in_session.R @@ -6,7 +6,7 @@ NULL #' Check Whether Filenames Already Exist in a Session #' #' @description Ask the server which of the supplied filenames already -#' exist as files in the given session. Useful before uploading multiple files to detect +#' exist as files in the given session. Useful before bulk uploads to detect #' name collisions in advance. #' #' @param vol_id Target volume number. Must be a positive integer. diff --git a/man/bulk_assign_records.Rd b/man/bulk_assign_records.Rd new file mode 100644 index 00000000..a7f6f3f3 --- /dev/null +++ b/man/bulk_assign_records.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_records.R +\name{bulk_assign_records} +\alias{bulk_assign_records} +\title{Bulk Assign Default Records to a Session} +\usage{ +bulk_assign_records( + vol_id = 1, + session_id, + record_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier.} + +\item{record_ids}{Numeric vector of record identifiers.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +\code{input} is each record id. +} +\description{ +For each record id, call \code{\link{add_default_record_to_session}} +so the record becomes a session default. +} +\examples{ +\donttest{ +\dontrun{ +bulk_assign_records(vol_id = 1, session_id = 42, record_ids = c(101, 102)) +} +} +} +\seealso{ +\code{\link{add_default_record_to_session}}, +\code{\link{resume_bulk}} +} diff --git a/man/bulk_create_folders.Rd b/man/bulk_create_folders.Rd new file mode 100644 index 00000000..08ae3075 --- /dev/null +++ b/man/bulk_create_folders.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_folders.R +\name{bulk_create_folders} +\alias{bulk_create_folders} +\title{Bulk Create Folders in a Databrary Volume} +\usage{ +bulk_create_folders( + vol_id = 1, + folder_names, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{folder_names}{Non-empty character vector of folder names (trimmed; +none may be empty after trimming).} + +\item{release_level}{Optional character vector (length 1 or +\code{length(folder_names)}), passed per row to \code{\link{create_folder}}.} + +\item{source_date}{Optional \code{Date}, ISO string, or vector thereof +(length 1 or \code{length(folder_names)}).} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}, +with \code{input} equal to the trimmed folder name for each row. +} +\description{ +Create many folders sequentially. \code{input} in the result +tibble is the folder name for that row (after trimming). \code{folder_names} +must be unique. Optional fields are recycled: length 1 or same length as +\code{folder_names}. +} +\examples{ +\donttest{ +\dontrun{ +bulk_create_folders(vol_id = 1, folder_names = c("A", "B", "C")) +} +} +} +\seealso{ +\code{\link{create_folder}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_create_records.Rd b/man/bulk_create_records.Rd new file mode 100644 index 00000000..d53976f7 --- /dev/null +++ b/man/bulk_create_records.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_records.R +\name{bulk_create_records} +\alias{bulk_create_records} +\title{Bulk Create Records in a Databrary Volume} +\usage{ +bulk_create_records( + vol_id = 1, + record_names, + category_id, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{record_names}{Non-empty character vector of record display names (trimmed).} + +\item{category_id}{Numeric category id(s); length 1 or \code{length(record_names)}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +\code{input} is each trimmed record name. +} +\description{ +Create many records sequentially via +\code{\link{create_volume_record}} with empty \code{measures} aside from the +resolved name metric. \code{record_names} must be unique (for +\code{\link{resume_bulk}}). \code{category_id} may be length 1 or match +\code{record_names}. Per-row \code{measures} / \code{participant} are not +supported; call \code{\link{create_volume_record}} for those cases. +} +\examples{ +\donttest{ +\dontrun{ +bulk_create_records( + vol_id = 1, + record_names = c("P101", "P102"), + category_id = 6 +) +} +} +} +\seealso{ +\code{\link{create_volume_record}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_create_sessions.Rd b/man/bulk_create_sessions.Rd new file mode 100644 index 00000000..b35ba61b --- /dev/null +++ b/man/bulk_create_sessions.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_sessions.R +\name{bulk_create_sessions} +\alias{bulk_create_sessions} +\title{Bulk Create Sessions in a Databrary Volume} +\usage{ +bulk_create_sessions( + vol_id = 1, + session_names, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_names}{Non-empty character vector of session names.} + +\item{release_level}{Optional character vector (length 1 or +\code{length(session_names)}).} + +\item{source_date}{Optional \code{Date}, ISO string, or vector thereof +(length 1 or \code{length(session_names)}).} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}, +with \code{input} equal to the trimmed session name for each row. +} +\description{ +Create many sessions sequentially. \code{input} in the result +tibble is the session name for that row (after trimming). \code{session_names} +must be unique. Optional fields are recycled. Structured \code{date}, +\code{date_precision}, and +\code{default_records} are not supported here; use \code{\link{create_session}} +per row if you need them. +} +\examples{ +\donttest{ +\dontrun{ +bulk_create_sessions(vol_id = 1, session_names = c("S1", "S2")) +} +} +} +\seealso{ +\code{\link{create_session}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_delete_files.Rd b/man/bulk_delete_files.Rd new file mode 100644 index 00000000..3ab0977b --- /dev/null +++ b/man/bulk_delete_files.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_files.R +\name{bulk_delete_files} +\alias{bulk_delete_files} +\title{Bulk Delete Files from a Databrary Session} +\usage{ +bulk_delete_files( + vol_id = 1, + session_id, + file_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{file_ids}{Numeric vector of file identifiers. Must be positive +integers.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}. +} +\description{ +Soft-delete many files from a single session sequentially. +} +\examples{ +\donttest{ +\dontrun{ +bulk_delete_files(vol_id = 1, session_id = 42, file_ids = c(1001, 1002)) +} +} +} +\seealso{ +\code{\link{delete_session_file}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_delete_folders.Rd b/man/bulk_delete_folders.Rd new file mode 100644 index 00000000..c22b7e5c --- /dev/null +++ b/man/bulk_delete_folders.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_folders.R +\name{bulk_delete_folders} +\alias{bulk_delete_folders} +\title{Bulk Delete Folders from a Databrary Volume} +\usage{ +bulk_delete_folders( + vol_id = 1, + folder_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{folder_ids}{Numeric vector of folder identifiers. Must be positive +integers.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}. +} +\description{ +Soft-delete many folders from a single volume sequentially. +} +\examples{ +\donttest{ +\dontrun{ +bulk_delete_folders(vol_id = 1, folder_ids = c(11, 12, 13)) +} +} +} +\seealso{ +\code{\link{delete_folder}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_delete_records.Rd b/man/bulk_delete_records.Rd new file mode 100644 index 00000000..da93af73 --- /dev/null +++ b/man/bulk_delete_records.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_records.R +\name{bulk_delete_records} +\alias{bulk_delete_records} +\title{Bulk Delete Records from a Databrary Volume} +\usage{ +bulk_delete_records( + vol_id = 1, + record_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{record_ids}{Numeric vector of record identifiers (positive integers).} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +\code{input} is each record id. +} +\description{ +Soft-delete many volume records sequentially via +\code{\link{delete_volume_record}}. +} +\examples{ +\donttest{ +\dontrun{ +bulk_delete_records(vol_id = 1, record_ids = c(101, 102)) +} +} +} +\seealso{ +\code{\link{delete_volume_record}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_delete_sessions.Rd b/man/bulk_delete_sessions.Rd new file mode 100644 index 00000000..9ec838ab --- /dev/null +++ b/man/bulk_delete_sessions.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_sessions.R +\name{bulk_delete_sessions} +\alias{bulk_delete_sessions} +\title{Bulk Delete Sessions from a Databrary Volume} +\usage{ +bulk_delete_sessions( + vol_id = 1, + session_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_ids}{Numeric vector of session identifiers. Must be positive +integers.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}. +} +\description{ +Soft-delete many sessions from a single volume sequentially. +With \code{on_error = "stop"} (default), fails fast and throws +\code{databraryr_bulk_error}; with \code{"collect"}, marks failed rows and +continues. +} +\examples{ +\donttest{ +\dontrun{ +bulk_delete_sessions(vol_id = 1, session_ids = c(101, 102, 103)) +} +} +} +\seealso{ +\code{\link{delete_session}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_rename_files.Rd b/man/bulk_rename_files.Rd new file mode 100644 index 00000000..7d2dc5af --- /dev/null +++ b/man/bulk_rename_files.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_files.R +\name{bulk_rename_files} +\alias{bulk_rename_files} +\title{Bulk Rename Files in a Databrary Session} +\usage{ +bulk_rename_files( + vol_id = 1, + session_id, + file_ids, + new_names, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier containing the files.} + +\item{file_ids}{Numeric vector of file identifiers (unique positive integers).} + +\item{new_names}{Character vector of new names, same length as \code{file_ids}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +\code{input} is each file id. +} +\description{ +Rename many session files sequentially via +\code{\link{patch_session_file}} (\code{name} only). \code{file_ids} must be +unique. Folder assets are not supported here (no folder file PATCH helper). +With \code{\link{resume_bulk}}, pass \code{new_names} aligned to incomplete +rows. +} +\examples{ +\donttest{ +\dontrun{ +bulk_rename_files( + vol_id = 1, + session_id = 42, + file_ids = c(1001, 1002), + new_names = c("clip_a.mp4", "clip_b.mp4") +) +} +} +} +\seealso{ +\code{\link{patch_session_file}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_rename_folders.Rd b/man/bulk_rename_folders.Rd new file mode 100644 index 00000000..8d69aa01 --- /dev/null +++ b/man/bulk_rename_folders.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_folders.R +\name{bulk_rename_folders} +\alias{bulk_rename_folders} +\title{Bulk Rename Folders in a Databrary Volume} +\usage{ +bulk_rename_folders( + vol_id = 1, + folder_ids, + new_names, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{folder_ids}{Numeric vector of folder identifiers (unique positive +integers).} + +\item{new_names}{Character vector of new names, same length as +\code{folder_ids}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +\code{input} is each folder id. +} +\description{ +Rename many folders sequentially via \code{\link{patch_folder}} +(\code{name} only). \code{folder_ids} must be unique. With +\code{\link{resume_bulk}}, pass \code{new_names} aligned to incomplete rows. +} +\examples{ +\donttest{ +\dontrun{ +bulk_rename_folders( + vol_id = 1, + folder_ids = c(11, 12), + new_names = c("Stimuli", "Protocols") +) +} +} +} +\seealso{ +\code{\link{patch_folder}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_rename_sessions.Rd b/man/bulk_rename_sessions.Rd new file mode 100644 index 00000000..50e249f5 --- /dev/null +++ b/man/bulk_rename_sessions.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_sessions.R +\name{bulk_rename_sessions} +\alias{bulk_rename_sessions} +\title{Bulk Rename Sessions in a Databrary Volume} +\usage{ +bulk_rename_sessions( + vol_id = 1, + session_ids, + new_names, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_ids}{Numeric vector of session identifiers (unique positive +integers).} + +\item{new_names}{Character vector of new names, same length as +\code{session_ids}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +\code{input} is each session id. +} +\description{ +Rename many sessions sequentially via \code{\link{patch_session}} +(\code{name} only). \code{session_ids} must be unique so each row maps to one +name. With \code{\link{resume_bulk}}, pass \code{new_names} aligned to the +subset of ids being retried (same order as incomplete rows). +} +\examples{ +\donttest{ +\dontrun{ +bulk_rename_sessions( + vol_id = 1, + session_ids = c(101, 102), + new_names = c("Lab visit A", "Lab visit B") +) +} +} +} +\seealso{ +\code{\link{patch_session}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_unassign_records.Rd b/man/bulk_unassign_records.Rd new file mode 100644 index 00000000..24c23e9f --- /dev/null +++ b/man/bulk_unassign_records.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_records.R +\name{bulk_unassign_records} +\alias{bulk_unassign_records} +\title{Bulk Unassign Default Records from a Session} +\usage{ +bulk_unassign_records( + vol_id = 1, + session_id, + record_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier.} + +\item{record_ids}{Numeric vector of record identifiers.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +\code{input} is each record id. +} +\description{ +For each record id, call +\code{\link{remove_default_record_from_session}}. +} +\examples{ +\donttest{ +\dontrun{ +bulk_unassign_records(vol_id = 1, session_id = 42, record_ids = c(101, 102)) +} +} +} +\seealso{ +\code{\link{remove_default_record_from_session}}, +\code{\link{resume_bulk}} +} diff --git a/man/bulk_upload_files.Rd b/man/bulk_upload_files.Rd new file mode 100644 index 00000000..4a2a20aa --- /dev/null +++ b/man/bulk_upload_files.Rd @@ -0,0 +1,85 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_files.R +\name{bulk_upload_files} +\alias{bulk_upload_files} +\title{Bulk Upload Files to a Databrary Session or Folder} +\usage{ +bulk_upload_files( + vol_id = 1, + session_id = NULL, + file_paths, + folder_id = NULL, + preflight = TRUE, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Session id when uploading to a session. Exactly one of +\code{session_id} and \code{folder_id} must be non-\code{NULL}.} + +\item{file_paths}{Character vector of local file paths to upload. Each must +point to an existing file.} + +\item{folder_id}{Folder id when uploading to a folder. Exactly one of +\code{session_id} and \code{folder_id} must be non-\code{NULL}.} + +\item{preflight}{Logical; if \code{TRUE} (default), skip files whose basename +already exists in the target session or folder (via +\code{\link{check_duplicate_files_in_session}} or +\code{\link{check_duplicate_files_in_folder}}).} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} (default) throws \code{databraryr_bulk_error} +on first failure after retries; \code{"collect"} marks failed rows and +continues.} + +\item{max_retries}{Non-negative integer: extra attempts per input after the +first failure (default \code{0}).} + +\item{retry_delay}{Seconds to sleep between retries (default \code{0}).} +} +\value{ +A \code{tibble} with one row per input file and columns: +\code{input} (path), \code{status} (\code{"success"}, \code{"failed"}, +\code{"skipped"}, or \code{"pending"}), \code{result} (list-column with +the per-file API response or \code{NULL}), \code{error} (character +message on failure), and \code{reason} (e.g. \code{"duplicate"}). +} +\description{ +Upload many files sequentially to a single session or a single +folder. Optionally runs a preflight check for duplicate basenames and skips +those uploads. With \code{on_error = "stop"} (default), fails fast on the +first error and throws \code{databraryr_bulk_error} with a partial tibble for +\code{\link{resume_bulk}}. +} +\examples{ +\donttest{ +\dontrun{ +result <- bulk_upload_files( + vol_id = 1, + session_id = 42, + file_paths = c("/tmp/a.mp4", "/tmp/b.mp4") +) +result <- bulk_upload_files( + vol_id = 1, + file_paths = c("/tmp/a.mp4", "/tmp/b.mp4"), + folder_id = 7 +) +} +} +} +\seealso{ +\code{\link{upload_file}}, +\code{\link{check_duplicate_files_in_session}}, +\code{\link{check_duplicate_files_in_folder}}, +\code{\link{resume_bulk}} +} diff --git a/man/check_duplicate_files_in_folder.Rd b/man/check_duplicate_files_in_folder.Rd index 49bb93f4..39b7cee7 100644 --- a/man/check_duplicate_files_in_folder.Rd +++ b/man/check_duplicate_files_in_folder.Rd @@ -33,7 +33,7 @@ a missing \code{folder_id} still yields a successful response with } \description{ Ask the server which of the supplied filenames already -exist as files in the given folder. Useful before uploading multiple files to detect +exist as files in the given folder. Useful before bulk uploads to detect name collisions in advance. } \examples{ diff --git a/man/check_duplicate_files_in_session.Rd b/man/check_duplicate_files_in_session.Rd index 87e4ee49..f4d6086d 100644 --- a/man/check_duplicate_files_in_session.Rd +++ b/man/check_duplicate_files_in_session.Rd @@ -33,7 +33,7 @@ reported as \code{exists = FALSE} (no rows match that session). } \description{ Ask the server which of the supplied filenames already -exist as files in the given session. Useful before uploading multiple files to detect +exist as files in the given session. Useful before bulk uploads to detect name collisions in advance. } \examples{ diff --git a/man/resume_bulk.Rd b/man/resume_bulk.Rd new file mode 100644 index 00000000..eef8ce81 --- /dev/null +++ b/man/resume_bulk.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_resume.R +\name{resume_bulk} +\alias{resume_bulk} +\title{Resume a Bulk Operation After a Failure} +\usage{ +resume_bulk(partial, fn, ..., input_arg = NULL) +} +\arguments{ +\item{partial}{A tibble produced by a previous \code{bulk_*} call (typically +extracted from a \code{databraryr_bulk_error} condition via +\code{conditionMessage} / direct access to \code{cond$partial}).} + +\item{fn}{The bulk function to re-invoke (e.g. \code{bulk_upload_files}).} + +\item{...}{Additional arguments forwarded to \code{fn} (for example +\code{vol_id}, \code{session_id}, \code{vb}, \code{rq}). The remaining +inputs are passed as the function's input vector argument under the name +\code{input_arg} (default: auto-detected from the function's formals).} + +\item{input_arg}{Optional name of the input argument of \code{fn}. If +\code{NULL} (default), it is inferred as the first formal of \code{fn} +matching one of \code{file_paths}, \code{session_ids}, \code{folder_ids}, +\code{file_ids}, \code{session_names}, \code{folder_names}, +\code{record_ids}, \code{record_names}.} +} +\value{ +A tibble of the same shape as \code{partial}, with rows from the +resumed run substituted in for previously incomplete rows. +} +\description{ +When a \code{bulk_*} run ends with incomplete rows (either +because \code{on_error = "stop"} threw \code{databraryr_bulk_error} or +because \code{on_error = "collect"} left \code{"failed"} / \code{"pending"} +rows), \code{resume_bulk()} re-runs the supplied bulk function on those rows +and merges the result, preserving original input order. +} +\examples{ +\donttest{ +\dontrun{ +result <- tryCatch( + bulk_upload_files( + vol_id = 1, session_id = 42, + file_paths = c("/tmp/a.mp4", "/tmp/b.mp4") + ), + databraryr_bulk_error = function(e) e$partial +) +# ... fix the failing file, then: +result <- resume_bulk(result, bulk_upload_files, + vol_id = 1, session_id = 42) +} +} +} +\seealso{ +\code{\link{bulk_upload_files}}, \code{\link{bulk_delete_sessions}}, +\code{\link{bulk_delete_folders}}, \code{\link{bulk_delete_files}}, +\code{\link{bulk_create_sessions}}, \code{\link{bulk_create_folders}}, +\code{\link{bulk_rename_sessions}}, \code{\link{bulk_rename_folders}}, +\code{\link{bulk_rename_files}}, \code{\link{bulk_create_records}}, +\code{\link{bulk_delete_records}}, \code{\link{bulk_assign_records}}, +\code{\link{bulk_unassign_records}} +} diff --git a/tests/testthat/test-bulk_assign_records.R b/tests/testthat/test-bulk_assign_records.R new file mode 100644 index 00000000..0df5289b --- /dev/null +++ b/tests/testthat/test-bulk_assign_records.R @@ -0,0 +1,90 @@ +# bulk_assign_records() ------------------------------------------------------- +login_test_account() + +test_that("bulk_assign_records rejects invalid args", { + expect_error(bulk_assign_records(vol_id = -1, session_id = 1L, record_ids = 1L)) + expect_error(bulk_assign_records(vol_id = 1L, session_id = -1L, record_ids = 1L)) + expect_error(bulk_assign_records(vol_id = 1L, session_id = 1L, record_ids = numeric(0))) +}) + +test_that("bulk_assign_records assigns defaults for multiple records", { + uniq <- sprintf( + "bulk_ar_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + sid <- make_test_session(sprintf("%s_sess", uniq), vb = FALSE) + skip_if_null_response(sid, "make_test_session") + + r1 <- make_test_record(sprintf("%s_r1", uniq), vb = FALSE) + r2 <- make_test_record(sprintf("%s_r2", uniq), vb = FALSE) + skip_if_null_response(r1, "make_test_record 1") + skip_if_null_response(r2, "make_test_record 2") + + result <- bulk_assign_records( + vol_id = TEST_VOL_ID, + session_id = sid, + record_ids = c(r1, r2), + vb = FALSE + ) + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 2) + expect_true(all(result$status == "success")) +}) + +test_that("bulk_assign_records fast-fails on bad record id", { + sid <- make_test_session("bulk_assign_records ff", vb = FALSE) + skip_if_null_response(sid, "make_test_session") + + r1 <- make_test_record("bulk_assign_records ff r", vb = FALSE) + skip_if_null_response(r1, "make_test_record") + + mixed <- c(r1, TEST_MISSING_ID) + + partial <- tryCatch( + bulk_assign_records( + vol_id = TEST_VOL_ID, + session_id = sid, + record_ids = mixed, + vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[[1]], "success") + expect_equal(partial$status[[2]], "failed") +}) + +test_that("bulk_assign_records on_error collect runs all rows", { + sid <- make_test_session("bulk_assign_records collect", vb = FALSE) + skip_if_null_response(sid, "make_test_session") + + created <- bulk_create_records( + vol_id = TEST_VOL_ID, + record_names = c("bulk_ar_c1", "bulk_ar_c2"), + category_id = TEST_CATEGORY_ID, + vb = FALSE + ) + skip_if_null_response(created, "bulk_create_records") + + ids <- vapply(created$result, function(r) as.integer(r$record_id), integer(1)) + on.exit({ + for (id in ids) { + try(delete_volume_record(TEST_VOL_ID, id, vb = FALSE), silent = TRUE) + } + }, add = TRUE) + + mixed <- c(ids[[1]], TEST_MISSING_ID, ids[[2]]) + result <- bulk_assign_records( + vol_id = TEST_VOL_ID, + session_id = sid, + record_ids = mixed, + vb = FALSE, + on_error = "collect" + ) + + expect_s3_class(result, "tbl_df") + expect_equal(result$status, c("success", "failed", "success")) +}) diff --git a/tests/testthat/test-bulk_create_folders.R b/tests/testthat/test-bulk_create_folders.R new file mode 100644 index 00000000..a7977fcf --- /dev/null +++ b/tests/testthat/test-bulk_create_folders.R @@ -0,0 +1,50 @@ +# bulk_create_folders() ------------------------------------------------------- +login_test_account() + +test_that("bulk_create_folders rejects invalid args", { + expect_error(bulk_create_folders(vol_id = -1, folder_names = "a")) + expect_error(bulk_create_folders(vol_id = 1, folder_names = character(0))) + expect_error(bulk_create_folders(vol_id = 1, folder_names = c("a", "a"))) + expect_error(bulk_create_folders( + vol_id = 1, folder_names = c("a", "b"), release_level = c("X", "Y", "Z") + )) +}) + +test_that("bulk_create_folders creates and deletes multiple folders", { + uniq <- sprintf( + "bulk_cf_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + names_vec <- c( + sprintf("%s_1", uniq), sprintf("%s_2", uniq), sprintf("%s_3", uniq) + ) + + result <- bulk_create_folders( + vol_id = TEST_VOL_ID, + folder_names = names_vec, + vb = FALSE + ) + skip_if_null_response(result, "bulk_create_folders live API") + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 3) + expect_equal(result$input, names_vec) + expect_true(all(result$status == "success")) + + ids <- vapply(result$result, function(r) { + if (is.null(r) || is.null(r$id)) NA_real_ else as.numeric(r$id) + }, numeric(1)) + on.exit({ + for (id in ids) { + if (!is.na(id)) { + try( + delete_folder(vol_id = TEST_VOL_ID, folder_id = as.integer(id), vb = FALSE), + silent = TRUE + ) + } + } + }, add = TRUE) + + expect_false(any(is.na(ids))) +}) diff --git a/tests/testthat/test-bulk_create_records.R b/tests/testthat/test-bulk_create_records.R new file mode 100644 index 00000000..ced70f77 --- /dev/null +++ b/tests/testthat/test-bulk_create_records.R @@ -0,0 +1,51 @@ +# bulk_create_records() ------------------------------------------------------- +login_test_account() + +test_that("bulk_create_records rejects invalid args", { + expect_error(bulk_create_records(vol_id = -1, record_names = "a", category_id = 1L)) + expect_error(bulk_create_records(vol_id = 1, record_names = character(0), category_id = 1L)) + expect_error(bulk_create_records(vol_id = 1, record_names = c("a", "a"), category_id = 6L)) + expect_error(bulk_create_records( + vol_id = 1, record_names = c("a", "b"), category_id = rep(TEST_CATEGORY_ID, 3L) + )) +}) + +test_that("bulk_create_records creates then deletes multiple records", { + uniq <- sprintf( + "bulk_cr_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + names_vec <- c( + sprintf("%s_1", uniq), sprintf("%s_2", uniq), sprintf("%s_3", uniq) + ) + + result <- bulk_create_records( + vol_id = TEST_VOL_ID, + record_names = names_vec, + category_id = TEST_CATEGORY_ID, + vb = FALSE + ) + skip_if_null_response(result, "bulk_create_records live API") + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 3) + expect_equal(result$input, names_vec) + expect_true(all(result$status == "success")) + + ids <- vapply(result$result, function(r) { + if (is.null(r) || is.null(r$record_id)) NA_real_ else as.numeric(r$record_id) + }, numeric(1)) + on.exit({ + for (id in ids) { + if (!is.na(id)) { + try( + delete_volume_record(vol_id = TEST_VOL_ID, record_id = as.integer(id), vb = FALSE), + silent = TRUE + ) + } + } + }, add = TRUE) + + expect_false(any(is.na(ids))) +}) diff --git a/tests/testthat/test-bulk_create_sessions.R b/tests/testthat/test-bulk_create_sessions.R new file mode 100644 index 00000000..b40766ca --- /dev/null +++ b/tests/testthat/test-bulk_create_sessions.R @@ -0,0 +1,50 @@ +# bulk_create_sessions() ------------------------------------------------------ +login_test_account() + +test_that("bulk_create_sessions rejects invalid args", { + expect_error(bulk_create_sessions(vol_id = -1, session_names = "a")) + expect_error(bulk_create_sessions(vol_id = 1, session_names = character(0))) + expect_error(bulk_create_sessions(vol_id = 1, session_names = c("a", "a"))) + expect_error(bulk_create_sessions( + vol_id = 1, session_names = c("a", "b"), source_date = rep("2024-01-01", 3) + )) +}) + +test_that("bulk_create_sessions creates and deletes multiple sessions", { + uniq <- sprintf( + "bulk_cs_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + names_vec <- c( + sprintf("%s_1", uniq), sprintf("%s_2", uniq), sprintf("%s_3", uniq) + ) + + result <- bulk_create_sessions( + vol_id = TEST_VOL_ID, + session_names = names_vec, + vb = FALSE + ) + skip_if_null_response(result, "bulk_create_sessions live API") + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 3) + expect_equal(result$input, names_vec) + expect_true(all(result$status == "success")) + + ids <- vapply(result$result, function(r) { + if (is.null(r) || is.null(r$id)) NA_real_ else as.numeric(r$id) + }, numeric(1)) + on.exit({ + for (id in ids) { + if (!is.na(id)) { + try( + delete_session(vol_id = TEST_VOL_ID, session_id = as.integer(id), vb = FALSE), + silent = TRUE + ) + } + } + }, add = TRUE) + + expect_false(any(is.na(ids))) +}) diff --git a/tests/testthat/test-bulk_delete_files.R b/tests/testthat/test-bulk_delete_files.R new file mode 100644 index 00000000..137a9bd1 --- /dev/null +++ b/tests/testthat/test-bulk_delete_files.R @@ -0,0 +1,52 @@ +# bulk_delete_files() --------------------------------------------------------- +login_test_account() + +# Argument validation --------------------------------------------------------- + +test_that("bulk_delete_files rejects invalid args", { + expect_error(bulk_delete_files( + vol_id = -1, session_id = 1, file_ids = 1 + )) + expect_error(bulk_delete_files( + vol_id = 1, session_id = 0, file_ids = 1 + )) + expect_error(bulk_delete_files( + vol_id = 1, session_id = 1, file_ids = numeric(0) + )) + expect_error(bulk_delete_files( + vol_id = 1, session_id = 1, file_ids = c(1, -2) + )) + expect_error(bulk_delete_files( + vol_id = 1, session_id = 1, file_ids = c(1, NA) + )) + expect_error(bulk_delete_files( + vol_id = 1, session_id = 1, file_ids = "1" + )) +}) + +# End-to-end ------------------------------------------------------------------ + +test_that("bulk_delete_files fast-fails on non-existent file ids", { + session <- create_session( + vol_id = TEST_VOL_ID, name = "bulk_delete_files fail test", vb = FALSE + ) + skip_if_null_response(session, "create_session for bulk_delete_files") + on.exit( + delete_session(vol_id = TEST_VOL_ID, session_id = session$id, vb = FALSE), + add = TRUE + ) + + partial <- tryCatch( + bulk_delete_files( + vol_id = TEST_VOL_ID, + session_id = session$id, + file_ids = c(999999999, 999999998), + vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[1], "failed") + expect_equal(partial$status[2], "pending") +}) diff --git a/tests/testthat/test-bulk_delete_folders.R b/tests/testthat/test-bulk_delete_folders.R new file mode 100644 index 00000000..81f030f2 --- /dev/null +++ b/tests/testthat/test-bulk_delete_folders.R @@ -0,0 +1,53 @@ +# bulk_delete_folders() ------------------------------------------------------- +login_test_account() + +# Argument validation --------------------------------------------------------- + +test_that("bulk_delete_folders rejects invalid args", { + expect_error(bulk_delete_folders(vol_id = -1, folder_ids = 1)) + expect_error(bulk_delete_folders(vol_id = 1, folder_ids = numeric(0))) + expect_error(bulk_delete_folders(vol_id = 1, folder_ids = c(1, -2))) + expect_error(bulk_delete_folders(vol_id = 1, folder_ids = c(1, NA))) + expect_error(bulk_delete_folders(vol_id = 1, folder_ids = c(1.5, 2))) + expect_error(bulk_delete_folders(vol_id = 1, folder_ids = "1")) +}) + +# End-to-end ------------------------------------------------------------------ + +test_that("bulk_delete_folders deletes multiple folders", { + ids <- vapply(seq_len(3), function(i) { + f <- create_folder( + vol_id = TEST_VOL_ID, + name = sprintf("bulk_delete_folders test %d", i), + vb = FALSE + ) + if (is.null(f)) NA_real_ else as.numeric(f$id) + }, numeric(1)) + + if (any(is.na(ids))) { + testthat::skip("Could not create test folders on staging.") + } + + result <- bulk_delete_folders( + vol_id = TEST_VOL_ID, folder_ids = ids, vb = FALSE + ) + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 3) + expect_true(all(result$status == "success")) +}) + +test_that("bulk_delete_folders fast-fails on non-existent folder", { + partial <- tryCatch( + bulk_delete_folders( + vol_id = TEST_VOL_ID, + folder_ids = c(999999999, 999999998), + vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[1], "failed") + expect_equal(partial$status[2], "pending") +}) diff --git a/tests/testthat/test-bulk_delete_records.R b/tests/testthat/test-bulk_delete_records.R new file mode 100644 index 00000000..1d47f767 --- /dev/null +++ b/tests/testthat/test-bulk_delete_records.R @@ -0,0 +1,89 @@ +# bulk_delete_records() ------------------------------------------------------- +login_test_account() + +test_that("bulk_delete_records rejects invalid args", { + expect_error(bulk_delete_records(vol_id = -1, record_ids = 1L)) + expect_error(bulk_delete_records(vol_id = 1, record_ids = numeric(0))) + expect_error(bulk_delete_records(vol_id = 1, record_ids = c(1L, -2L))) + expect_error(bulk_delete_records(vol_id = 1, record_ids = c(1L, NA))) +}) + +test_that("bulk_delete_records deletes multiple records", { + uniq <- sprintf( + "bulk_delrec_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + created <- bulk_create_records( + vol_id = TEST_VOL_ID, + record_names = c(sprintf("%s_1", uniq), sprintf("%s_2", uniq)), + category_id = TEST_CATEGORY_ID, + vb = FALSE + ) + skip_if_null_response(created, "bulk_create_records for bulk_delete_records") + + ids <- vapply(created$result, function(r) as.numeric(r$record_id), numeric(1)) + + result <- bulk_delete_records(vol_id = TEST_VOL_ID, record_ids = ids, vb = FALSE) + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 2) + expect_true(all(result$status == "success")) +}) + +test_that("bulk_delete_records fast-fails on missing record id", { + uniq <- sprintf( + "bulk_delrec_ff_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + one <- create_volume_record( + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, + name = sprintf("%s_single", uniq), + vb = FALSE + ) + skip_if_null_response(one, "create_volume_record") + + rid <- as.integer(one$record_id) + on.exit(try(delete_volume_record(TEST_VOL_ID, rid, vb = FALSE), silent = TRUE), add = TRUE) + + mixed <- c(rid, TEST_MISSING_ID) + + partial <- tryCatch( + bulk_delete_records(vol_id = TEST_VOL_ID, record_ids = mixed, vb = FALSE), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[[1]], "success") + expect_equal(partial$status[[2]], "failed") +}) + +test_that("bulk_delete_records on_error collect runs all rows", { + uniq <- sprintf( + "bulk_delrec_coll_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + created <- bulk_create_records( + vol_id = TEST_VOL_ID, + record_names = c(sprintf("%s_1", uniq), sprintf("%s_2", uniq)), + category_id = TEST_CATEGORY_ID, + vb = FALSE + ) + skip_if_null_response(created, "bulk_create_records") + + ids <- vapply(created$result, function(r) as.numeric(r$record_id), numeric(1)) + + mixed <- c(ids[[1]], TEST_MISSING_ID, ids[[2]]) + result <- bulk_delete_records( + vol_id = TEST_VOL_ID, + record_ids = mixed, + vb = FALSE, + on_error = "collect" + ) + + expect_s3_class(result, "tbl_df") + expect_equal(result$status, c("success", "failed", "success")) +}) diff --git a/tests/testthat/test-bulk_delete_sessions.R b/tests/testthat/test-bulk_delete_sessions.R new file mode 100644 index 00000000..6ad1e446 --- /dev/null +++ b/tests/testthat/test-bulk_delete_sessions.R @@ -0,0 +1,105 @@ +# bulk_delete_sessions() ------------------------------------------------------ +login_test_account() + +# Argument validation --------------------------------------------------------- + +test_that("bulk_delete_sessions rejects invalid args", { + expect_error(bulk_delete_sessions(vol_id = -1, session_ids = 1)) + expect_error(bulk_delete_sessions(vol_id = 1, session_ids = numeric(0))) + expect_error(bulk_delete_sessions(vol_id = 1, session_ids = c(1, -2))) + expect_error(bulk_delete_sessions(vol_id = 1, session_ids = c(1, NA))) + expect_error(bulk_delete_sessions(vol_id = 1, session_ids = c(1.5, 2))) + expect_error(bulk_delete_sessions(vol_id = 1, session_ids = "1")) +}) + +# End-to-end ------------------------------------------------------------------ + +test_that("bulk_delete_sessions deletes multiple sessions", { + ids <- vapply(seq_len(3), function(i) { + s <- create_session( + vol_id = TEST_VOL_ID, + name = sprintf("bulk_delete_sessions test %d", i), + vb = FALSE + ) + if (is.null(s)) NA_real_ else as.numeric(s$id) + }, numeric(1)) + + if (any(is.na(ids))) { + testthat::skip("Could not create test sessions on staging.") + } + + result <- bulk_delete_sessions( + vol_id = TEST_VOL_ID, session_ids = ids, vb = FALSE + ) + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 3) + expect_true(all(result$status == "success")) +}) + +test_that("bulk_delete_sessions fast-fails and resume completes the rest", { + ids <- vapply(seq_len(2), function(i) { + s <- create_session( + vol_id = TEST_VOL_ID, + name = sprintf("bulk_delete_sessions resume %d", i), + vb = FALSE + ) + if (is.null(s)) NA_real_ else as.numeric(s$id) + }, numeric(1)) + + if (any(is.na(ids))) { + testthat::skip("Could not create test sessions on staging.") + } + on.exit({ + for (id in ids) { + try(delete_session(TEST_VOL_ID, id, vb = FALSE), silent = TRUE) + } + }, add = TRUE) + + # Put a non-existent id between the two real ones; delete_session returns + # FALSE on it, which fast-fails the bulk run. + mixed <- c(ids[1], 999999999, ids[2]) + + partial <- tryCatch( + bulk_delete_sessions( + vol_id = TEST_VOL_ID, session_ids = mixed, vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[1], "success") + expect_equal(partial$status[2], "failed") + expect_equal(partial$status[3], "pending") +}) + +test_that("bulk_delete_sessions on_error collect runs all rows", { + ids <- vapply(seq_len(2), function(i) { + s <- create_session( + vol_id = TEST_VOL_ID, + name = sprintf("bulk_delete_sessions collect %d", i), + vb = FALSE + ) + if (is.null(s)) NA_real_ else as.numeric(s$id) + }, numeric(1)) + + if (any(is.na(ids))) { + testthat::skip("Could not create test sessions on staging.") + } + on.exit({ + for (id in ids) { + try(delete_session(TEST_VOL_ID, id, vb = FALSE), silent = TRUE) + } + }, add = TRUE) + + mixed <- c(ids[1], 999999999, ids[2]) + result <- bulk_delete_sessions( + vol_id = TEST_VOL_ID, + session_ids = mixed, + vb = FALSE, + on_error = "collect" + ) + + expect_s3_class(result, "tbl_df") + expect_equal(result$status, c("success", "failed", "success")) +}) diff --git a/tests/testthat/test-bulk_rename_files.R b/tests/testthat/test-bulk_rename_files.R new file mode 100644 index 00000000..30902b95 --- /dev/null +++ b/tests/testthat/test-bulk_rename_files.R @@ -0,0 +1,123 @@ +# bulk_rename_files() --------------------------------------------------------- +login_test_account() + +test_that("bulk_rename_files rejects invalid args", { + expect_error(bulk_rename_files(vol_id = -1, session_id = 1L, file_ids = 1L, new_names = "a")) + expect_error(bulk_rename_files(vol_id = 1L, session_id = 1L, file_ids = integer(0), new_names = character(0))) + expect_error(bulk_rename_files(vol_id = 1L, session_id = 1L, file_ids = c(1L, 2L), new_names = "a")) + expect_error(bulk_rename_files(vol_id = 1L, session_id = 1L, file_ids = c(1L, 1L), new_names = c("a", "b"))) +}) + +test_that("bulk_rename_files renames multiple session assets", { + uniq <- sprintf( + "bulk_rfile_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + sid <- make_test_session(sprintf("%s_sess", uniq), vb = FALSE) + skip_if_null_response(sid, "make_test_session for bulk_rename_files") + + fn1 <- sprintf("%s_one.txt", uniq) + fn2 <- sprintf("%s_two.txt", uniq) + aid1 <- upload_test_session_asset(sid, file_basename = fn1, vb = FALSE) + aid2 <- upload_test_session_asset(sid, file_basename = fn2, vb = FALSE) + skip_if_null_response(aid1, "upload asset 1") + skip_if_null_response(aid2, "upload asset 2") + + new_names <- c( + sprintf("%s_one_renamed.txt", uniq), + sprintf("%s_two_renamed.txt", uniq) + ) + + result <- bulk_rename_files( + vol_id = TEST_VOL_ID, + session_id = sid, + file_ids = c(aid1, aid2), + new_names = new_names, + vb = FALSE + ) + + skip_if_null_response(result, "bulk_rename_files live API") + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 2) + expect_equal(result$input, c(aid1, aid2)) + expect_true(all(result$status == "success")) + + file_ids <- c(aid1, aid2) + for (k in seq_along(file_ids)) { + file_detail <- get_session_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_ids[[k]], + vb = FALSE + ) + skip_if_null_response( + file_detail, + sprintf("get_session_file after rename (file %d)", k) + ) + nm <- new_names[[k]] + expect_true( + identical(file_detail$name, nm) || + identical(file_detail$name, tools::file_path_sans_ext(nm)), + info = sprintf( + 'Expected name "%s" or stem "%s"; got "%s"', + nm, tools::file_path_sans_ext(nm), file_detail$name + ) + ) + } +}) + +test_that("bulk_rename_files fast-fails on bad file id", { + sid <- make_test_session("bulk_rename_files resume sess", vb = FALSE) + skip_if_null_response(sid, "make_test_session") + + fn1 <- "bulk_rf_resume_a.txt" + aid <- upload_test_session_asset(sid, file_basename = fn1, vb = FALSE) + skip_if_null_response(aid, "upload asset") + + mixed <- c(aid, TEST_MISSING_ID) + nn <- c("bulk_rf_resume_a_renamed.txt", "bulk_rf_resume_b.txt") + + partial <- tryCatch( + bulk_rename_files( + vol_id = TEST_VOL_ID, + session_id = sid, + file_ids = mixed, + new_names = nn, + vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[[1]], "success") + expect_equal(partial$status[[2]], "failed") +}) + +test_that("bulk_rename_files on_error collect runs all rows", { + sid <- make_test_session("bulk_rename_files collect sess", vb = FALSE) + skip_if_null_response(sid, "make_test_session") + + fn1 <- "bulk_rf_collect_a.txt" + fn2 <- "bulk_rf_collect_b.txt" + aid1 <- upload_test_session_asset(sid, file_basename = fn1, vb = FALSE) + aid2 <- upload_test_session_asset(sid, file_basename = fn2, vb = FALSE) + skip_if_null_response(aid1, "upload 1") + skip_if_null_response(aid2, "upload 2") + + mixed <- c(aid1, TEST_MISSING_ID, aid2) + nn <- c("bulk_rf_c1.txt", "bulk_rf_c2.txt", "bulk_rf_c3.txt") + + result <- bulk_rename_files( + vol_id = TEST_VOL_ID, + session_id = sid, + file_ids = mixed, + new_names = nn, + vb = FALSE, + on_error = "collect" + ) + + expect_s3_class(result, "tbl_df") + expect_equal(result$status, c("success", "failed", "success")) +}) diff --git a/tests/testthat/test-bulk_rename_folders.R b/tests/testthat/test-bulk_rename_folders.R new file mode 100644 index 00000000..75cc2776 --- /dev/null +++ b/tests/testthat/test-bulk_rename_folders.R @@ -0,0 +1,122 @@ +# bulk_rename_folders() ------------------------------------------------------- +login_test_account() + +test_that("bulk_rename_folders rejects invalid args", { + expect_error(bulk_rename_folders(vol_id = -1, folder_ids = 1L, new_names = "a")) + expect_error(bulk_rename_folders(vol_id = 1, folder_ids = integer(0), new_names = character(0))) + expect_error(bulk_rename_folders(vol_id = 1L, folder_ids = c(1L, 2L), new_names = "a")) + expect_error(bulk_rename_folders(vol_id = 1L, folder_ids = c(1L, 1L), new_names = c("a", "b"))) +}) + +test_that("bulk_rename_folders renames multiple folders", { + uniq <- sprintf( + "bulk_rf_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + fids <- integer(3) + for (i in seq_along(fids)) { + nm <- sprintf("%s_%d", uniq, i) + fid <- make_test_folder(nm, vb = FALSE) + skip_if_null_response(fid, "make_test_folder for bulk_rename_folders") + fids[[i]] <- fid + } + + new_names <- c( + sprintf("%s_new_a", uniq), + sprintf("%s_new_b", uniq), + sprintf("%s_new_c", uniq) + ) + + result <- bulk_rename_folders( + vol_id = TEST_VOL_ID, + folder_ids = fids, + new_names = new_names, + vb = FALSE + ) + + skip_if_null_response(result, "bulk_rename_folders live API") + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 3) + expect_equal(result$input, fids) + expect_true(all(result$status == "success")) + + for (k in seq_along(fids)) { + fol <- get_folder_by_id(vol_id = TEST_VOL_ID, folder_id = fids[[k]], vb = FALSE) + skip_if_null_response(fol, "get_folder_by_id after rename") + expect_equal(fol$name, new_names[[k]]) + } +}) + +test_that("bulk_rename_folders fast-fails on bad folder id", { + ids <- vapply(seq_len(2), function(i) { + f <- create_folder( + vol_id = TEST_VOL_ID, + name = sprintf("bulk_rename_folders resume %d", i), + vb = FALSE + ) + if (is.null(f)) NA_real_ else as.numeric(f$id) + }, numeric(1)) + + if (any(is.na(ids))) { + testthat::skip("Could not create test folders on staging.") + } + on.exit({ + for (id in ids) { + try(delete_folder(TEST_VOL_ID, id, vb = FALSE), silent = TRUE) + } + }, add = TRUE) + + mixed <- c(ids[[1]], TEST_MISSING_ID, ids[[2]]) + nn <- c("x", "y", "z") + + partial <- tryCatch( + bulk_rename_folders( + vol_id = TEST_VOL_ID, + folder_ids = mixed, + new_names = nn, + vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[[1]], "success") + expect_equal(partial$status[[2]], "failed") + expect_equal(partial$status[[3]], "pending") +}) + +test_that("bulk_rename_folders on_error collect runs all rows", { + ids <- vapply(seq_len(2), function(i) { + f <- create_folder( + vol_id = TEST_VOL_ID, + name = sprintf("bulk_rename_folders collect %d", i), + vb = FALSE + ) + if (is.null(f)) NA_real_ else as.numeric(f$id) + }, numeric(1)) + + if (any(is.na(ids))) { + testthat::skip("Could not create test folders on staging.") + } + on.exit({ + for (id in ids) { + try(delete_folder(TEST_VOL_ID, id, vb = FALSE), silent = TRUE) + } + }, add = TRUE) + + mixed <- c(ids[[1]], TEST_MISSING_ID, ids[[2]]) + nn <- c("c1", "c2", "c3") + + result <- bulk_rename_folders( + vol_id = TEST_VOL_ID, + folder_ids = mixed, + new_names = nn, + vb = FALSE, + on_error = "collect" + ) + + expect_s3_class(result, "tbl_df") + expect_equal(result$status, c("success", "failed", "success")) +}) diff --git a/tests/testthat/test-bulk_rename_sessions.R b/tests/testthat/test-bulk_rename_sessions.R new file mode 100644 index 00000000..73372029 --- /dev/null +++ b/tests/testthat/test-bulk_rename_sessions.R @@ -0,0 +1,122 @@ +# bulk_rename_sessions() ------------------------------------------------------ +login_test_account() + +test_that("bulk_rename_sessions rejects invalid args", { + expect_error(bulk_rename_sessions(vol_id = -1, session_ids = 1L, new_names = "a")) + expect_error(bulk_rename_sessions(vol_id = 1, session_ids = integer(0), new_names = character(0))) + expect_error(bulk_rename_sessions(vol_id = 1L, session_ids = c(1L, 2L), new_names = "a")) + expect_error(bulk_rename_sessions(vol_id = 1L, session_ids = c(1L, 1L), new_names = c("a", "b"))) +}) + +test_that("bulk_rename_sessions renames multiple sessions", { + uniq <- sprintf( + "bulk_rs_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + sids <- integer(3) + for (i in seq_along(sids)) { + nm <- sprintf("%s_%d", uniq, i) + sid <- make_test_session(nm, vb = FALSE) + skip_if_null_response(sid, "make_test_session for bulk_rename_sessions") + sids[[i]] <- sid + } + + new_names <- c( + sprintf("%s_new_a", uniq), + sprintf("%s_new_b", uniq), + sprintf("%s_new_c", uniq) + ) + + result <- bulk_rename_sessions( + vol_id = TEST_VOL_ID, + session_ids = sids, + new_names = new_names, + vb = FALSE + ) + + skip_if_null_response(result, "bulk_rename_sessions live API") + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 3) + expect_equal(result$input, sids) + expect_true(all(result$status == "success")) + + for (k in seq_along(sids)) { + sess <- get_session_by_id(vol_id = TEST_VOL_ID, session_id = sids[[k]], vb = FALSE) + skip_if_null_response(sess, "get_session_by_id after rename") + expect_equal(sess$name, new_names[[k]]) + } +}) + +test_that("bulk_rename_sessions fast-fails on bad session id", { + ids <- vapply(seq_len(2), function(i) { + s <- create_session( + vol_id = TEST_VOL_ID, + name = sprintf("bulk_rename_sessions resume %d", i), + vb = FALSE + ) + if (is.null(s)) NA_real_ else as.numeric(s$id) + }, numeric(1)) + + if (any(is.na(ids))) { + testthat::skip("Could not create test sessions on staging.") + } + on.exit({ + for (id in ids) { + try(delete_session(TEST_VOL_ID, id, vb = FALSE), silent = TRUE) + } + }, add = TRUE) + + mixed <- c(ids[[1]], TEST_MISSING_ID, ids[[2]]) + nn <- c("x", "y", "z") + + partial <- tryCatch( + bulk_rename_sessions( + vol_id = TEST_VOL_ID, + session_ids = mixed, + new_names = nn, + vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[[1]], "success") + expect_equal(partial$status[[2]], "failed") + expect_equal(partial$status[[3]], "pending") +}) + +test_that("bulk_rename_sessions on_error collect runs all rows", { + ids <- vapply(seq_len(2), function(i) { + s <- create_session( + vol_id = TEST_VOL_ID, + name = sprintf("bulk_rename_sessions collect %d", i), + vb = FALSE + ) + if (is.null(s)) NA_real_ else as.numeric(s$id) + }, numeric(1)) + + if (any(is.na(ids))) { + testthat::skip("Could not create test sessions on staging.") + } + on.exit({ + for (id in ids) { + try(delete_session(TEST_VOL_ID, id, vb = FALSE), silent = TRUE) + } + }, add = TRUE) + + mixed <- c(ids[[1]], TEST_MISSING_ID, ids[[2]]) + nn <- c("c1", "c2", "c3") + + result <- bulk_rename_sessions( + vol_id = TEST_VOL_ID, + session_ids = mixed, + new_names = nn, + vb = FALSE, + on_error = "collect" + ) + + expect_s3_class(result, "tbl_df") + expect_equal(result$status, c("success", "failed", "success")) +}) diff --git a/tests/testthat/test-bulk_unassign_records.R b/tests/testthat/test-bulk_unassign_records.R new file mode 100644 index 00000000..d3e4bf81 --- /dev/null +++ b/tests/testthat/test-bulk_unassign_records.R @@ -0,0 +1,102 @@ +# bulk_unassign_records() ----------------------------------------------------- +login_test_account() + +test_that("bulk_unassign_records rejects invalid args", { + expect_error(bulk_unassign_records(vol_id = -1, session_id = 1L, record_ids = 1L)) + expect_error(bulk_unassign_records(vol_id = 1L, session_id = -1L, record_ids = 1L)) + expect_error(bulk_unassign_records(vol_id = 1L, session_id = 1L, record_ids = numeric(0))) +}) + +test_that("bulk_unassign_records removes defaults for multiple records", { + uniq <- sprintf( + "bulk_ur_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + sid <- make_test_session(sprintf("%s_sess", uniq), vb = FALSE) + skip_if_null_response(sid, "make_test_session") + + r1 <- make_test_record(sprintf("%s_r1", uniq), vb = FALSE) + r2 <- make_test_record(sprintf("%s_r2", uniq), vb = FALSE) + skip_if_null_response(r1, "make_test_record 1") + skip_if_null_response(r2, "make_test_record 2") + + asg <- bulk_assign_records( + vol_id = TEST_VOL_ID, + session_id = sid, + record_ids = c(r1, r2), + vb = FALSE + ) + expect_true(all(asg$status == "success")) + + result <- bulk_unassign_records( + vol_id = TEST_VOL_ID, + session_id = sid, + record_ids = c(r1, r2), + vb = FALSE + ) + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 2) + expect_true(all(result$status == "success")) +}) + +test_that("bulk_unassign_records fast-fails when record is not a default", { + sid <- make_test_session("bulk_unassign_records ff", vb = FALSE) + skip_if_null_response(sid, "make_test_session") + + r1 <- make_test_record("bulk_unassign_records ff r", vb = FALSE) + skip_if_null_response(r1, "make_test_record") + + add_default_record_to_session(TEST_VOL_ID, sid, r1, vb = FALSE) + + mixed <- c(r1, TEST_MISSING_ID) + + partial <- tryCatch( + bulk_unassign_records( + vol_id = TEST_VOL_ID, + session_id = sid, + record_ids = mixed, + vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[[1]], "success") + expect_equal(partial$status[[2]], "failed") +}) + +test_that("bulk_unassign_records on_error collect runs all rows", { + sid <- make_test_session("bulk_unassign_records collect", vb = FALSE) + skip_if_null_response(sid, "make_test_session") + + created <- bulk_create_records( + vol_id = TEST_VOL_ID, + record_names = c("bulk_ur_c1", "bulk_ur_c2"), + category_id = TEST_CATEGORY_ID, + vb = FALSE + ) + skip_if_null_response(created, "bulk_create_records") + + ids <- vapply(created$result, function(r) as.integer(r$record_id), integer(1)) + on.exit({ + for (id in ids) { + try(delete_volume_record(TEST_VOL_ID, id, vb = FALSE), silent = TRUE) + } + }, add = TRUE) + + bulk_assign_records(TEST_VOL_ID, sid, ids, vb = FALSE) + + mixed <- c(ids[[1]], TEST_MISSING_ID, ids[[2]]) + result <- bulk_unassign_records( + vol_id = TEST_VOL_ID, + session_id = sid, + record_ids = mixed, + vb = FALSE, + on_error = "collect" + ) + + expect_s3_class(result, "tbl_df") + expect_equal(result$status, c("success", "failed", "success")) +}) diff --git a/tests/testthat/test-bulk_upload_files.R b/tests/testthat/test-bulk_upload_files.R new file mode 100644 index 00000000..06a0a38f --- /dev/null +++ b/tests/testthat/test-bulk_upload_files.R @@ -0,0 +1,339 @@ +# bulk_upload_files() --------------------------------------------------------- +login_test_account() + +# Argument validation (no API) ------------------------------------------------ + +test_that("bulk_upload_files rejects invalid args", { + tf <- tempfile(fileext = ".txt") + writeLines("ok", tf) + on.exit(unlink(tf), add = TRUE) + expect_error(bulk_upload_files( + vol_id = 1, file_paths = tf + ), regexp = "Exactly one of session_id and folder_id") + expect_error(bulk_upload_files( + vol_id = 1, session_id = 1, folder_id = 2, file_paths = tf + ), regexp = "Exactly one of session_id and folder_id") + + expect_error(bulk_upload_files( + vol_id = -1, session_id = 1, file_paths = "x" + )) + expect_error(bulk_upload_files( + vol_id = 1, session_id = 0, file_paths = "x" + )) + expect_error(bulk_upload_files( + vol_id = 1, session_id = 1, file_paths = character(0) + )) + expect_error(bulk_upload_files( + vol_id = 1, session_id = 1, file_paths = c("/nope/does/not/exist") + )) + expect_error(bulk_upload_files( + vol_id = 1, session_id = 1, file_paths = c("a", NA) + )) +}) + +# Internal helpers ------------------------------------------------------------ + +test_that("init_bulk_tibble initializes one pending row per input", { + t <- databraryr:::init_bulk_tibble(c("a", "b", "c")) + expect_s3_class(t, "tbl_df") + expect_equal(nrow(t), 3) + expect_equal(t$status, rep("pending", 3)) + expect_true(all(is.na(t$error))) + expect_true(all(is.na(t$reason))) + expect_equal(length(t$result), 3) +}) + +test_that("bulk_apply succeeds when fn returns non-NULL", { + state <- databraryr:::bulk_apply( + inputs = c(1, 2, 3), + fn = function(x) x * 10 + ) + expect_equal(state$status, rep("success", 3)) + expect_equal(unlist(state$result), c(10, 20, 30)) +}) + +test_that("bulk_apply fast-fails and carries partial state", { + err <- tryCatch( + databraryr:::bulk_apply( + inputs = c(1, 2, 3), + fn = function(x) if (x == 2) NULL else x + ), + databraryr_bulk_error = function(e) e + ) + expect_s3_class(err, "databraryr_bulk_error") + expect_equal(err$failed_input, 2) + expect_equal(err$partial$status, c("success", "failed", "pending")) + expect_equal(err$partial$result[[1]], 1) + expect_false(is.na(err$partial$error[2])) +}) + +test_that("bulk_apply respects custom is_failure predicate", { + err <- tryCatch( + databraryr:::bulk_apply( + inputs = c(1, 2), + fn = function(x) FALSE, + is_failure = function(res) isFALSE(res) + ), + databraryr_bulk_error = function(e) e + ) + expect_s3_class(err, "databraryr_bulk_error") + expect_equal(err$failed_input, 1) +}) + +test_that("bulk_apply catches errors thrown by fn", { + err <- tryCatch( + databraryr:::bulk_apply( + inputs = c(1, 2), + fn = function(x) stop("boom") + ), + databraryr_bulk_error = function(e) e + ) + expect_s3_class(err, "databraryr_bulk_error") + expect_match(err$partial$error[1], "boom") +}) + +test_that("bulk_apply collect mode records failures and continues", { + state <- databraryr:::bulk_apply( + inputs = c(1, 2, 3), + fn = function(x) if (x == 2) NULL else x * 10, + on_error = "collect" + ) + expect_equal(state$status, c("success", "failed", "success")) + expect_equal(state$result[[1]], 10) + expect_true(is.null(state$result[[2]])) + expect_equal(state$result[[3]], 30) + expect_false(is.na(state$error[2])) + expect_true(is.na(state$error[1])) + expect_true(is.na(state$error[3])) +}) + +test_that("bulk_apply retries failed invocations up to max_retries", { + n_try <- 0L + state <- databraryr:::bulk_apply( + inputs = 1, + fn = function(x) { + n_try <<- n_try + 1L + if (n_try < 3L) NULL else 99L + }, + max_retries = 2L + ) + expect_equal(n_try, 3L) + expect_equal(state$status, "success") + expect_equal(state$result[[1]], 99L) + + n_try2 <- 0L + err <- tryCatch( + databraryr:::bulk_apply( + inputs = 1, + fn = function(x) { + n_try2 <<- n_try2 + 1L + NULL + }, + max_retries = 1L + ), + databraryr_bulk_error = function(e) e + ) + expect_equal(n_try2, 2L) + expect_s3_class(err, "databraryr_bulk_error") +}) + +# End-to-end live API tests --------------------------------------------------- + +test_that("bulk_upload_files uploads multiple files end-to-end", { + session <- create_session( + vol_id = TEST_VOL_ID, name = "bulk_upload test", vb = FALSE + ) + skip_if_null_response(session, "create_session for bulk_upload_files") + on.exit( + delete_session(vol_id = TEST_VOL_ID, session_id = session$id, vb = FALSE), + add = TRUE + ) + + paths <- vapply(seq_len(3), function(i) { + p <- tempfile(pattern = sprintf("bulk_%d_", i), fileext = ".txt") + writeLines(strrep("x", 512L), p, useBytes = FALSE) + p + }, character(1)) + on.exit(unlink(paths), add = TRUE) + + result <- bulk_upload_files( + vol_id = TEST_VOL_ID, + session_id = session$id, + file_paths = paths, + preflight = FALSE, + vb = FALSE + ) + skip_if_null_response(result, "bulk_upload_files e2e") + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 3) + expect_equal(result$input, paths) + expect_true(all(result$status == "success")) +}) + +test_that("bulk_upload_files uploads multiple files to a folder end-to-end", { + fid <- make_test_folder("bulk_upload folder e2e", vb = FALSE) + skip_if_null_response(fid, "make_test_folder for bulk_upload folder e2e") + + paths <- vapply(seq_len(2), function(i) { + p <- tempfile(pattern = sprintf("bulk_folder_%d_", i), fileext = ".txt") + writeLines(strrep("x", 512L), p, useBytes = FALSE) + p + }, character(1)) + on.exit(unlink(paths), add = TRUE) + + result <- bulk_upload_files( + vol_id = TEST_VOL_ID, + session_id = NULL, + file_paths = paths, + folder_id = fid, + preflight = FALSE, + vb = FALSE + ) + skip_if_null_response(result, "bulk_upload_files folder e2e") + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 2) + expect_equal(result$input, paths) + expect_true(all(result$status == "success")) +}) + +test_that("bulk_upload_files preflight skips duplicate filenames", { + session <- create_session( + vol_id = TEST_VOL_ID, name = "bulk_upload preflight test", vb = FALSE + ) + skip_if_null_response(session, "create_session for preflight test") + on.exit( + delete_session(vol_id = TEST_VOL_ID, session_id = session$id, vb = FALSE), + add = TRUE + ) + + p <- tempfile(pattern = "preflight_", fileext = ".txt") + writeLines(strrep("x", 512L), p, useBytes = FALSE) + on.exit(unlink(p), add = TRUE) + + first <- bulk_upload_files( + vol_id = TEST_VOL_ID, session_id = session$id, file_paths = p, + preflight = FALSE, vb = FALSE + ) + skip_if_null_response(first, "first upload for preflight test") + expect_true(first$status == "success") + + # Listing used by preflight can lag behind upload_file success on staging. + bn <- basename(p) + deadline <- Sys.time() + 60 + visible <- FALSE + while (Sys.time() < deadline) { + dup <- check_duplicate_files_in_session( + vol_id = TEST_VOL_ID, + session_id = session$id, + filenames = bn, + vb = FALSE + ) + if (!is.null(dup) && nrow(dup) == 1L && isTRUE(dup$exists[[1L]])) { + visible <- TRUE + break + } + Sys.sleep(0.5) + } + skip_if(!visible, "upload not yet visible for duplicate preflight on staging") + + again <- bulk_upload_files( + vol_id = TEST_VOL_ID, session_id = session$id, file_paths = p, + preflight = TRUE, vb = FALSE + ) + expect_equal(again$status, "skipped") + expect_equal(again$reason, "duplicate") +}) + +test_that("bulk_upload_files folder preflight skips duplicate filenames", { + fid <- make_test_folder("bulk_upload folder preflight", vb = FALSE) + skip_if_null_response(fid, "make_test_folder for folder preflight") + + p <- tempfile(pattern = "preflight_folder_", fileext = ".txt") + writeLines(strrep("x", 512L), p, useBytes = FALSE) + on.exit(unlink(p), add = TRUE) + + first <- bulk_upload_files( + vol_id = TEST_VOL_ID, + session_id = NULL, + file_paths = p, + folder_id = fid, + preflight = FALSE, + vb = FALSE + ) + skip_if_null_response(first, "first folder upload for preflight test") + expect_true(first$status == "success") + + bn <- basename(p) + deadline <- Sys.time() + 60 + visible <- FALSE + while (Sys.time() < deadline) { + dup <- check_duplicate_files_in_folder( + vol_id = TEST_VOL_ID, + folder_id = fid, + filenames = bn, + vb = FALSE + ) + if (!is.null(dup) && nrow(dup) == 1L && isTRUE(dup$exists[[1L]])) { + visible <- TRUE + break + } + Sys.sleep(0.5) + } + skip_if(!visible, "folder upload not yet visible for duplicate preflight") + + again <- bulk_upload_files( + vol_id = TEST_VOL_ID, + session_id = NULL, + file_paths = p, + folder_id = fid, + preflight = TRUE, + vb = FALSE + ) + expect_equal(again$status, "skipped") + expect_equal(again$reason, "duplicate") +}) + +test_that("bulk_upload_files fast-fails and supports resume", { + session <- create_session( + vol_id = TEST_VOL_ID, name = "bulk_upload resume test", vb = FALSE + ) + skip_if_null_response(session, "create_session for resume test") + on.exit( + delete_session(vol_id = TEST_VOL_ID, session_id = session$id, vb = FALSE), + add = TRUE + ) + + good <- tempfile(pattern = "good_", fileext = ".txt") + writeLines(strrep("x", 512L), good, useBytes = FALSE) + on.exit(unlink(good), add = TRUE) + + bad_inputs <- c(good, good) + partial <- tryCatch( + bulk_upload_files( + vol_id = TEST_VOL_ID, + session_id = 999999999, + file_paths = bad_inputs, + preflight = FALSE, + vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + skip_if(is.null(partial), "expected fast-fail did not occur") + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[1], "failed") + expect_equal(partial$status[2], "pending") + + resumed <- resume_bulk( + partial, + bulk_upload_files, + vol_id = TEST_VOL_ID, + session_id = session$id, + preflight = FALSE, + vb = FALSE + ) + skip_if_null_response(resumed, "bulk_upload_files resume") + expect_true(all(resumed$status == "success")) +}) From 3246a33a2441056cdb10d44c5f0e871a262c739a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Mon, 18 May 2026 12:59:55 +0200 Subject: [PATCH 73/77] docs: expand README and Rmd to include detailed documentation on bulk operations and error handling --- NAMESPACE | 1 - R/aaa.R | 17 +++ R/list_folder_assets.R | 4 +- R/list_session_assets.R | 4 +- R/list_volume_assets.R | 8 +- R/list_volume_session_assets.R | 4 +- R/utils.R | 27 ---- README.Rmd | 136 ++++++++++++++---- README.md | 169 +++++++++++++++-------- man/HHMMSSmmm_to_ms.Rd | 20 --- man/list_volume_assets.Rd | 4 +- tests/testthat/test-list_volume_assets.R | 8 ++ tests/testthat/test-utils.R | 12 -- 13 files changed, 259 insertions(+), 155 deletions(-) delete mode 100644 man/HHMMSSmmm_to_ms.Rd diff --git a/NAMESPACE b/NAMESPACE index dad1795e..d5eebbbc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,6 @@ # Generated by roxygen2: do not edit by hand export("%>%") -export(HHMMSSmmm_to_ms) export(add_default_record_to_session) export(assign_constants) export(assign_record_to_file) diff --git a/R/aaa.R b/R/aaa.R index 102faff8..9f92b091 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -37,3 +37,20 @@ NULL } utils::globalVariables(".data") + +# Internal: nullable API scalars — tibble/map_dfr drop raw NULL columns. +null_to_na_double <- function(x) { + if (is.null(x) || length(x) == 0L) { + return(NA_real_) + } + v <- suppressWarnings(as.numeric(x)) + if (length(v) == 0L || all(is.na(v))) NA_real_ else v[[1L]] +} + +null_to_na_character <- function(x) { + if (is.null(x) || length(x) == 0L) { + return(NA_character_) + } + tc <- suppressWarnings(as.character(x)) + if (length(tc) == 0L) NA_character_ else tc[[1L]] +} diff --git a/R/list_folder_assets.R b/R/list_folder_assets.R index 9f1ffb63..6b1ee8f0 100644 --- a/R/list_folder_assets.R +++ b/R/list_folder_assets.R @@ -85,14 +85,14 @@ list_folder_assets <- function(folder_id = 9807, asset_format_id = format$id, asset_format_name = format$name, format_extension = format$extension, - asset_duration = file$duration, + asset_duration = null_to_na_double(file[["duration"]]), asset_created_at = file$created_at, asset_updated_at = file$updated_at, asset_uploader_id = uploader$id, asset_uploader_first_name = uploader$first_name, asset_uploader_last_name = uploader$last_name, asset_sha1 = file$sha1, - asset_thumbnail_url = file$thumbnail_url + asset_thumbnail_url = null_to_na_character(file[["thumbnail_url"]]) ) }) diff --git a/R/list_session_assets.R b/R/list_session_assets.R index dfeb536c..f6e341f1 100644 --- a/R/list_session_assets.R +++ b/R/list_session_assets.R @@ -88,14 +88,14 @@ list_session_assets <- function(session_id = 9807, asset_format_id = format$id, asset_format_name = format$name, format_extension = format$extension, - asset_duration = file$duration, + asset_duration = null_to_na_double(file[["duration"]]), asset_created_at = file$created_at, asset_updated_at = file$updated_at, asset_uploader_id = uploader$id, asset_uploader_first_name = uploader$first_name, asset_uploader_last_name = uploader$last_name, asset_sha1 = file$sha1, - asset_thumbnail_url = file$thumbnail_url + asset_thumbnail_url = null_to_na_character(file[["thumbnail_url"]]) ) }) diff --git a/R/list_volume_assets.R b/R/list_volume_assets.R index 9d626bb8..8eec11fe 100644 --- a/R/list_volume_assets.R +++ b/R/list_volume_assets.R @@ -9,7 +9,9 @@ NULL #' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Default is NULL. #' -#' @returns A data frame with information about all assets in a volume. +#' @returns A tibble with one row per asset. Columns `asset_duration` and +#' `asset_thumbnail_url` are always present (as `NA` when the API omits them). +#' Other fields come from the volume sessions/files payload. #' #' @inheritParams options_params #' @@ -64,14 +66,14 @@ list_volume_assets <- function(vol_id = 1, asset_mime_type = format$mimetype, asset_format_id = format$id, asset_format_name = format$name, - asset_duration = file$duration, + asset_duration = null_to_na_double(file[["duration"]]), asset_created_at = file$created_at, asset_updated_at = file$updated_at, asset_uploader_id = uploader$id, asset_uploader_first_name = uploader$first_name, asset_uploader_last_name = uploader$last_name, asset_sha1 = file$sha1, - asset_thumbnail_url = file$thumbnail_url, + asset_thumbnail_url = null_to_na_character(file[["thumbnail_url"]]), session_id = session$id, session_name = session$name, session_date = session$source_date, diff --git a/R/list_volume_session_assets.R b/R/list_volume_session_assets.R index e930aff0..234cc9e1 100644 --- a/R/list_volume_session_assets.R +++ b/R/list_volume_session_assets.R @@ -90,14 +90,14 @@ list_volume_session_assets <- asset_mime_type = format$mimetype, asset_format_id = format$id, asset_format_name = format$name, - asset_duration = file$duration, + asset_duration = null_to_na_double(file[["duration"]]), asset_created_at = file$created_at, asset_updated_at = file$updated_at, asset_uploader_id = uploader$id, asset_uploader_first_name = uploader$first_name, asset_uploader_last_name = uploader$last_name, asset_sha1 = file$sha1, - asset_thumbnail_url = file$thumbnail_url, + asset_thumbnail_url = null_to_na_character(file[["thumbnail_url"]]), session_id = session$id, session_name = session$name, session_release = session$release_level diff --git a/R/utils.R b/R/utils.R index deff08f6..247e6ab3 100644 --- a/R/utils.R +++ b/R/utils.R @@ -28,33 +28,6 @@ get_permission_levels <- function(vb = options::opt("vb")) { enums$volume_access_levels } -#---------------------------------------------------------------------------- -#' Convert Timestamp String To ms. -#' -#' @param HHMMSSmmm a string in the format "HH:MM:SS:mmm" -#' -#' @returns A numeric value in ms from the input string. -#' -#' @examples -#' HHMMSSmmm_to_ms() # 01:01:01:333 in ms -#' @export -HHMMSSmmm_to_ms <- function(HHMMSSmmm = "01:01:01:333") { - # Check parameters - if (!is.character(HHMMSSmmm)) { - stop("HHMMSSmmm must be a string.") - } - - if (stringr::str_detect(HHMMSSmmm, "([0-9]{2}):([0-9]{2}):([0-9]{2}):([0-9]{3})")) { - time_segs <- stringr::str_match(HHMMSSmmm, - "([0-9]{2}):([0-9]{2}):([0-9]{2}):([0-9]{3})") - as.numeric(time_segs[5]) + as.numeric(time_segs[4]) * - 1000 + as.numeric(time_segs[3]) * 1000 * 60 + - as.numeric(time_segs[2]) * 1000 * 60 * 60 - } else { - NULL - } -} - #---------------------------------------------------------------------------- #' Show Databrary Release Levels #' diff --git a/README.Rmd b/README.Rmd index e7ccae6b..927875a0 100644 --- a/README.Rmd +++ b/README.Rmd @@ -1,6 +1,3 @@ ---- -output: github_document ---- @@ -15,9 +12,7 @@ knitr::opts_chunk$set( # databraryr -```{r include=FALSE} -usethis::use_cran_badge() -usethis::use_lifecycle_badge("stable") +```{r include=FALSE, eval=FALSE} ``` [![CRAN status](https://www.r-pkg.org/badges/version/databraryr)](https://CRAN.R-project.org/package=databraryr) [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) @@ -48,18 +43,19 @@ The registration process involves the creation of an (email-account-based) user Once institutional authorization has been granted, a user may gain access to shared video, audio, and other data. See for more information about gaining access to restricted data. -All API calls now require OAuth2 authentication. Before +All API calls require OAuth2 authentication. Before running the examples below, ensure you have set the following environment variables or stored values with `login_db(store = TRUE)`: - `DATABRARY_CLIENT_ID` - `DATABRARY_CLIENT_SECRET` - `DATABRARY_LOGIN` (your Databrary account email) -- `DATABRARY_PASSWORD` (optional; prompted securely if missing) +- `DATABRARY_PASSWORD` (optional; prompted securely via **getPass** if missing and not in the keyring) +- `DATABRARY_BASE_URL` (optional; defaults to `https://api.databrary.org`; use this for staging or a custom API host) -You can configure these via `usethis::edit_r_environ()`. +You can put these in your user or project `.Renviron` (for example `file.edit("~/.Renviron")` in R, or `usethis::edit_r_environ()` if you use the **usethis** package). -```{r example} +```{r example, eval=FALSE} library(databraryr) login_db() @@ -67,29 +63,111 @@ login_db() whoami() get_db_stats() -#> # A tibble: 1 × 1 -#> date -#> -#> 1 2025-10-31 12:05:57 -list_volume_assets() |> +list_volume_assets(vol_id = 1) |> head() -#> # A tibble: 6 × 17 -#> asset_id asset_name asset_permission asset_size -#> -#> 1 9826 Introduction public 88610655 -#> 2 9828 Databrary demo public 917124852 -#> 3 9830 Databrary 1 public 899912341 -#> 4 9832 Datavyu public 764340542 -#> 5 22412 Slides public 4573426 -#> 6 9834 Overview and Policy Upda… public 1301079971 -#> # ℹ 12 more variables: asset_mime_type , asset_format_id , -#> # asset_format_name , asset_created_at , asset_updated_at , -#> # asset_sha1 , session_id , session_name , -#> # session_date , session_release , asset_uploader_id , -#> # asset_uploader_first_name , asset_uploader_last_name ``` +Illustrative output (depends on your account, API host, and when you run the code): + +``` text +#> Welcome to the databraryr package. + +#> # A tibble: 1 × 11 +#> date institutions affiliates investigators hours_of_recordings +#> +#> 1 2026-05-18 12:05:57 120 3400 2100 95000 +#> # ℹ 6 more variables: authorized_users , total_volumes , +#> # public_volumes , total_files , total_duration_hours , +#> # total_storage_tb +#> # (from get_db_stats(); default type aggregates summary counters) + +#> # A tibble: 6 × 19 +#> asset_id asset_name asset_permission asset_size asset_mime_type +#> +#> 1 9826 Introduction public 88610655 video/mp4 +#> 2 9828 Databrary demo public 917124852 video/mp4 +#> 3 9830 Databrary 1 public 899912341 video/mp4 +#> 4 9832 Datavyu public 764340542 video/mp4 +#> 5 22412 Slides public 4573426 application/pdf +#> 6 9834 Overview and Policy Upda… public 1301079971 video/mp4 +#> # ℹ 14 more variables: asset_format_id , asset_format_name , +#> # asset_duration , asset_created_at , asset_updated_at , +#> # asset_sha1 , asset_thumbnail_url , session_id , +#> # session_name , session_date , session_release , +#> # asset_uploader_id , asset_uploader_first_name , +#> # asset_uploader_last_name +#> # (`asset_duration` / `asset_thumbnail_url` are NA when the API omits them.) +``` + +## Bulk operations + +Functions whose names start with `bulk_*` run many API requests in order (sessions, folders, session files, volume records). Each returns a **tibble** with one row per item you asked to process: + +| Column | Meaning | +|--------|---------| +| `input` | That row’s key (e.g. local path, session id, folder name) | +| `status` | `"success"`, `"failed"`, `"skipped"` (e.g. duplicate basename on upload preflight), or `"pending"` | +| `result` | List column with the API payload when `status` is `"success"` | +| `error` | Error message when `status` is `"failed"` | +| `reason` | Extra detail when relevant (e.g. `"duplicate"` for skipped uploads) | + +### `on_error`, retries, and conditions + +- **`on_error = "stop"`** (default): first failed row stops execution with an error of class **`databraryr_bulk_error`**. In **`tryCatch(..., databraryr_bulk_error = function(e) e$partial)`**, use **`e$partial`** for the tibble of all rows so far (`"failed"` / `"pending"` for rows after the stop). +- **`on_error = "collect"`**: every row is attempted; failures stay `"failed"` and the function returns the full tibble instead of throwing. +- **`max_retries`** / **`retry_delay`**: optional per-row retries before counting a row as failed. + +### Resuming with `resume_bulk()` + +Use **`resume_bulk()`** to run the **same** bulk function again on only **incomplete** rows (`"pending"` or `"failed"`), and merge those outcomes back into the original tibble (order preserved). + +Typical pattern after **`on_error = "stop"`**: + +```{r, eval = FALSE} +partial <- tryCatch( + bulk_upload_files(vol_id = 1, session_id = 42, file_paths = my_paths), + databraryr_bulk_error = function(e) e$partial +) + +# Fix data or environment, then: +partial <- resume_bulk(partial, bulk_upload_files, vol_id = 1, session_id = 42) +``` + +Pass every argument the bulk function needs via `...` except the **vector argument that defines rows** (`file_paths`, `session_ids`, `folder_ids`, `file_ids`, `session_names`, `folder_names`, `record_ids`, or `record_names`). That vector is filled automatically from `partial$input` for incomplete rows; pass **`input_arg = "..."`** if auto-detection is wrong. + +**Rename helpers** (`bulk_rename_sessions`, `bulk_rename_folders`, `bulk_rename_files`) also take **`new_names`** parallel to the ids being renamed. `resume_bulk()` only forwards the id/file vector—you must pass **`new_names`** (subset to match the incomplete rows, in the same order) yourself. + +**Creates-from-names** helpers (`bulk_create_sessions`, `bulk_create_folders`, `bulk_create_records`) require **unique** names so each row’s `input` stays identifiable when resuming. + +See `?resume_bulk` and the individual `bulk_*` help pages for details. + +## Testing + +The test suite includes integration tests that run against the Databrary API. +These tests require the following environment variables to be set: + +| Variable | Description | +|---|---| +| `DATABRARY_LOGIN` | Email address for the account | +| `DATABRARY_PASSWORD` | Password for the account | +| `DATABRARY_CLIENT_ID` | OAuth client ID | +| `DATABRARY_CLIENT_SECRET` | OAuth client secret | +| `DATABRARY_BASE_URL` | *(optional)* API base URL; defaults to `https://api.databrary.org`. Integration tests use NYU staging (`https://api.stg-databrary.its.nyu.edu`) when this variable is **unset**. | + +Tests that require authentication are automatically skipped when these variables are not available. + +The recommended way to provide them is a project-level `.Renviron` file in the package root: + +```bash +DATABRARY_LOGIN=you@example.com +DATABRARY_PASSWORD=your-password +DATABRARY_CLIENT_ID=your-client-id +DATABRARY_CLIENT_SECRET=your-client-secret +``` + +R loads this file automatically on startup, so `devtools::test()` and `devtools::check()` will pick up the credentials without any extra steps. + ## Lifecycle Rick Gilmore has been using experimental versions of databraryr for many years, but the package was only released to CRAN in the fall of 2023. diff --git a/README.md b/README.md index 9af7ec24..aa52366a 100644 --- a/README.md +++ b/README.md @@ -1,26 +1,25 @@ + + # databraryr -[![CRAN -status](https://www.r-pkg.org/badges/version/databraryr)](https://CRAN.R-project.org/package=databraryr) -[![Lifecycle: -stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) +[![CRAN status](https://www.r-pkg.org/badges/version/databraryr)](https://CRAN.R-project.org/package=databraryr) +[![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) [![R-CMD-check](https://github.com/databrary/databraryr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/databrary/databraryr/actions/workflows/R-CMD-check.yaml) ## Overview -databraryr is a wrapper for the [Databrary](https://databrary.org) data -library’s application programming interface (API). The package can be -used to create reproducible data wrangling, analysis, and visualization -pipelines from data stored and shared on Databrary. +databraryr is a wrapper for the [Databrary](https://databrary.org) data library's application programming interface (API). +The package can be used to create reproducible data wrangling, analysis, and visualization pipelines from data stored and shared on Databrary. ## Installation + ``` r # The easiest way to install databraryr is from CRAN install.packages("databraryr") @@ -32,54 +31,117 @@ pak::pak("databrary/databraryr") ## Usage -Databrary ([databrary.org](https://databrary.org)) is a -restricted-access research data library specialized for storing and -sharing video with capabilities of storing [other -types](https://nyu.databrary.org/asset/formats/) of associated data. -Access to restricted data requires registration and formal approval by -an institution. The registration process involves the creation of an -(email-account-based) user account and secure password. Once -institutional authorization has been granted, a user may gain access to -shared video, audio, and other data. See - for more information about gaining -access to restricted data. - -However, many commands in the `databraryr` package return meaningful -results *without* or *prior to* formal authorization. These commands -access public data or metadata. +Databrary ([databrary.org](https://databrary.org)) is a restricted-access research data library specialized for storing and sharing video with capabilities of storing [other types](https://nyu.databrary.org/asset/formats/) of associated data. +Access to restricted data requires registration and formal approval by an institution. +The registration process involves the creation of an (email-account-based) user account and secure password. +Once institutional authorization has been granted, a user may gain access to shared video, audio, and other data. +See for more information about gaining access to restricted data. + +All API calls require OAuth2 authentication. Before +running the examples below, ensure you have set the following environment variables +or stored values with `login_db(store = TRUE)`: + +- `DATABRARY_CLIENT_ID` +- `DATABRARY_CLIENT_SECRET` +- `DATABRARY_LOGIN` (your Databrary account email) +- `DATABRARY_PASSWORD` (optional; prompted securely via **getPass** if missing and not in the keyring) +- `DATABRARY_BASE_URL` (optional; defaults to `https://api.databrary.org`; use this for staging or a custom API host) + +You can put these in your user or project `.Renviron` (for example `file.edit("~/.Renviron")` in R, or `usethis::edit_r_environ()` if you use the **usethis** package). + ``` r library(databraryr) -#> Welcome to the databraryr package. + +login_db() + +whoami() get_db_stats() -#> # A tibble: 1 × 1 -#> date -#> -#> 1 2025-10-31 12:05:57 -list_volume_assets() |> +list_volume_assets(vol_id = 1) |> head() -#> # A tibble: 6 × 17 -#> asset_id asset_name asset_permission asset_size -#> -#> 1 9826 Introduction public 88610655 -#> 2 9828 Databrary demo public 917124852 -#> 3 9830 Databrary 1 public 899912341 -#> 4 9832 Datavyu public 764340542 -#> 5 22412 Slides public 4573426 -#> 6 9834 Overview and Policy Upda… public 1301079971 -#> # ℹ 12 more variables: asset_mime_type , asset_format_id , -#> # asset_format_name , asset_created_at , asset_updated_at , -#> # asset_sha1 , session_id , session_name , -#> # session_date , session_release , asset_uploader_id , -#> # asset_uploader_first_name , asset_uploader_last_name ``` +Illustrative output (depends on your account, API host, and when you run the code): + +``` text +#> Welcome to the databraryr package. + +#> # A tibble: 1 × 11 +#> date institutions affiliates investigators hours_of_recordings +#> +#> 1 2026-05-18 12:05:57 120 3400 2100 95000 +#> # ℹ 6 more variables: authorized_users , total_volumes , +#> # public_volumes , total_files , total_duration_hours , +#> # total_storage_tb +#> # (from get_db_stats(); default type aggregates summary counters) + +#> # A tibble: 6 × 19 +#> asset_id asset_name asset_permission asset_size asset_mime_type +#> +#> 1 9826 Introduction public 88610655 video/mp4 +#> 2 9828 Databrary demo public 917124852 video/mp4 +#> 3 9830 Databrary 1 public 899912341 video/mp4 +#> 4 9832 Datavyu public 764340542 video/mp4 +#> 5 22412 Slides public 4573426 application/pdf +#> 6 9834 Overview and Policy Upda… public 1301079971 video/mp4 +#> # ℹ 14 more variables: asset_format_id , asset_format_name , +#> # asset_duration , asset_created_at , asset_updated_at , +#> # asset_sha1 , asset_thumbnail_url , session_id , +#> # session_name , session_date , session_release , +#> # asset_uploader_id , asset_uploader_first_name , +#> # asset_uploader_last_name +#> # (`asset_duration` / `asset_thumbnail_url` are NA when the API omits them.) +``` + +## Bulk operations + +Functions whose names start with `bulk_*` run many API requests in order (sessions, folders, session files, volume records). Each returns a **tibble** with one row per item you asked to process: + +| Column | Meaning | +|--------|---------| +| `input` | That row’s key (e.g. local path, session id, folder name) | +| `status` | `"success"`, `"failed"`, `"skipped"` (e.g. duplicate basename on upload preflight), or `"pending"` | +| `result` | List column with the API payload when `status` is `"success"` | +| `error` | Error message when `status` is `"failed"` | +| `reason` | Extra detail when relevant (e.g. `"duplicate"` for skipped uploads) | + +### `on_error`, retries, and conditions + +- **`on_error = "stop"`** (default): first failed row stops execution with an error of class **`databraryr_bulk_error`**. In **`tryCatch(..., databraryr_bulk_error = function(e) e$partial)`**, use **`e$partial`** for the tibble of all rows so far (`"failed"` / `"pending"` for rows after the stop). +- **`on_error = "collect"`**: every row is attempted; failures stay `"failed"` and the function returns the full tibble instead of throwing. +- **`max_retries`** / **`retry_delay`**: optional per-row retries before counting a row as failed. + +### Resuming with `resume_bulk()` + +Use **`resume_bulk()`** to run the **same** bulk function again on only **incomplete** rows (`"pending"` or `"failed"`), and merge those outcomes back into the original tibble (order preserved). + +Typical pattern after **`on_error = "stop"`**: + + +``` r +partial <- tryCatch( + bulk_upload_files(vol_id = 1, session_id = 42, file_paths = my_paths), + databraryr_bulk_error = function(e) e$partial +) + +# Fix data or environment, then: +partial <- resume_bulk(partial, bulk_upload_files, vol_id = 1, session_id = 42) +``` + +Pass every argument the bulk function needs via `...` except the **vector argument that defines rows** (`file_paths`, `session_ids`, `folder_ids`, `file_ids`, `session_names`, `folder_names`, `record_ids`, or `record_names`). That vector is filled automatically from `partial$input` for incomplete rows; pass **`input_arg = "..."`** if auto-detection is wrong. + +**Rename helpers** (`bulk_rename_sessions`, `bulk_rename_folders`, `bulk_rename_files`) also take **`new_names`** parallel to the ids being renamed. `resume_bulk()` only forwards the id/file vector—you must pass **`new_names`** (subset to match the incomplete rows, in the same order) yourself. + +**Creates-from-names** helpers (`bulk_create_sessions`, `bulk_create_folders`, `bulk_create_records`) require **unique** names so each row’s `input` stays identifiable when resuming. + +See `?resume_bulk` and the individual `bulk_*` help pages for details. + ## Testing -The test suite includes integration tests that run against the Databrary API. These tests require the following environment variables to -be set: +The test suite includes integration tests that run against the Databrary API. +These tests require the following environment variables to be set: | Variable | Description | |---|---| @@ -87,27 +149,22 @@ be set: | `DATABRARY_PASSWORD` | Password for the account | | `DATABRARY_CLIENT_ID` | OAuth client ID | | `DATABRARY_CLIENT_SECRET` | OAuth client secret | -| `DATABRARY_BASE_URL` | *(optional)* API base URL; defaults to `https://api.stg-databrary.its.nyu.edu` | +| `DATABRARY_BASE_URL` | *(optional)* API base URL; defaults to `https://api.databrary.org`. Integration tests use NYU staging (`https://api.stg-databrary.its.nyu.edu`) when this variable is **unset**. | -Tests that require authentication are automatically skipped when these -variables are not available. +Tests that require authentication are automatically skipped when these variables are not available. -The recommended way to provide them is a project-level `.Renviron` file -in the package root: +The recommended way to provide them is a project-level `.Renviron` file in the package root: -``` bash +```bash DATABRARY_LOGIN=you@example.com DATABRARY_PASSWORD=your-password DATABRARY_CLIENT_ID=your-client-id DATABRARY_CLIENT_SECRET=your-client-secret ``` -R loads this file automatically on startup, so `devtools::test()` and -`devtools::check()` will pick up the credentials without any extra -steps. +R loads this file automatically on startup, so `devtools::test()` and `devtools::check()` will pick up the credentials without any extra steps. ## Lifecycle -Rick Gilmore has been using experimental versions of databraryr for many -years, but the package was only released to CRAN in the fall of 2023. +Rick Gilmore has been using experimental versions of databraryr for many years, but the package was only released to CRAN in the fall of 2023. Some new features are on the roadmap, but the package is largely stable. diff --git a/man/HHMMSSmmm_to_ms.Rd b/man/HHMMSSmmm_to_ms.Rd deleted file mode 100644 index 4396e5a6..00000000 --- a/man/HHMMSSmmm_to_ms.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{HHMMSSmmm_to_ms} -\alias{HHMMSSmmm_to_ms} -\title{Convert Timestamp String To ms.} -\usage{ -HHMMSSmmm_to_ms(HHMMSSmmm = "01:01:01:333") -} -\arguments{ -\item{HHMMSSmmm}{a string in the format "HH:MM:SS:mmm"} -} -\value{ -A numeric value in ms from the input string. -} -\description{ -Convert Timestamp String To ms. -} -\examples{ -HHMMSSmmm_to_ms() # 01:01:01:333 in ms -} diff --git a/man/list_volume_assets.Rd b/man/list_volume_assets.Rd index 0b6cf58f..a12c2b5b 100644 --- a/man/list_volume_assets.Rd +++ b/man/list_volume_assets.Rd @@ -14,7 +14,9 @@ list_volume_assets(vol_id = 1, vb = options::opt("vb"), rq = NULL) \item{rq}{An \code{httr2} request object. Default is NULL.} } \value{ -A data frame with information about all assets in a volume. +A tibble with one row per asset. Columns \code{asset_duration} and +\code{asset_thumbnail_url} are always present (as \code{NA} when the API omits them). +Other fields come from the volume sessions/files payload. } \description{ List Assets in Databrary Volume. diff --git a/tests/testthat/test-list_volume_assets.R b/tests/testthat/test-list_volume_assets.R index 47b44be8..512b1fb4 100644 --- a/tests/testthat/test-list_volume_assets.R +++ b/tests/testthat/test-list_volume_assets.R @@ -14,6 +14,14 @@ test_that("list_volume_assets returns tibble for accessible volume", { expect_gt(nrow(result), 0) }) +test_that("list_volume_assets always includes duration and thumbnail columns", { + result <- list_volume_assets(vol_id = 1) + skip_if_null_response(result, "list_volume_assets(vol_id = 1)") + expect_true(all(c("asset_duration", "asset_thumbnail_url") %in% names(result))) + expect_type(result$asset_duration, "double") + expect_type(result$asset_thumbnail_url, "character") +}) + test_that("list_volume_assets rejects bad input parameters", { expect_error(list_volume_assets(vol_id = -1)) expect_error(list_volume_assets(vol_id = 0)) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index af806abc..e309db26 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -38,18 +38,6 @@ test_that("get_supported_file_types rejects bad input parameters", { expect_error(get_supported_file_types(vb = "a")) }) -# HHMMSSmmm_to_ms --------------------------------------------------- -test_that("HHMMSSmmm_to_ms returns number", { - expect_true(class(HHMMSSmmm_to_ms()) == "numeric") -}) - -test_that("HHMMSSmmm_to_ms rejects bad input parameters", { - expect_error(HHMMSSmmm_to_ms(HHMMSSmmm = -1)) - #expect_error(HHMMSSmmm_to_ms(HHMMSSmmm = "a")) - #expect_error(HHMMSSmmm_to_ms(HHMMSSmmm = list(a=1, b=2))) - expect_error(HHMMSSmmm_to_ms(HHMMSSmmm = TRUE)) -}) - # make_fn_portable --------------------------------------------------- test_that("make_fn_portable returns string", { expect_true("character" %in% class(make_fn_portable("}*&!@#$%^+.pdf"))) From 6bc7fcdfd3a71c4c9119f3678d2b2ef06b029f51 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Mon, 18 May 2026 16:21:04 +0200 Subject: [PATCH 74/77] docs: enhance README with looping fix-and-resume example for bulk operations; refactor duplicate checking functions --- R/bulk_apply_internals.R | 41 ++++++---------------------------------- R/bulk_files.R | 18 ++++++++++++++++-- R/bulk_resume.R | 32 ++++++++++++++++++++++++++++--- README.Rmd | 16 ++++++++++++++++ README.md | 16 ++++++++++++++++ man/resume_bulk.Rd | 7 +++++++ 6 files changed, 90 insertions(+), 40 deletions(-) diff --git a/R/bulk_apply_internals.R b/R/bulk_apply_internals.R index bd5b2795..740f2397 100644 --- a/R/bulk_apply_internals.R +++ b/R/bulk_apply_internals.R @@ -108,43 +108,14 @@ bulk_apply <- function(inputs, fn, state } -# Internal: mark inputs whose basenames already exist in the session as -# "skipped" with reason "duplicate". Returns the updated state tibble. +# Internal: mark inputs whose basenames already exist in the target session or +# folder as "skipped" with reason "duplicate". `checker` is +# check_duplicate_files_in_session or check_duplicate_files_in_folder; `...` is +# forwarded (vol_id, session_id or folder_id, vb, rq). #' @noRd -preflight_session_duplicates <- function(state, vol_id, session_id, vb, rq) { +preflight_duplicates <- function(state, checker, ...) { filenames <- basename(state$input) - dupes <- check_duplicate_files_in_session( - vol_id = vol_id, - session_id = session_id, - filenames = filenames, - vb = vb, - rq = rq - ) - if (is.null(dupes)) { - return(state) - } - - exists_lookup <- stats::setNames(dupes$exists, dupes$filename) - is_dupe <- !is.na(exists_lookup[filenames]) & - unname(exists_lookup[filenames]) - is_dupe[is.na(is_dupe)] <- FALSE - - state$status[is_dupe] <- "skipped" - state$reason[is_dupe] <- "duplicate" - state -} - -# Internal: duplicate filenames in folder preflight (mirrors session). -#' @noRd -preflight_folder_duplicates <- function(state, vol_id, folder_id, vb, rq) { - filenames <- basename(state$input) - dupes <- check_duplicate_files_in_folder( - vol_id = vol_id, - folder_id = folder_id, - filenames = filenames, - vb = vb, - rq = rq - ) + dupes <- checker(filenames = filenames, ...) if (is.null(dupes)) { return(state) } diff --git a/R/bulk_files.R b/R/bulk_files.R index aa693d74..a06b5e92 100644 --- a/R/bulk_files.R +++ b/R/bulk_files.R @@ -94,11 +94,25 @@ bulk_upload_files <- function( preflight_fn <- if (preflight) { if (has_session) { function(state) { - preflight_session_duplicates(state, vol_id, session_id, vb, rq) + preflight_duplicates( + state, + check_duplicate_files_in_session, + vol_id = vol_id, + session_id = session_id, + vb = vb, + rq = rq + ) } } else { function(state) { - preflight_folder_duplicates(state, vol_id, folder_id, vb, rq) + preflight_duplicates( + state, + check_duplicate_files_in_folder, + vol_id = vol_id, + folder_id = folder_id, + vb = vb, + rq = rq + ) } } } else { diff --git a/R/bulk_resume.R b/R/bulk_resume.R index a054d567..43b3ffd5 100644 --- a/R/bulk_resume.R +++ b/R/bulk_resume.R @@ -23,6 +23,12 @@ #' @return A tibble of the same shape as \code{partial}, with rows from the #' resumed run substituted in for previously incomplete rows. #' +#' @details If \code{fn} itself fast-fails (\code{on_error = "stop"}), the +#' re-thrown \code{databraryr_bulk_error}'s \code{$partial} is the \strong{full +#' accumulated tibble} (outcomes from all prior runs merged with the latest +#' attempt), so you can safely pass it back to \code{resume_bulk()} in a loop +#' without losing rows that already succeeded. +#' #' @seealso \code{\link{bulk_upload_files}}, \code{\link{bulk_delete_sessions}}, #' \code{\link{bulk_delete_folders}}, \code{\link{bulk_delete_files}}, #' \code{\link{bulk_create_sessions}}, \code{\link{bulk_create_folders}}, @@ -68,11 +74,31 @@ resume_bulk <- function(partial, fn, ..., input_arg = NULL) { args <- list(...) args[[input_arg]] <- remaining - new_rows <- do.call(fn, args) - - # Splice new rows back into the original order. out <- partial redo_idx <- which(to_redo) + + inner_result <- tryCatch( + list(ok = TRUE, val = do.call(fn, args)), + databraryr_bulk_error = function(e) list(ok = FALSE, err = e) + ) + + if (!isTRUE(inner_result$ok)) { + inner <- inner_result$err$partial + for (k in seq_along(redo_idx)) { + i <- redo_idx[k] + out$status[i] <- inner$status[k] + out$result[i] <- inner$result[k] + out$error[i] <- inner$error[k] + out$reason[i] <- inner$reason[k] + } + stop(databraryr_bulk_error( + message = inner_result$err$message, + partial = out, + failed_input = inner_result$err$failed_input + )) + } + + new_rows <- inner_result$val for (k in seq_along(redo_idx)) { i <- redo_idx[k] out$status[i] <- new_rows$status[k] diff --git a/README.Rmd b/README.Rmd index 927875a0..2891e67c 100644 --- a/README.Rmd +++ b/README.Rmd @@ -134,6 +134,22 @@ partial <- tryCatch( partial <- resume_bulk(partial, bulk_upload_files, vol_id = 1, session_id = 42) ``` +Looping fix-and-resume (safe: each `e$partial` always reflects the full job, not only the last retried subset): + +```{r, eval = FALSE} +partial <- tryCatch( + bulk_upload_files(vol_id = 1, session_id = 42, file_paths = my_paths), + databraryr_bulk_error = function(e) e$partial +) +while (any(partial$status %in% c("pending", "failed"))) { + # fix whatever caused the failure, then: + partial <- tryCatch( + resume_bulk(partial, bulk_upload_files, vol_id = 1, session_id = 42), + databraryr_bulk_error = function(e) e$partial + ) +} +``` + Pass every argument the bulk function needs via `...` except the **vector argument that defines rows** (`file_paths`, `session_ids`, `folder_ids`, `file_ids`, `session_names`, `folder_names`, `record_ids`, or `record_names`). That vector is filled automatically from `partial$input` for incomplete rows; pass **`input_arg = "..."`** if auto-detection is wrong. **Rename helpers** (`bulk_rename_sessions`, `bulk_rename_folders`, `bulk_rename_files`) also take **`new_names`** parallel to the ids being renamed. `resume_bulk()` only forwards the id/file vector—you must pass **`new_names`** (subset to match the incomplete rows, in the same order) yourself. diff --git a/README.md b/README.md index aa52366a..5a0dfb0c 100644 --- a/README.md +++ b/README.md @@ -130,6 +130,22 @@ partial <- tryCatch( partial <- resume_bulk(partial, bulk_upload_files, vol_id = 1, session_id = 42) ``` +Looping fix-and-resume (safe: each `e$partial` always reflects the full job, not only the last retried subset): + +``` r +partial <- tryCatch( + bulk_upload_files(vol_id = 1, session_id = 42, file_paths = my_paths), + databraryr_bulk_error = function(e) e$partial +) +while (any(partial$status %in% c("pending", "failed"))) { + # fix whatever caused the failure, then: + partial <- tryCatch( + resume_bulk(partial, bulk_upload_files, vol_id = 1, session_id = 42), + databraryr_bulk_error = function(e) e$partial + ) +} +``` + Pass every argument the bulk function needs via `...` except the **vector argument that defines rows** (`file_paths`, `session_ids`, `folder_ids`, `file_ids`, `session_names`, `folder_names`, `record_ids`, or `record_names`). That vector is filled automatically from `partial$input` for incomplete rows; pass **`input_arg = "..."`** if auto-detection is wrong. **Rename helpers** (`bulk_rename_sessions`, `bulk_rename_folders`, `bulk_rename_files`) also take **`new_names`** parallel to the ids being renamed. `resume_bulk()` only forwards the id/file vector—you must pass **`new_names`** (subset to match the incomplete rows, in the same order) yourself. diff --git a/man/resume_bulk.Rd b/man/resume_bulk.Rd index eef8ce81..217a7029 100644 --- a/man/resume_bulk.Rd +++ b/man/resume_bulk.Rd @@ -35,6 +35,13 @@ because \code{on_error = "collect"} left \code{"failed"} / \code{"pending"} rows), \code{resume_bulk()} re-runs the supplied bulk function on those rows and merges the result, preserving original input order. } +\details{ +If \code{fn} itself fast-fails (\code{on_error = "stop"}), the +re-thrown \code{databraryr_bulk_error}'s \code{$partial} is the \strong{full +accumulated tibble} (outcomes from all prior runs merged with the latest +attempt), so you can safely pass it back to \code{resume_bulk()} in a loop +without losing rows that already succeeded. +} \examples{ \donttest{ \dontrun{ From af41f31edf8692b2a89e09f6f058181189101b6f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Tue, 19 May 2026 10:23:47 +0200 Subject: [PATCH 75/77] chore: update GitHub Actions workflows to use actions/checkout@v6 --- .github/workflows/R-CMD-check.yaml | 2 +- .github/workflows/lint.yaml | 2 +- .github/workflows/pkgdown.yaml | 2 +- .github/workflows/test-coverage.yaml | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index aea61ef6..064247c6 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -29,7 +29,7 @@ jobs: R_KEEP_PKG_SOURCE: yes steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@v6 - uses: r-lib/actions/setup-pandoc@v2 diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml index ef5a5b45..7b788e06 100644 --- a/.github/workflows/lint.yaml +++ b/.github/workflows/lint.yaml @@ -16,7 +16,7 @@ jobs: env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@v6 - uses: r-lib/actions/setup-r@v2 with: diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 79c26075..93c997dd 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -25,7 +25,7 @@ jobs: permissions: contents: write steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@v6 with: # When triggered by workflow_run, checkout the commit that was checked ref: ${{ github.event_name == 'workflow_run' && github.event.workflow_run.head_sha || github.ref }} diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 40a5f6bf..61c518a5 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -15,7 +15,7 @@ jobs: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@v6 - uses: r-lib/actions/setup-r@v2 with: From 00b9f618269e269a499c77872a03a2cb05290269 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Tue, 19 May 2026 10:29:08 +0200 Subject: [PATCH 76/77] chore: update codecov action to version 6 in test coverage workflow --- .github/workflows/test-coverage.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 61c518a5..25bed7c2 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -48,7 +48,7 @@ jobs: } shell: Rscript {0} - - uses: codecov/codecov-action@v5 + - uses: codecov/codecov-action@v6 with: fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} files: ./cobertura.xml From fdd2845964dec09c91e6690458285d3f5a69e9ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Armatys?= Date: Fri, 29 May 2026 09:16:59 +0200 Subject: [PATCH 77/77] feat: add file_count_value function and update volume folder/session listings to use it for file count handling --- R/api_utils.R | 11 +++++++++++ R/list_volume_folders.R | 8 ++++++-- R/list_volume_sessions.R | 8 ++++++-- tests/testthat/test-list_volume_folders.R | 5 +++++ tests/testthat/test-list_volume_sessions.R | 10 ++++++++++ 5 files changed, 38 insertions(+), 4 deletions(-) diff --git a/R/api_utils.R b/R/api_utils.R index 9ba7e33c..5dc9d648 100644 --- a/R/api_utils.R +++ b/R/api_utils.R @@ -117,6 +117,17 @@ perform_api_get <- function(path, body } +#' Extract one integer bucket from a file_counts object. +#' @noRd +file_count_value <- function(counts, key) { + value <- if (is.null(counts)) NULL else counts[[key]] + if (is.null(value) || length(value) == 0L) { + 0L + } else { + as.integer(value) + } +} + #' @noRd collect_paginated_get <- function(path, params = list(), diff --git a/R/list_volume_folders.R b/R/list_volume_folders.R index fcdb0009..9a8c1bf9 100644 --- a/R/list_volume_folders.R +++ b/R/list_volume_folders.R @@ -52,12 +52,16 @@ list_volume_folders <- function(vol_id = 1, volume_value <- vol_id } + fc <- folder[["file_counts"]] + tibble::tibble( folder_id = folder$id, folder_name = folder$name, folder_release = folder$release_level, - folder_file_count = folder$file_count, - folder_accessible_file_count = folder$accessible_file_count, + folder_native_accessible = file_count_value(fc, "native_accessible"), + folder_native_inaccessible = file_count_value(fc, "native_inaccessible"), + folder_linked_accessible = file_count_value(fc, "linked_accessible"), + folder_linked_inaccessible = file_count_value(fc, "linked_inaccessible"), folder_has_full_access = folder$has_full_access, folder_contains_different_release_levels = folder$contains_different_release_levels, folder_created_at = folder$created_at, diff --git a/R/list_volume_sessions.R b/R/list_volume_sessions.R index 3da26bf3..efc8cfd0 100644 --- a/R/list_volume_sessions.R +++ b/R/list_volume_sessions.R @@ -60,13 +60,17 @@ list_volume_sessions <- vol_id) df <- purrr::map_dfr(sessions, function(session) { + fc <- session[["file_counts"]] + tibble::tibble( session_id = session$id, session_name = session$name, session_release = session$release_level, session_source_date = session$source_date, - session_file_count = session$file_count, - session_accessible_file_count = session$accessible_file_count, + session_native_accessible = file_count_value(fc, "native_accessible"), + session_native_inaccessible = file_count_value(fc, "native_inaccessible"), + session_linked_accessible = file_count_value(fc, "linked_accessible"), + session_linked_inaccessible = file_count_value(fc, "linked_inaccessible"), session_has_full_access = session$has_full_access ) }) diff --git a/tests/testthat/test-list_volume_folders.R b/tests/testthat/test-list_volume_folders.R index fa901759..75fcceb8 100644 --- a/tests/testthat/test-list_volume_folders.R +++ b/tests/testthat/test-list_volume_folders.R @@ -4,6 +4,11 @@ test_that("list_volume_folders returns tibble for accessible volume", { result <- list_volume_folders(vol_id = 2) skip_if_null_response(result, "list_volume_folders(vol_id = 2)") expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), dplyr::n_distinct(result$folder_id)) + expect_type(result$folder_native_accessible, "integer") + expect_type(result$folder_native_inaccessible, "integer") + expect_type(result$folder_linked_accessible, "integer") + expect_type(result$folder_linked_inaccessible, "integer") }) test_that("list_volume_folders rejects bad input parameters", { diff --git a/tests/testthat/test-list_volume_sessions.R b/tests/testthat/test-list_volume_sessions.R index 5cd9abbf..6f007b28 100644 --- a/tests/testthat/test-list_volume_sessions.R +++ b/tests/testthat/test-list_volume_sessions.R @@ -6,6 +6,11 @@ test_that("list_volume_sessions returns tibble given valid vol_id", { skip_if_null_response(result, "list_volume_sessions()") expect_s3_class(result, "tbl_df") expect_gt(nrow(result), 0) + expect_equal(nrow(result), dplyr::n_distinct(result$session_id)) + expect_type(result$session_native_accessible, "integer") + expect_type(result$session_native_inaccessible, "integer") + expect_type(result$session_linked_accessible, "integer") + expect_type(result$session_linked_inaccessible, "integer") }) test_that("list_volume_sessions returns tibble for another volume", { @@ -13,6 +18,11 @@ test_that("list_volume_sessions returns tibble for another volume", { skip_if_null_response(result, "list_volume_sessions(vol_id = 2)") expect_s3_class(result, "tbl_df") expect_gt(nrow(result), 0) + expect_equal(nrow(result), dplyr::n_distinct(result$session_id)) + expect_type(result$session_native_accessible, "integer") + expect_type(result$session_native_inaccessible, "integer") + expect_type(result$session_linked_accessible, "integer") + expect_type(result$session_linked_inaccessible, "integer") }) test_that("list_volume_sessions returns NULL for unknown volume", {