diff --git a/DESCRIPTION b/DESCRIPTION index a91bbb3d..d68b1a78 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,12 +1,14 @@ 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"), + 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 @@ -46,4 +48,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..a406a9d6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,51 +4,71 @@ export("%>%") export(HHMMSSmmm_to_ms) export(assign_constants) export(check_ssl_certs) -export(download_party_avatar) +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) -export(get_asset_segment_range) +export(get_category_by_id) export(get_db_stats) -export(get_file_duration) -export(get_party_by_id) +export(get_folder_by_id) +export(get_folder_file) +export(get_funder_by_id) +export(get_institution_avatar) +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_session_file) 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(is_institution) -export(is_person) +export(get_volume_collaborator_by_id) +export(get_volume_record_by_id) export(list_asset_formats) export(list_authorized_investigators) -export(list_party_affiliates) -export(list_party_sponsors) -export(list_party_volumes) +export(list_categories) +export(list_folder_assets) +export(list_institution_affiliates) +export(list_institutions) 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_records) 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,"%>%") importFrom(methods,is) 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 diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 07b70d86..36e1c0b7 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -1,74 +1,65 @@ #' 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_CONSTANTS <- "https://nyu.databrary.org/api/constants" +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_LIST <- "/institutions/" +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_COLLABORATOR_DETAIL <- "/volumes/%s/collaborators/%s/" +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/" +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_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/" +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/" +API_FUNDER_DETAIL <- "/funders/%s/" +API_TAG_DETAIL <- "/tags/%s/" +API_CATEGORIES <- "/categories/" +API_CATEGORY_DETAIL <- "/categories/%s/" -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' - -# 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 + + +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/") +KEYRING_SERVICE <- 'org.databrary.databraryr' diff --git a/R/api_utils.R b/R/api_utils.R new file mode 100644 index 00000000..ca95322f --- /dev/null +++ b/R/api_utils.R @@ -0,0 +1,183 @@ +# 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 + } +} + +#' @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 bcc64bd3..7ede9a2d 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. @@ -17,27 +18,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 - } + validate_flag(vb, "vb") + 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/auth_service.R b/R/auth_service.R new file mode 100644 index 00000000..100174b6 --- /dev/null +++ b/R/auth_service.R @@ -0,0 +1,113 @@ +# 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)) + validate_flag(vb, "vb") + + 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)) + validate_flag(vb, "vb") + + 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/download_folder_asset.R b/R/download_folder_asset.R new file mode 100644 index 00000000..30385935 --- /dev/null +++ b/R/download_folder_asset.R @@ -0,0 +1,126 @@ +#' @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 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. +#' 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 +#' 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 = 9807, asset_id = 1, +#' file_name = "video.mp4") +#' } +#' } +#' +#' @export +download_folder_asset <- function(vol_id = 1, + folder_id = 9807, + asset_id = 1, + file_name = "video.mp4", + 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) + + validate_flag(vb, "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..aa92a404 --- /dev/null +++ b/R/download_folder_assets_fr_df.R @@ -0,0 +1,115 @@ +#' @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 vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @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..9ced2c48 --- /dev/null +++ b/R/download_folder_zip.R @@ -0,0 +1,55 @@ +#' @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. 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. +#' +#' @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() # Volume 1, folder 9807 +#' } +#' } +#' +#' @export +download_folder_zip <- function(vol_id = 1, + folder_id = 9807, + 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_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/download_session_asset.R b/R/download_session_asset.R index 87000398..ba8c2578 100644 --- a/R/download_session_asset.R +++ b/R/download_session_asset.R @@ -3,175 +3,119 @@ #' 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 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. +#' @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 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 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) + if (!is.null(file_name)) { + assertthat::assert_that(length(file_name) == 1) + assertthat::assert_that(is.character(file_name)) + } - assertthat::assert_that(is.character(target_dir)) 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)) + validate_flag(vb, "vb") - assertthat::assert_that(is.null(rq) | + 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_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 ", - session_id, - "." - ) + path <- sprintf(API_FILES_DOWNLOAD_LINK, vol_id, session_id, asset_id) + link <- request_signed_download_link(path = path, rq = rq, vb = vb) - 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)) + if (is.null(link)) { 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)) + 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") } - 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), + dest_path <- file.path(target_dir, resolved_name) + + if (file.exists(dest_path)) { + dest_path <- file.path(target_dir, paste0( - session_id, - "-", - asset_id, + tools::file_path_sans_ext(resolved_name), "-", format(Sys.time(), "%F-%H%M-%S"), - paste0(".", this_file_extension) + ifelse( + nzchar(tools::file_ext(resolved_name)), + paste0(".", tools::file_ext(resolved_name)), + "" + ) )) } - 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) - } - - 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..e40dece6 100644 --- a/R/download_session_assets_fr_df.R +++ b/R/download_session_assets_fr_df.R @@ -3,43 +3,45 @@ #' 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. 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 +#' 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 vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @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 = 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, @@ -47,33 +49,30 @@ 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) @@ -93,15 +92,17 @@ download_session_assets_fr_df <- assertthat::assert_that(length(vb) == 1) assertthat::assert_that(is.logical(vb)) - assertthat::assert_that(is.null(rq) | + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - if (vb) - message("Downloading n=", dim(session_df)[1], " files to /", target_dir) + 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 +110,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..818b43fd 100644 --- a/R/download_session_csv.R +++ b/R/download_session_csv.R @@ -3,108 +3,64 @@ #' 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 2. +#' @param session_id Optional integer. When provided, requests a session-level +#' 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. #' -#' @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() # CSV for default volume 2 +#' +#' # Request a session-specific CSV export +#' download_session_csv(vol_id = 2, session_id = 9) #' } #' } #' #' @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) | + 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 + 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..3315c10c 100644 --- a/R/download_session_zip.R +++ b/R/download_session_zip.R @@ -3,33 +3,39 @@ #' 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. 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. +#' +#' @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) @@ -38,90 +44,11 @@ download_session_zip <- function(vol_id = 31, 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)) + validate_flag(vb, "vb") - assertthat::assert_that(is.null(rq) | + 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" - ) + 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..29ea5637 --- /dev/null +++ b/R/download_single_folder_asset_fr_df.R @@ -0,0 +1,147 @@ +#' @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 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. +#' +#' @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) + + 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) { + 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..18d84a30 100644 --- a/R/download_single_session_asset_fr_df.R +++ b/R/download_single_session_asset_fr_df.R @@ -1,50 +1,31 @@ #' @eval options::as_params() #' @name options_params -#' +#' 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 vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @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,26 +36,32 @@ 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)) + 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)) @@ -83,155 +70,81 @@ 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) | + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - this_asset <- session_df[i, ] - if (is.null(this_asset)) { - if (vb) + 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 } + dir.create(dest_dir, recursive = TRUE, showWarnings = FALSE) + assertthat::assert_that(dir.exists(dest_dir)) + assertthat::is.writeable(dest_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.") - } + 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) } - if (make_portable_fn) { - if (vb) - message("Making file name '", full_fn, "' portable.") - full_fn <- make_fn_portable(full_fn, vb = vb) + 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) + } + } } - assertthat::is.string(full_fn) - if (!dir.exists(dirname(full_fn))) { + candidate_name <- paste0(base_name, extension) + + if (make_portable_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..76a0449c --- /dev/null +++ b/R/download_utils.R @@ -0,0 +1,103 @@ +# 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) + + 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) + 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..575fdf04 100644 --- a/R/download_video.R +++ b/R/download_video.R @@ -3,38 +3,40 @@ #' 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 vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @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) @@ -43,79 +45,39 @@ download_video <- function(asset_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) - assertthat::assert_that(length(target_dir) == 1) - assertthat::assert_that(is.character(target_dir)) - assertthat::assert_that(dir.exists(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.") + 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) } - rq <- databraryr::make_default_request() } - this_rq <- rq %>% - httr2::req_url(sprintf(DOWNLOAD_FILE, session_id, asset_id)) %>% - httr2::req_progress() + 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::is.writeable(target_dir) - 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" - )) - } + validate_flag(vb, "vb") - if (vb) - message("Attempting to download video with asset_id ", - asset_id, - " from session_id ", - session_id) + assertthat::assert_that(is.null(rq) || + ("httr2_request" %in% class(rq))) - 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 - } + 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..30c350ac 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 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. +#' +#' @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 -} + validate_flag(vb, "vb") -#------------------------------------------------------------------------------- -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" - ) + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) + + path <- sprintf(API_VOLUME_DOWNLOAD_LINK, vol_id) + request_processing_task(path = path, rq = rq, vb = vb) } diff --git a/R/get_category_by_id.R b/R/get_category_by_id.R new file mode 100644 index 00000000..ebda2afb --- /dev/null +++ b/R/get_category_by_id.R @@ -0,0 +1,83 @@ +#' @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 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, +#' 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) { + 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_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) { + 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 + ) +} diff --git a/R/get_db_stats.R b/R/get_db_stats.R index 4036cd34..f84d9f1f 100644 --- a/R/get_db_stats.R +++ b/R/get_db_stats.R @@ -1,134 +1,137 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL -#' Get Stats About Databrary. +#' 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 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 +#' @returns A data frame with the requested data or NULL if there is #' no new information. #' #' @inheritParams options_params -#' +#' #' @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. #' } #' @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))) - - 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 (!type %in% c( + "institutions", + "people", + "researchers", + "investigators", + "data", + "stats", + "numbers" + )) { + if (vb) + message("Legacy parameter not supported in new API") } - 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 - } + validate_flag(vb, "vb") + + assertthat::assert_that( + is.null(rq) | + ("httr2_request" %in% class(rq)) ) - - if (is.null(resp)) { + + stats <- perform_api_get( + path = API_ACTIVITY_SUMMARY, + rq = rq, + vb = vb + ) + + 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)) + 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 { - 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)) + NA_integer_ + }, + affiliates = if (!is.null(stats$affiliates)) { + stats$affiliates } 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) - ) + 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 { - return(NULL) + 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_ } - } - df + ) + } else { + # For other types, return the raw stats as a tibble + tibble::as_tibble(stats) } } diff --git a/R/get_folder_by_id.R b/R/get_folder_by_id.R new file mode 100644 index 00000000..b68a2a9b --- /dev/null +++ b/R/get_folder_by_id.R @@ -0,0 +1,60 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get Folder Metadata From a Databrary Volume +#' +#' @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`. +#' +#' @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 = 9807, + 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) + + 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 ", + folder_id, + " in volume ", + vol_id) + } + return(NULL) + } + + folder +} diff --git a/R/get_folder_file.R b/R/get_folder_file.R new file mode 100644 index 00000000..ba8b272e --- /dev/null +++ b/R/get_folder_file.R @@ -0,0 +1,78 @@ +#' @eval options::as_params() +#' @name options_params +#' +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. +#' @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. +#' +#' @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_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 +get_folder_file <- + function(vol_id = 1, + folder_id = 9807, + file_id = 1, + 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) + + 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( + "Cannot access requested file ", + file_id, + " in folder ", + folder_id, + " of volume ", + vol_id + ) + } + return(NULL) + } + + file + } diff --git a/R/get_funder_by_id.R b/R/get_funder_by_id.R new file mode 100644 index 00000000..138e6194 --- /dev/null +++ b/R/get_funder_by_id.R @@ -0,0 +1,64 @@ +#' @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 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 +#' 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) { + 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_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, + funder_name = funder$name, + funder_is_approved = funder$is_approved + ) +} diff --git a/R/get_institution_avatar.R b/R/get_institution_avatar.R new file mode 100644 index 00000000..a94b7361 --- /dev/null +++ b/R/get_institution_avatar.R @@ -0,0 +1,179 @@ +#' @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 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 +#' 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) { + 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") + + 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) %>% + 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) + }) +} diff --git a/R/get_institution_by_id.R b/R/get_institution_by_id.R new file mode 100644 index 00000000..cfe60e8d --- /dev/null +++ b/R/get_institution_by_id.R @@ -0,0 +1,50 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get institution metadata +#' +#' @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. +#' @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) + + validate_flag(vb, "vb") + + 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..e7d7d1cb 100644 --- a/R/get_session_by_id.R +++ b/R/get_session_by_id.R @@ -6,8 +6,9 @@ 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. #' #' @returns A JSON blob with the session data. If the user has previously logged @@ -24,76 +25,35 @@ NULL #' } #' @export get_session_by_id <- - function(session_id = 9807, + function(session_id = 6256, 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)) { + + validate_flag(vb, "vb") + + 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..6a348a3e 100644 --- a/R/get_session_by_name.R +++ b/R/get_session_by_name.R @@ -3,11 +3,12 @@ #' 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()`. #' #' @returns One or more JSON blobs (as lists) whose session name(s) match @@ -30,62 +31,38 @@ 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) 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))) + 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) + sessions <- collect_paginated_get( + path = sprintf(API_VOLUME_SESSIONS, vol_id), + params = list(search = session_name), + rq = rq, + vb = vb + ) - if (is.null(name_matches)) { - message("No matches") + 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] == 0) { - message("Empty array") - 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_session_file.R b/R/get_session_file.R new file mode 100644 index 00000000..cb4fc389 --- /dev/null +++ b/R/get_session_file.R @@ -0,0 +1,72 @@ +#' @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 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 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 = 3) +#' # A video from volume 1, session 11. +#' } +#' } +#' @export +get_session_file <- + function(vol_id = 1, + session_id = 9578, + file_id = 27227, + 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) + + 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( + "Cannot access requested file ", + file_id, + " in session ", + session_id, + " of volume ", + vol_id + ) + } + return(NULL) + } + + file + } diff --git a/R/get_tag_by_id.R b/R/get_tag_by_id.R new file mode 100644 index 00000000..4044c698 --- /dev/null +++ b/R/get_tag_by_id.R @@ -0,0 +1,58 @@ +#' @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 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, +#' 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) { + 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_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 new file mode 100644 index 00000000..e7f555d9 --- /dev/null +++ b/R/get_user_avatar.R @@ -0,0 +1,162 @@ +#' @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) { + assertthat::assert_that(length(user_id) == 1) + 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 |> + 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) + }) +} diff --git a/R/get_user_by_id.R b/R/get_user_by_id.R new file mode 100644 index 00000000..d200c133 --- /dev/null +++ b/R/get_user_by_id.R @@ -0,0 +1,51 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get public profile information for a Databrary user +#' +#' @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. +#' @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) + + 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, + 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..78196edf 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()`. @@ -27,34 +28,48 @@ 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))) - # 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/get_volume_collaborator_by_id.R b/R/get_volume_collaborator_by_id.R new file mode 100644 index 00000000..452b26db --- /dev/null +++ b/R/get_volume_collaborator_by_id.R @@ -0,0 +1,137 @@ +#' @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. 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`. +#' +#' @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) { + 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(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( + "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 + ) +} diff --git a/R/get_volume_record_by_id.R b/R/get_volume_record_by_id.R new file mode 100644 index 00000000..18cf7c24 --- /dev/null +++ b/R/get_volume_record_by_id.R @@ -0,0 +1,103 @@ +#' @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. 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, +#' 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) { + 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(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_flag(vb, "vb") + + 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/R/list_asset_formats.R b/R/list_asset_formats.R index 5720a8be..ce2fda06 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. #' @@ -17,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 43b1a73d..3992ded3 100644 --- a/R/list_authorized_investigators.R +++ b/R/list_authorized_investigators.R @@ -1,69 +1,38 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL -#' List Authorized Investigators at Institution +#' List authorized investigators for an 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()`. +#' @description Lists the authorized investigators at an institution. #' -#' @returns A data frame with information the institution's authorized -#' investigators. +#' @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 +#' @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) + 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 <- list_institution_affiliates(institution_id, vb = vb, rq = rq) + if (is.null(affiliates)) { return(NULL) } - if (!("institution" %in% names(this_party))) { - if (vb) - message("Party ", party_id, " not an institution.") + investigators <- affiliates |> dplyr::filter(.data$role == "investigator") + if (nrow(investigators) == 0) { return(NULL) } - - if (dim(as.data.frame(this_party$children))[1] == 0) { - if (vb) - message("Party ", party_id, " has no affiliates.") - 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_categories.R b/R/list_categories.R new file mode 100644 index 00000000..b0c67f51 --- /dev/null +++ b/R/list_categories.R @@ -0,0 +1,78 @@ +#' @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 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, +#' 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_flag(vb, "vb") + + 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/R/list_folder_assets.R b/R/list_folder_assets.R new file mode 100644 index 00000000..e37c643f --- /dev/null +++ b/R/list_folder_assets.R @@ -0,0 +1,107 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List Assets Within a Databrary Folder. +#' +#' @param folder_id Folder identifier scoped to the given volume. Must be a +#' 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")`. +#' @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 = 9807, + 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) + + 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, + asset_permission = file$release_level, + asset_size = file$size, + 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, + 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..ff8afe19 --- /dev/null +++ b/R/list_institution_affiliates.R @@ -0,0 +1,54 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List affiliates for 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 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) + + 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( + 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_institutions.R b/R/list_institutions.R new file mode 100644 index 00000000..7eab34c5 --- /dev/null +++ b/R/list_institutions.R @@ -0,0 +1,130 @@ +#' @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 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, +#' 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) { + 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, + 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 + } + ) + }) +} 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..f1a9cf12 100644 --- a/R/list_session_activity.R +++ b/R/list_session_activity.R @@ -1,71 +1,155 @@ #' @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. +#' @description 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). 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. #' -#' @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. #' -#' list_session_activity(session_id = 6256, vb = FALSE) +#' @inheritParams options_params +#' +#' @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)) + validate_flag(vb, "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)) + 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 (vb) message("Retrieving activity for session id, ", session_id, ".") - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) { - NULL + 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 (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } else { - httr2::resp_body_json(resp) + 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..1a5d0c71 100644 --- a/R/list_session_assets.R +++ b/R/list_session_assets.R @@ -14,6 +14,10 @@ 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 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(). #' @@ -29,99 +33,78 @@ 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) + + validate_flag(vb, "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() + 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, + format_extension = format$extension, + 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..f8c84af9 --- /dev/null +++ b/R/list_user_affiliates.R @@ -0,0 +1,47 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List affiliates for a user +#' +#' @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. +#' @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")) + + 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, + 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..a132ff55 --- /dev/null +++ b/R/list_user_history.R @@ -0,0 +1,64 @@ +#' @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. 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 +#' 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) + + 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, + 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..012232a9 --- /dev/null +++ b/R/list_user_sponsors.R @@ -0,0 +1,56 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List sponsorships for a user +#' +#' @param user_id User identifier. +#' @inheritParams options_params +#' +#' @returns 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")) + + 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( + 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..33124e87 --- /dev/null +++ b/R/list_user_volumes.R @@ -0,0 +1,57 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List Volumes Associated With A User +#' +#' @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. +#' @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) + validate_flag(vb, "vb") + 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) + } + 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) + + 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 + ) + }, .progress = TRUE) %>% + 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..86fbf48a --- /dev/null +++ b/R/list_users.R @@ -0,0 +1,109 @@ +#' @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 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 +#' 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(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..04a896ac 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 -#' history of the volume as a +#' @description If a user has access to a volume, this command lists the modification +#' history of the volume. #' -#' @param vol_id Selected volume number. +#' @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. #' #' @returns A list with the activity history on a volume. @@ -18,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 = 1) # Activity on volume 1. +#' list_volume_activity(vol_id) #' } #' } #' @export list_volume_activity <- - function(vol_id = 1, + function(vol_id = NULL, vb = options::opt("vb"), rq = NULL) { # Check parameters @@ -34,38 +35,75 @@ 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()...') - + 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 + ) + }, .progress = TRUE) } diff --git a/R/list_volume_assets.R b/R/list_volume_assets.R index 4d5bb35a..68a92e0b 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. @@ -27,111 +28,64 @@ 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)) + validate_flag(vb, "vb") - # 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_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 + ) + }, .progress = TRUE) %>% + 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..451c6e38 --- /dev/null +++ b/R/list_volume_collaborators.R @@ -0,0 +1,118 @@ +#' @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. 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 +#' `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) + + 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 + 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 + ) + }, .progress = TRUE) +} 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..00d3f184 --- /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. 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 +#' `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) + + 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, + 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..4155ff41 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. @@ -35,86 +36,38 @@ 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))) - - 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.") - 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..8db32a45 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. #' @@ -31,91 +32,69 @@ 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))) - # 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..d243b44b 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. @@ -27,37 +28,25 @@ 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") - 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_records.R b/R/list_volume_records.R new file mode 100644 index 00000000..27f7ce31 --- /dev/null +++ b/R/list_volume_records.R @@ -0,0 +1,161 @@ +#' @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 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, 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) { + 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") + + 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), + params = params, + rq = rq, + vb = vb + ) + + if (is.null(records) || length(records) == 0) { + if (vb) { + 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 + 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/R/list_volume_session_assets.R b/R/list_volume_session_assets.R index 2dd1ea2a..7ade992b 100644 --- a/R/list_volume_session_assets.R +++ b/R/list_volume_session_assets.R @@ -1,39 +1,39 @@ #' @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) @@ -42,96 +42,68 @@ 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))) - 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) + session <- perform_api_get( + path = sprintf(API_SESSION_DETAIL, vol_id, session_id), + rq = rq, + vb = vb + ) - if (!("containers" %in% names(vol_list))) { + 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() + files <- collect_paginated_get( + path = sprintf(API_SESSION_FILES, vol_id, session_id), + rq = rq, + vb = vb + ) - session_match <- (session_id == these_sessions$session_id) - if (sum(session_match) == 0) { + if (is.null(files) || length(files) == 0) { if (vb) - message("No matching session_id: ", session_id) + message("No assets in vol_id ", vol_id, " 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 + 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, + 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 ) + }) %>% + purrr::list_rbind() - 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 + asset_rows } diff --git a/R/list_volume_sessions.R b/R/list_volume_sessions.R index c8feb025..3c132991 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. @@ -36,86 +37,56 @@ 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))) - # 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() + if (vb) message("Found n = ", + length(sessions), + " sessions in vol_id ", + vol_id) + + 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..a1a325fd 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. @@ -25,41 +26,28 @@ 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))) - # 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) { + 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 new file mode 100644 index 00000000..11d23b60 --- /dev/null +++ b/R/list_volumes.R @@ -0,0 +1,89 @@ +#' @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 vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' +#' @returns 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)) + } + + validate_flag(vb, "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) + } + if (vb) message("Found n = ", + length(volumes), + " volumes that matched the supplied filters.") + + 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 + ) + }, .progress = TRUE) +} + + diff --git a/R/login_db.R b/R/login_db.R index 75c47d82..71b33ce4 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 feedback. Defaults to `options::opt("vb")`. +#' #' @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)) + 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, # 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..cd0d42e5 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. #' @@ -16,26 +16,17 @@ NULL #' logout_db() #' } #' @export -logout_db <- function(vb = options::opt("vb"), rq = NULL){ +logout_db <- function(vb = options::opt("vb")) { + validate_flag(vb, "vb") - 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..428d061a 100644 --- a/R/make_default_request.R +++ b/R/make_default_request.R @@ -1,17 +1,44 @@ -#' 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`. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' +#' @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")) { + + 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) |> + 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/make_login_client.R b/R/make_login_client.R index 338a9254..6dfc20d4 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. #' @@ -40,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/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..622a76da 100644 --- a/R/search_for_funder.R +++ b/R/search_for_funder.R @@ -5,7 +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. @@ -19,45 +22,60 @@ 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(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))) - 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..f08705e3 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. @@ -26,33 +27,30 @@ 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))) - 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..8bb9abee --- /dev/null +++ b/R/search_institutions.R @@ -0,0 +1,70 @@ +#' @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 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 +#' `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)) + 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 '", + 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..79b228eb --- /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 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` +#' 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)) + validate_flag(vb, "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..1c1d67fb --- /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 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` +#' 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)) + validate_flag(vb, "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 new file mode 100644 index 00000000..6f2162fc --- /dev/null +++ b/R/token_helpers.R @@ -0,0 +1,52 @@ +# Token-aware request helpers ------------------------------------------------- + +#' @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/utils.R b/R/utils.R index af9a6cdb..c2723162 100644 --- a/R/utils.R +++ b/R/utils.R @@ -8,363 +8,132 @@ #' NULL -#' Get Duration (In ms) Of A File. -#' -#' @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 the test video from databrary.org/volume/1 +#' get_permission_levels() #' } #' #' @export -get_file_duration <- function(asset_id = 1, - types_w_durations = c("-600", "-800"), - vb = options::opt("vb"), - rq = NULL) { - 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.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() +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. +#' +#' @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.") } - rq <- rq %>% - httr2::req_url(sprintf(GET_ASSET_BY_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) + 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 { - asset_df <- httr2::resp_body_json(resp) - if (asset_df$format %in% types_w_durations) { - asset_df$duration - } + 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() - } - 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 + +#---------------------------------------------------------------------------- +#' 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")) { + validate_flag(vb, "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")) { + validate_flag(vb, "vb") + constants <- assign_constants(vb = vb) + constants$format_df |> + dplyr::rename( + asset_type = name, + asset_type_id = id, + asset_category = category ) - 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 - } - } - } - - #---------------------------------------------------------------------------- - #' 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")) { - c <- assign_constants(vb = vb) - c$permission %>% unlist() - } - - #---------------------------------------------------------------------------- - #' 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 - #' - #' @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")) { - c <- assign_constants(vb = vb) - c$release %>% unlist() - } +} + +#---------------------------------------------------------------------------- +#' 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")) { - 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 - } + validate_flag(vb, "vb") - #---------------------------------------------------------------------------- - #' 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 - } - } + assertthat::is.string(replace_regex) + assertthat::assert_that(length(replace_regex) == 1) - #---------------------------------------------------------------------------- - #' 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 - )) - } + assertthat::is.string(replacement_char) + assertthat::assert_that(length(replacement_char) == 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 + if (vb) { + non_portable_chars <- stringr::str_detect(fn, replace_regex) + message("There are ", sum(non_portable_chars), " in ", fn) } - \ No newline at end of file + new_fn <- stringr::str_replace_all(fn, replace_regex, replacement_char) + new_fn +} diff --git a/R/whoami.R b/R/whoami.R new file mode 100644 index 00000000..7647f3e4 --- /dev/null +++ b/R/whoami.R @@ -0,0 +1,73 @@ +#' 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`. +#' @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. +#' +#' @examples +#' \\dontrun{ +#' login_db() +#' whoami() +#' } +#' @export +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) { + if (vb) + message("Authentication required: ", conditionMessage(err)) + NULL + } + ) + + if (is.null(req)) { + return(NULL) + } + + resp <- tryCatch( + 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)) + message("whoami -> request url: ", OAUTH_TEST_URL) + 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)) + return(NULL) + } + + httr2::resp_body_json(resp, simplifyVector = TRUE) +} diff --git a/README.Rmd b/README.Rmd index ce23e410..e7ccae6b 100644 --- a/README.Rmd +++ b/README.Rmd @@ -48,16 +48,46 @@ 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) +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_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_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/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/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_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/man/get_file_duration.Rd b/man/get_file_duration.Rd deleted file mode 100644 index ed6e2c60..00000000 --- a/man/get_file_duration.Rd +++ /dev/null @@ -1,34 +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( - asset_id = 1, - types_w_durations = c("-600", "-800"), - vb = options::opt("vb"), - rq = NULL -) -} -\arguments{ -\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 the test video from databrary.org/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_folder_file.Rd b/man/get_folder_file.Rd new file mode 100644 index 00000000..41889851 --- /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_folder_file(vol_id = 2, folder_id = 11, file_id = 1) +} +} +} 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/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_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/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_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/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/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/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/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/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/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_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/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_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/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_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/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/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/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/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/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_folder_asset.R b/tests/testthat/test-download_folder_asset.R new file mode 100644 index 00000000..16ca27ac --- /dev/null +++ b/tests/testthat/test-download_folder_asset.R @@ -0,0 +1,71 @@ +# 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 + } + ) + 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)) +}) + + + 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_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_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 45a0a7c7..34038857 100644 --- a/tests/testthat/test-download_session_zip.R +++ b/tests/testthat/test-download_session_zip.R @@ -2,28 +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", { - 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 f29cc225..35c5e254 100644 --- a/tests/testthat/test-download_volume_zip.R +++ b/tests/testthat/test-download_volume_zip.R @@ -2,24 +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", { - 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)) }) 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 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_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))) +}) 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 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 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_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))) +}) 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")) +}) 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 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-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 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")) + } +}) 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_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)) +}) 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_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)) + } +}) 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_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)) +}) 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-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..aebe7829 100644 --- a/tests/testthat/test-make_default_request.R +++ b/tests/testthat/test-make_default_request.R @@ -1,5 +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 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..6286b45e 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1,65 +1,26 @@ -# 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 rejects bad input parameters", { - 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_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) + login_test_account() + 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 +47,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 new file mode 100644 index 00000000..173dde50 --- /dev/null +++ b/tests/testthat/test-whoami.R @@ -0,0 +1,18 @@ +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() + login_test_account() + on.exit(clear_token_bundle(), add = TRUE) + + result <- whoami(refresh = TRUE, vb = FALSE) + skip_if_null_response(result, "whoami") + + 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() ```