diff --git a/.Rbuildignore b/.Rbuildignore index 4f1536ac..b511a8ce 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -9,7 +9,12 @@ ^_notes$ ^tmp$ ^_wip +^\.lintr$ ^\.github$ ^cran-comments\.md$ ^CRAN-SUBMISSION$ ^README.Rmd$ +^\.Renviron\.stg$ +^\.Renviron$ +^\.vscode$ +^\.Rprofile$ diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 14159b77..064247c6 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -2,9 +2,9 @@ # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help on: push: - branches: [main, master] + branches: [main, master, staging] pull_request: - branches: [main, master] + branches: [main, master, staging, development] name: R-CMD-check @@ -29,7 +29,7 @@ jobs: R_KEEP_PKG_SOURCE: yes steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@v6 - uses: r-lib/actions/setup-pandoc@v2 diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml new file mode 100644 index 00000000..7b788e06 --- /dev/null +++ b/.github/workflows/lint.yaml @@ -0,0 +1,36 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master, staging] + pull_request: + branches: [main, master, staging, development] + +name: lint + +permissions: read-all + +jobs: + lint: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - uses: actions/checkout@v6 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: lintr@3.2.0, any::pkgload, local::. + needs: lint + + - name: Lint + run: | + pkgload::load_all() + lintr::lint_package() + shell: Rscript {0} + env: + LINTR_ERROR_ON_LINT: true diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index a7276e85..93c997dd 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -1,9 +1,10 @@ # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +# Runs after R-CMD-check succeeds on main/master, or on release, or manually on: - push: - branches: [main, master] - pull_request: + workflow_run: + workflows: [R-CMD-check] + types: [completed] branches: [main, master] release: types: [published] @@ -14,15 +15,20 @@ name: pkgdown jobs: pkgdown: runs-on: ubuntu-latest + # Only run when R-CMD-check succeeded (for workflow_run), or for release/manual + if: github.event_name != 'workflow_run' || github.event.workflow_run.conclusion == 'success' # Only restrict concurrency for non-PR jobs concurrency: - group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} + group: pkgdown-${{ github.event_name != 'workflow_run' || github.run_id }} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} permissions: contents: write steps: - - uses: actions/checkout@v4 + - uses: actions/checkout@v6 + with: + # When triggered by workflow_run, checkout the commit that was checked + ref: ${{ github.event_name == 'workflow_run' && github.event.workflow_run.head_sha || github.ref }} - uses: r-lib/actions/setup-pandoc@v2 diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml new file mode 100644 index 00000000..25bed7c2 --- /dev/null +++ b/.github/workflows/test-coverage.yaml @@ -0,0 +1,71 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + pull_request: + branches: [main, master, staging, development] + +name: test-coverage + +permissions: read-all + +jobs: + test-coverage: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + + steps: + - uses: actions/checkout@v6 + + - uses: r-lib/actions/setup-r@v2 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::covr, any::xml2 + needs: coverage + + - name: Test coverage + run: | + cov <- covr::package_coverage( + quiet = FALSE, + clean = FALSE, + install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") + ) + print(cov) + covr::to_cobertura(cov) + pct <- covr::percent_coverage(cov) + cat("Coverage:", pct, "%\n") + # TODO: Re-enable coverage threshold once target is met + # if (pct < 80) stop("Coverage is below 80% (", pct, "%)") + if (pct < 80) { + warning("Coverage is below 80% (", pct, "%) - threshold temporarily disabled") + } else if (pct < 90) { + message("Coverage is below 90% (", pct, "%)") + } else { + message("Coverage is above 90% (", pct, "%)") + } + shell: Rscript {0} + + - uses: codecov/codecov-action@v6 + with: + fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }} + files: ./cobertura.xml + plugins: noop + disable_search: true + token: ${{ secrets.CODECOV_TOKEN }} + + - name: Show testthat output + if: always() + run: | + ## -------------------------------------------------------------------- + find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true + shell: bash + + - name: Upload test results + if: failure() + uses: actions/upload-artifact@v4 + with: + name: coverage-test-failures + path: ${{ runner.temp }}/package diff --git a/.gitignore b/.gitignore index b7c0678c..5625f5e5 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,5 @@ +.env +.env.* Meta doc .Rproj.user @@ -20,4 +22,5 @@ tmp docs /doc/ /Meta/ +.Renviron* diff --git a/.lintr b/.lintr new file mode 100644 index 00000000..652b2173 --- /dev/null +++ b/.lintr @@ -0,0 +1,2 @@ +linters: linters_with_defaults(line_length_linter = line_length_linter(120)) +exclusions: list("_wip", "tests/testthat", "vignettes", "R/CONSTANTS.R" = list(object_name_linter = Inf, object_length_linter = Inf), "R/aaa.R" = list(object_name_linter = Inf), "R/auth_utils.R" = list(object_name_linter = Inf), "R/utils.R" = list(object_name_linter = Inf)) diff --git a/DESCRIPTION b/DESCRIPTION index a91bbb3d..f312a76e 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 @@ -23,27 +25,29 @@ Imports: httr2 (>= 1.0.0), keyring (>= 1.3.2), lifecycle (>= 1.0.4), - magick (>= 2.8.2), magrittr, methods (>= 4.3.2), options (>= 0.2.0), purrr (>= 1.0.2), stringr (>= 1.5.1), stats, - tibble (>= 3.2.1), - xfun (>= 0.41) + tibble (>= 3.2.1) Suggests: av (>= 0.9.0), + covr (>= 3.6.0), ggplot2, knitr, + lintr (>= 3.0.0), openssl, readr, rmarkdown (>= 2.26), - testthat (>= 3.0.0) + testthat (>= 3.0.0), + withr (>= 2.5.0), + xml2 (>= 1.3.0) VignetteBuilder: knitr 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..d5eebbbc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,54 +1,118 @@ # Generated by roxygen2: do not edit by hand export("%>%") -export(HHMMSSmmm_to_ms) +export(add_default_record_to_session) export(assign_constants) +export(assign_record_to_file) +export(bulk_assign_records) +export(bulk_create_folders) +export(bulk_create_records) +export(bulk_create_sessions) +export(bulk_delete_files) +export(bulk_delete_folders) +export(bulk_delete_records) +export(bulk_delete_sessions) +export(bulk_rename_files) +export(bulk_rename_folders) +export(bulk_rename_sessions) +export(bulk_unassign_records) +export(bulk_upload_files) +export(check_duplicate_files_in_folder) +export(check_duplicate_files_in_session) export(check_ssl_certs) -export(download_party_avatar) +export(complete_upload) +export(create_folder) +export(create_session) +export(create_volume_record) +export(delete_folder) +export(delete_record_measure) +export(delete_session) +export(delete_session_file) +export(delete_volume_record) +export(disable_volume_category) +export(download_folder_asset) +export(download_folder_asset_from_df) +export(download_folder_assets_fr_df) +export(download_folder_zip) export(download_session_asset) +export(download_session_asset_from_df) export(download_session_assets_fr_df) export(download_session_csv) export(download_session_zip) -export(download_single_session_asset_fr_df) export(download_video) export(download_volume_zip) -export(get_asset_segment_range) +export(enable_volume_category) +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_institution_statistics) 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_upload_status) +export(get_user_avatar) +export(get_user_by_id) +export(get_user_statistics) export(get_volume_by_id) -export(is_institution) -export(is_person) +export(get_volume_collaborator_by_id) +export(get_volume_enabled_categories) +export(get_volume_record_by_id) +export(initiate_upload) export(list_asset_formats) export(list_authorized_investigators) -export(list_party_affiliates) -export(list_party_sponsors) -export(list_party_volumes) -export(list_session_activity) +export(list_categories) +export(list_folder_assets) +export(list_institution_affiliates) +export(list_institutions) 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(patch_folder) +export(patch_session) +export(patch_session_file) +export(remove_default_record_from_session) +export(resume_bulk) export(search_for_funder) -export(search_for_keywords) export(search_for_tags) +export(search_institutions) +export(search_users) +export(search_volumes) +export(set_record_measure) +export(set_volume_enabled_categories) +export(unassign_record_from_file) +export(update_folder) +export(update_session) +export(update_session_file) +export(update_volume_record) +export(upload_file) +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..a066a13b 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -1,74 +1,84 @@ #' Load Package-wide Constants into Local Environment #' #' +# Default; overridden at load time by .onLoad from DATABRARY_BASE_URL env var +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_USER_STATISTICS <- "/users/%s/statistics/" +API_INSTITUTIONS_LIST <- "/institutions/" +API_INSTITUTIONS <- "/institutions/%s/" +API_INSTITUTION_AFFILIATES <- "/institutions/%s/affiliates/" +API_INSTITUTION_AVATAR <- "/institutions/%s/avatar/" +API_INSTITUTION_STATISTICS <- "/institutions/%s/statistics/" +API_VOLUMES <- "/volumes/" +API_VOLUME_DETAIL <- "/volumes/%s/" +API_VOLUME_TAGS <- "/volumes/%s/tags/" +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_RECORD_MEASURES <- "/volumes/%s/records/%s/measures/%s/" +API_SESSION_DETAIL <- "/volumes/%s/sessions/%s/" +API_SESSION_ADD_DEFAULT_RECORD <- "/volumes/%s/sessions/%s/add-default-record/" +API_SESSION_REMOVE_DEFAULT_RECORD <- "/volumes/%s/sessions/%s/remove-default-record/" +API_SESSION_CHECK_DUPLICATE_FILES <- "/volumes/%s/sessions/%s/check-duplicate-files/" +API_SESSION_FILES <- "/volumes/%s/sessions/%s/files/" +API_SESSION_FILE_DETAIL <- "/volumes/%s/sessions/%s/files/%s/" +API_SESSION_FILE_ASSIGN <- "/volumes/%s/sessions/%s/files/%s/assign-record/" +API_SESSION_FILE_UNASSIGN <- "/volumes/%s/sessions/%s/files/%s/unassign-record/" +API_FILES_DOWNLOAD_LINK <- "/volumes/%s/sessions/%s/files/%s/download-link/" +API_SESSION_DOWNLOAD_LINK <- "/volumes/%s/sessions/%s/download-link/" +API_SESSION_CSV_DOWNLOAD_LINK <- "/volumes/%s/sessions/%s/csv-download-link/" +API_FOLDER_DETAIL <- "/volumes/%s/folders/%s/" +API_FOLDER_CHECK_DUPLICATE_FILES <- "/volumes/%s/folders/%s/check-duplicate-files/" +API_FOLDER_FILES <- "/volumes/%s/folders/%s/files/" +API_FOLDER_FILES_DETAIL <- "/volumes/%s/folders/%s/files/%s/" +API_FOLDER_DOWNLOAD_LINK <- "/volumes/%s/folders/%s/download-link/" +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/" +API_VOLUME_CATEGORIES <- "/volumes/%s/categories/" +API_UPLOADS_INITIATE <- "/uploads/initiate/" +API_UPLOADS_STATUS <- "/uploads/%s/status/" +API_UPLOADS_COMPLETE_MULTIPART <- "/uploads/complete-multipart/" +API_UPLOADS_ABORT_MULTIPART <- "/uploads/abort-multipart/" -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" +RETRY_LIMIT <- 3 +RETRY_WAIT_TIME <- 1 # seconds +RETRY_BACKOFF <- 2 # exponential backoff +REQUEST_TIMEOUT <- 5 # seconds +REQUEST_TIMEOUT_VERY_LONG <- 600 -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" +OAUTH_TOKEN_URL <- sprintf("%s/o/token/", DATABRARY_BASE_URL) +OAUTH_TEST_URL <- sprintf("%s/oauth2/test/", DATABRARY_BASE_URL) +LOGIN <- sprintf("%s/login/", DATABRARY_BASE_URL) -# Authentication parameters -USER_AGENT <- - "databraryr (https://cran.r-project.org/package=databraryr)" -KEYRING_SERVICE <- 'org.databrary.databraryr' +USER_AGENT <- paste0( + "databraryr/", + as.character(utils::packageVersion("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 +KEYRING_SERVICE <- "org.databrary.databraryr" diff --git a/R/aaa.R b/R/aaa.R index 39c050e9..9f92b091 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -17,10 +17,40 @@ NULL devtools.desc = list() ) toset <- !(names(op.devtools) %in% names(op)) - if(any(toset)) options(op.devtools[toset]) + if (any(toset)) options(op.devtools[toset]) + + base_url <- Sys.getenv("DATABRARY_BASE_URL", "https://api.databrary.org") + ns <- asNamespace(pkgname) + + for (nm in c("DATABRARY_BASE_URL", "OAUTH_TOKEN_URL", "OAUTH_TEST_URL", "LOGIN")) { + unlockBinding(nm, ns) + } + assign("DATABRARY_BASE_URL", base_url, envir = ns) + assign("OAUTH_TOKEN_URL", sprintf("%s/o/token/", base_url), envir = ns) + assign("OAUTH_TEST_URL", sprintf("%s/oauth2/test/", base_url), envir = ns) + assign("LOGIN", sprintf("%s/login/", base_url), envir = ns) + for (nm in c("DATABRARY_BASE_URL", "OAUTH_TOKEN_URL", "OAUTH_TEST_URL", "LOGIN")) { + lockBinding(nm, ns) + } invisible() } utils::globalVariables(".data") +# Internal: nullable API scalars — tibble/map_dfr drop raw NULL columns. +null_to_na_double <- function(x) { + if (is.null(x) || length(x) == 0L) { + return(NA_real_) + } + v <- suppressWarnings(as.numeric(x)) + if (length(v) == 0L || all(is.na(v))) NA_real_ else v[[1L]] +} + +null_to_na_character <- function(x) { + if (is.null(x) || length(x) == 0L) { + return(NA_character_) + } + tc <- suppressWarnings(as.character(x)) + if (length(tc) == 0L) NA_character_ else tc[[1L]] +} diff --git a/R/add_default_record_to_session.R b/R/add_default_record_to_session.R new file mode 100644 index 00000000..97b87eaf --- /dev/null +++ b/R/add_default_record_to_session.R @@ -0,0 +1,63 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Add a Default Record to a Session +#' +#' @description Attach a record to a session as a default record. Default +#' records apply to all files in the session unless overridden. The record +#' must either belong to the destination volume or be accessible to it via a +#' linked volume; the server enforces this and returns \code{403} otherwise. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} if the record was successfully added, \code{FALSE} +#' otherwise. +#' +#' @seealso \code{\link{remove_default_record_from_session}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' add_default_record_to_session(vol_id = 1, session_id = 42, record_id = 101) +#' } +#' } +#' @export +add_default_record_to_session <- function( + vol_id = 1, + session_id, + record_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer(record_id, "record_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + result <- perform_api_post( + path = sprintf(API_SESSION_ADD_DEFAULT_RECORD, vol_id, session_id), + body = list(record_id = record_id), + rq = rq, + vb = vb + ) + + if (is.null(result)) { + if (vb) { + message( + "Failed to add default record ", record_id, + " to session ", session_id, " in volume ", vol_id + ) + } + return(FALSE) + } + + TRUE +} diff --git a/R/api_utils.R b/R/api_utils.R new file mode 100644 index 00000000..5dc9d648 --- /dev/null +++ b/R/api_utils.R @@ -0,0 +1,494 @@ +# Internal helpers for interacting with the Databrary Django API. + +#' Validate that a value is a single positive integer (e.g. vol_id, record_id). +#' @noRd +assert_positive_integer <- function(x, name = deparse(substitute(x))) { + assertthat::assert_that( + length(x) == 1, + msg = paste(name, "must have length 1") + ) + assertthat::assert_that( + is.numeric(x), + msg = paste(name, "must be numeric") + ) + assertthat::assert_that(x >= 1, msg = paste(name, "must be >= 1")) + assertthat::assert_that( + x == floor(x), + msg = paste(name, "must be an integer") + ) + invisible(TRUE) +} + +#' @noRd +resp_has_body <- function(response) { + raw <- tryCatch( + httr2::resp_body_raw(response), + error = function(e) raw(0) + ) + length(raw) > 0 +} + +#' @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) + } + + status <- httr2::resp_status(response) + if (status == 204L || !resp_has_body(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 +} + +#' Extract one integer bucket from a file_counts object. +#' @noRd +file_count_value <- function(counts, key) { + value <- if (is.null(counts)) NULL else counts[[key]] + if (is.null(value) || length(value) == 0L) { + 0L + } else { + as.integer(value) + } +} + +#' @noRd +collect_paginated_get <- function(path, + params = list(), + 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)) + } + # API may return absolute next links with a different host/port than the + # configured base (e.g. http://localhost/... while DATABRARY_BASE_URL is + # http://localhost:8000). Re-anchor path+query to our base URL. + if (!is.null(next_url) && grepl("^https?://", next_url)) { + path_query <- sub("^https?://[^/]+", "", next_url) + if (!startsWith(path_query, "/")) { + path_query <- paste0("/", path_query) + } + next_url <- paste0(sub("/$", "", DATABRARY_BASE_URL), path_query) + } + + first_iter <- FALSE + } + + 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)) +} + +#' Iterative (non-recursive) conversion of all named-list keys to snake_case. +#' +#' Uses a BFS queue with nested numeric index paths (`obj[[c(i, j, ...)]]`) +#' to avoid hitting R's C-stack / expression-depth limits on deeply nested or +#' wide API responses. +#' @noRd +snake_case_list <- function(obj) { + if (!is.list(obj) && !(is.vector(obj) && !is.null(names(obj)))) { + return(obj) + } + + # Rename keys at the top level + if (!is.null(names(obj))) { + names(obj) <- vapply(names(obj), camel_to_snake, character(1)) + } + + # Seed the BFS queue with indices of children that need processing + queue <- list() + if (is.list(obj)) { + for (i in seq_along(obj)) { + el <- obj[[i]] + if (is.list(el) || (is.vector(el) && !is.null(names(el)))) { + queue <- c(queue, list(i)) + } + } + } + + while (length(queue) > 0) { + path <- queue[[1L]] + queue <- queue[-1L] + + node <- obj[[path]] + + if (!is.null(names(node))) { + names(node) <- vapply(names(node), camel_to_snake, character(1)) + obj[[path]] <- node + } + + if (is.list(node)) { + for (i in seq_along(node)) { + child <- node[[i]] + if (is.list(child) || + (is.vector(child) && !is.null(names(child)))) { + queue <- c(queue, list(c(path, i))) + } + } + } + } + + obj +} + +#' @noRd +perform_api_post <- function(path, + body = list(), + rq = NULL, + vb = FALSE, + normalize = TRUE) { + request <- rq + if (is.null(request)) { + request <- databraryr::make_default_request() + } + + url <- paste0(DATABRARY_BASE_URL, ensure_leading_slash(path)) + request <- httr2::req_url(request, url) + request <- httr2::req_method(request, "POST") + + if (!is.null(body) && length(body) > 0) { + request <- httr2::req_body_json(request, body) + } + + response <- tryCatch( + httr2::req_perform(request), + httr2_error = function(cnd) { + if (vb) { + message("POST request failed for ", url, ": ", conditionMessage(cnd)) + } + NULL + } + ) + + if (is.null(response)) { + return(NULL) + } + + status <- httr2::resp_status(response) + if (status == 204L || !resp_has_body(response)) { + return(TRUE) + } + + payload <- httr2::resp_body_json(response) + if (isTRUE(normalize)) { + payload <- snake_case_list(payload) + } + payload +} + +#' @noRd +perform_api_patch <- function(path, + body = list(), + rq = NULL, + vb = FALSE, + normalize = TRUE) { + request <- rq + if (is.null(request)) { + request <- databraryr::make_default_request() + } + + url <- paste0(DATABRARY_BASE_URL, ensure_leading_slash(path)) + request <- httr2::req_url(request, url) + request <- httr2::req_method(request, "PATCH") + + if (!is.null(body) && length(body) > 0) { + request <- httr2::req_body_json(request, body) + } + + response <- tryCatch( + httr2::req_perform(request), + httr2_error = function(cnd) { + if (vb) { + message("PATCH request failed for ", url, ": ", conditionMessage(cnd)) + } + NULL + } + ) + + if (is.null(response)) { + return(NULL) + } + + status <- httr2::resp_status(response) + if (status == 204L || !resp_has_body(response)) { + return(TRUE) + } + + payload <- httr2::resp_body_json(response) + if (isTRUE(normalize)) { + payload <- snake_case_list(payload) + } + payload +} + +#' @noRd +# TODO: verify behavior against the live API. Mirrors `perform_api_patch`, +# but no existing wrapper currently issues PUT, so this helper is unexercised. +perform_api_put <- function(path, + body = list(), + rq = NULL, + vb = FALSE, + normalize = TRUE) { + request <- rq + if (is.null(request)) { + request <- databraryr::make_default_request() + } + + url <- paste0(DATABRARY_BASE_URL, ensure_leading_slash(path)) + request <- httr2::req_url(request, url) + request <- httr2::req_method(request, "PUT") + + if (!is.null(body) && length(body) > 0) { + request <- httr2::req_body_json(request, body) + } + + response <- tryCatch( + httr2::req_perform(request), + httr2_error = function(cnd) { + if (vb) { + message("PUT request failed for ", url, ": ", conditionMessage(cnd)) + } + NULL + } + ) + + if (is.null(response)) { + return(NULL) + } + + status <- httr2::resp_status(response) + if (status == 204L || !resp_has_body(response)) { + return(TRUE) + } + + payload <- httr2::resp_body_json(response) + if (isTRUE(normalize)) { + payload <- snake_case_list(payload) + } + payload +} + +#' @noRd +perform_api_delete <- function(path, + rq = NULL, + vb = FALSE) { + request <- rq + if (is.null(request)) { + request <- databraryr::make_default_request() + } + + url <- paste0(DATABRARY_BASE_URL, ensure_leading_slash(path)) + request <- httr2::req_url(request, url) + request <- httr2::req_method(request, "DELETE") + + response <- tryCatch( + httr2::req_perform(request), + httr2_error = function(cnd) { + if (vb) { + message("DELETE request failed for ", url, ": ", conditionMessage(cnd)) + } + NULL + } + ) + + if (is.null(response)) { + return(FALSE) + } + + TRUE +} + +#' Normalize an API record payload (already snake_case) into the package list shape. +#' +#' Mirrors read-only fields from core \verb{RecordSerializer}: \verb{id}, \verb{volume}, +#' \verb{volume_name}, \verb{category_id}, \verb{measures}, \verb{birthday}, \verb{age}, +#' \verb{default_sessions}, \verb{record_source_kind}. +#' +#' @noRd +record_as_client_list <- function(record) { + age <- NULL + if (!is.null(record$age)) { + age <- list( + years = record$age$years, + months = record$age$months, + days = record$age$days, + total_days = record$age$total_days, + formatted_value = record$age$formatted_value, + is_estimated = record$age$is_estimated, + is_blurred = record$age$is_blurred + ) + } + + ds <- record$default_sessions + if (is.null(ds)) { + ds <- list() + } + + list( + record_id = record$id, + record_volume = record$volume, + record_volume_name = if (is.null(record$volume_name)) { + NA_character_ + } else { + as.character(record$volume_name) + }, + record_category_id = record$category_id, + measures = record$measures, + birthday = record$birthday, + age = age, + default_sessions = ds, + record_source_kind = if (is.null(record$record_source_kind)) { + NA_character_ + } else { + as.character(record$record_source_kind) + } + ) +} + +#' @noRd +#' @param optional If `TRUE`, `NULL` is allowed (parameter omitted from an API +#' call). If `FALSE`, `value` must be a single logical (e.g. `vb`). +validate_flag <- function(value, name, optional = FALSE) { + if (isTRUE(optional) && is.null(value)) { + return(invisible(NULL)) + } + assertthat::assert_that( + !is.null(value), + msg = paste0(name, " must not be NULL.") + ) + assertthat::assert_that(length(value) == 1) + assertthat::assert_that( + is.logical(value), + msg = paste0(name, " must be logical.") + ) + invisible(NULL) +} diff --git a/R/assign_constants.R b/R/assign_constants.R index bcc64bd3..85dfbf0b 100644 --- a/R/assign_constants.R +++ b/R/assign_constants.R @@ -1,43 +1,60 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL #' Download Databrary Constants From API. -#' +#' +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. #' @param rq An `httr2` request object. Defaults to NULL. #' #' @returns A data frame with the constants. -#' +#' #' @inheritParams options_params -#' +#' #' @examples -#' \donttest{ +#' \dontrun{ #' assign_constants() #' } #' @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 = get_permission_levels_enums(), + release = get_release_levels_enums() + ) } diff --git a/R/assign_record_to_file.R b/R/assign_record_to_file.R new file mode 100644 index 00000000..505b0dc9 --- /dev/null +++ b/R/assign_record_to_file.R @@ -0,0 +1,79 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Assign Record to Session File +#' +#' @description Assign a record to a session file, creating a record-file +#' association. This operation is idempotent - calling it multiple times with +#' the same parameters will not create duplicate associations. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param file_id Numeric file identifier. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer and +#' must belong to the specified volume. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return The response data on success, or \code{NULL} if the operation fails. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Assign a participant record to a video file +#' assign_record_to_file( +#' vol_id = 1, +#' session_id = 10, +#' file_id = 20, +#' record_id = 123 +#' ) +#' } +#' } +#' @export +assign_record_to_file <- function( + vol_id = 1, + session_id, + file_id, + record_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer(file_id, "file_id") + assert_positive_integer(record_id, "record_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Build request body + body <- list(record_id = record_id) + + # Perform API call + result <- perform_api_post( + path = sprintf(API_SESSION_FILE_ASSIGN, vol_id, session_id, file_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(result)) { + if (vb) { + message( + "Failed to assign record ", + record_id, + " to file ", + file_id, + " in session ", + session_id, + " of volume ", + vol_id + ) + } + return(NULL) + } + + result +} diff --git a/R/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..98c08688 --- /dev/null +++ b/R/auth_state.R @@ -0,0 +1,72 @@ +# 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/bulk_apply_internals.R b/R/bulk_apply_internals.R new file mode 100644 index 00000000..740f2397 --- /dev/null +++ b/R/bulk_apply_internals.R @@ -0,0 +1,213 @@ +# Internal helpers shared by bulk_* functions. This file is named +# bulk_apply_internals.R so it loads before other bulk_*.R files (ASCII order). + +# Internal: condition constructor for fast-fail with resumable partial state. +#' @noRd +databraryr_bulk_error <- function(message, partial, failed_input) { + structure( + class = c("databraryr_bulk_error", "error", "condition"), + list( + message = message, + partial = partial, + failed_input = failed_input, + call = sys.call(-1) + ) + ) +} + +# Internal: initialise the result tibble with one row per input. +#' @noRd +init_bulk_tibble <- function(inputs) { + tibble::tibble( + input = inputs, + status = rep("pending", length(inputs)), + result = vector("list", length(inputs)), + error = rep(NA_character_, length(inputs)), + reason = rep(NA_character_, length(inputs)) + ) +} + +# Internal: shared iteration engine. Each pending row runs `fn` with optional +# retries. On failure: `on_error = "stop"` throws `databraryr_bulk_error`; +# `on_error = "collect"` marks the row failed and continues. +# +# `fn` is invoked on each pending input. `is_failure(res)` decides whether the +# returned value (rather than a thrown error) should be treated as a failure. +#' @noRd +bulk_apply <- function(inputs, fn, + is_failure = function(res) is.null(res), + preflight = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0) { + on_error <- match.arg(on_error) + assertthat::assert_that( + is.numeric(max_retries), + length(max_retries) == 1L, + max_retries >= 0, + max_retries == floor(max_retries), + msg = "max_retries must be a single non-negative integer" + ) + assertthat::assert_that( + is.numeric(retry_delay), + length(retry_delay) == 1L, + retry_delay >= 0, + msg = "retry_delay must be a single non-negative number (seconds)" + ) + + state <- init_bulk_tibble(inputs) + + if (!is.null(preflight)) { + state <- preflight(state) + } + + pending_idx <- which(state$status == "pending") + max_retries <- as.integer(max_retries) + + for (i in pending_idx) { + attempt <- 0L + repeat { + res <- tryCatch(fn(state$input[[i]]), error = function(e) e) + failed <- inherits(res, "error") || isTRUE(is_failure(res)) + + if (!failed) { + state$status[i] <- "success" + state$result[[i]] <- res + break + } + + msg <- if (inherits(res, "error")) { + conditionMessage(res) + } else { + "operation returned a failure value (NULL or FALSE)" + } + + if (attempt >= max_retries) { + state$status[i] <- "failed" + state$error[i] <- msg + if (on_error == "stop") { + stop(databraryr_bulk_error( + message = sprintf( + "Bulk operation failed at input '%s': %s", + format(state$input[[i]]), msg + ), + partial = state, + failed_input = state$input[[i]] + )) + } + break + } + + attempt <- attempt + 1L + if (retry_delay > 0) { + Sys.sleep(as.numeric(retry_delay)) + } + } + } + + state +} + +# Internal: mark inputs whose basenames already exist in the target session or +# folder as "skipped" with reason "duplicate". `checker` is +# check_duplicate_files_in_session or check_duplicate_files_in_folder; `...` is +# forwarded (vol_id, session_id or folder_id, vb, rq). +#' @noRd +preflight_duplicates <- function(state, checker, ...) { + filenames <- basename(state$input) + dupes <- checker(filenames = filenames, ...) + if (is.null(dupes)) { + return(state) + } + + exists_lookup <- stats::setNames(dupes$exists, dupes$filename) + is_dupe <- !is.na(exists_lookup[filenames]) & + unname(exists_lookup[filenames]) + is_dupe[is.na(is_dupe)] <- FALSE + + state$status[is_dupe] <- "skipped" + state$reason[is_dupe] <- "duplicate" + state +} + +# Internal: argument validation ----------------------------------------------- + +#' @noRd +assert_recyclable <- function(x, n, name = "argument") { + if (is.null(x)) { + return(invisible(x)) + } + assertthat::assert_that( + length(x) %in% c(1L, n), + msg = sprintf("%s must be NULL, length 1, or length %d", name, n) + ) + invisible(x) +} + +#' @noRd +recycle_i <- function(x, i) { + if (is.null(x)) { + return(NULL) + } + if (length(x) == 1L) { + x[[1L]] + } else { + x[[i]] + } +} + +#' @noRd +assert_bulk_names <- function(names_vec, label = "names") { + assertthat::assert_that( + is.character(names_vec), + length(names_vec) >= 1L, + msg = paste(label, "must be a non-empty character vector") + ) + assertthat::assert_that( + !any(is.na(names_vec)), + msg = paste(label, "must not contain NA") + ) + trimmed <- trimws(names_vec) + assertthat::assert_that( + all(nzchar(trimmed)), + msg = paste(label, "must not contain empty or whitespace-only names") + ) + invisible(trimmed) +} + +#' @noRd +assert_file_paths <- function(file_paths) { + assertthat::assert_that( + is.character(file_paths), + length(file_paths) >= 1, + msg = "file_paths must be a non-empty character vector" + ) + assertthat::assert_that( + !any(is.na(file_paths)), + all(nzchar(file_paths)), + msg = "file_paths must not contain NA or empty strings" + ) + missing_files <- file_paths[!file.exists(file_paths)] + assertthat::assert_that( + length(missing_files) == 0, + msg = paste0( + "file_paths point to non-existent files: ", + paste(missing_files, collapse = ", ") + ) + ) +} + +#' @noRd +assert_positive_integer_vec <- function(x, name = deparse(substitute(x))) { + assertthat::assert_that( + is.numeric(x), + length(x) >= 1, + msg = paste(name, "must be a non-empty numeric vector") + ) + assertthat::assert_that( + !any(is.na(x)), + all(x >= 1), + all(x == floor(x)), + msg = paste(name, "must contain only positive integers") + ) +} diff --git a/R/bulk_files.R b/R/bulk_files.R new file mode 100644 index 00000000..a06b5e92 --- /dev/null +++ b/R/bulk_files.R @@ -0,0 +1,276 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Bulk Upload Files to a Databrary Session or Folder +#' +#' @description Upload many files sequentially to a single session or a single +#' folder. Optionally runs a preflight check for duplicate basenames and skips +#' those uploads. With \code{on_error = "stop"} (default), fails fast on the +#' first error and throws \code{databraryr_bulk_error} with a partial tibble for +#' \code{\link{resume_bulk}}. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Session id when uploading to a session. Exactly one of +#' \code{session_id} and \code{folder_id} must be non-\code{NULL}. +#' @param file_paths Character vector of local file paths to upload. Each must +#' point to an existing file. +#' @param folder_id Folder id when uploading to a folder. Exactly one of +#' \code{session_id} and \code{folder_id} must be non-\code{NULL}. +#' @param preflight Logical; if \code{TRUE} (default), skip files whose basename +#' already exists in the target session or folder (via +#' \code{\link{check_duplicate_files_in_session}} or +#' \code{\link{check_duplicate_files_in_folder}}). +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} (default) throws \code{databraryr_bulk_error} +#' on first failure after retries; \code{"collect"} marks failed rows and +#' continues. +#' @param max_retries Non-negative integer: extra attempts per input after the +#' first failure (default \code{0}). +#' @param retry_delay Seconds to sleep between retries (default \code{0}). +#' +#' @return A \code{tibble} with one row per input file and columns: +#' \code{input} (path), \code{status} (\code{"success"}, \code{"failed"}, +#' \code{"skipped"}, or \code{"pending"}), \code{result} (list-column with +#' the per-file API response or \code{NULL}), \code{error} (character +#' message on failure), and \code{reason} (e.g. \code{"duplicate"}). +#' +#' @seealso \code{\link{upload_file}}, +#' \code{\link{check_duplicate_files_in_session}}, +#' \code{\link{check_duplicate_files_in_folder}}, +#' \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' result <- bulk_upload_files( +#' vol_id = 1, +#' session_id = 42, +#' file_paths = c("/tmp/a.mp4", "/tmp/b.mp4") +#' ) +#' result <- bulk_upload_files( +#' vol_id = 1, +#' file_paths = c("/tmp/a.mp4", "/tmp/b.mp4"), +#' folder_id = 7 +#' ) +#' } +#' } +#' @export +bulk_upload_files <- function( + vol_id = 1, + session_id = NULL, + file_paths, + folder_id = NULL, + preflight = TRUE, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + has_session <- !is.null(session_id) + has_folder <- !is.null(folder_id) + assertthat::assert_that( + xor(has_session, has_folder), + msg = "Exactly one of session_id and folder_id must be non-NULL" + ) + if (has_session) { + assert_positive_integer(session_id, "session_id") + } else { + assert_positive_integer(folder_id, "folder_id") + } + assert_file_paths(file_paths) + assertthat::assert_that(is.logical(preflight), length(preflight) == 1) + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + dest_type <- if (has_session) "session" else "folder" + dest_id <- if (has_session) session_id else folder_id + + preflight_fn <- if (preflight) { + if (has_session) { + function(state) { + preflight_duplicates( + state, + check_duplicate_files_in_session, + vol_id = vol_id, + session_id = session_id, + vb = vb, + rq = rq + ) + } + } else { + function(state) { + preflight_duplicates( + state, + check_duplicate_files_in_folder, + vol_id = vol_id, + folder_id = folder_id, + vb = vb, + rq = rq + ) + } + } + } else { + NULL + } + + bulk_apply( + inputs = file_paths, + fn = function(p) { + upload_file( + path = p, + destination_type = dest_type, + object_id = dest_id, + vb = vb, + rq = rq + ) + }, + is_failure = function(res) is.null(res), + preflight = preflight_fn, + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Delete Files from a Databrary Session +#' +#' @description Soft-delete many files from a single session sequentially. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param file_ids Numeric vector of file identifiers. Must be positive +#' integers. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}. +#' +#' @seealso \code{\link{delete_session_file}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_delete_files(vol_id = 1, session_id = 42, file_ids = c(1001, 1002)) +#' } +#' } +#' @export +bulk_delete_files <- function( + vol_id = 1, + session_id, + file_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer_vec(file_ids, "file_ids") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = file_ids, + fn = function(id) { + delete_session_file( + vol_id = vol_id, session_id = session_id, file_id = id, + vb = vb, rq = rq + ) + }, + is_failure = function(res) is.null(res) || isFALSE(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Rename Files in a Databrary Session +#' +#' @description Rename many session files sequentially via +#' \code{\link{patch_session_file}} (\code{name} only). \code{file_ids} must be +#' unique. Folder assets are not supported here (no folder file PATCH helper). +#' With \code{\link{resume_bulk}}, pass \code{new_names} aligned to incomplete +#' rows. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier containing the files. +#' @param file_ids Numeric vector of file identifiers (unique positive integers). +#' @param new_names Character vector of new names, same length as \code{file_ids}. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +#' \code{input} is each file id. +#' +#' @seealso \code{\link{patch_session_file}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_rename_files( +#' vol_id = 1, +#' session_id = 42, +#' file_ids = c(1001, 1002), +#' new_names = c("clip_a.mp4", "clip_b.mp4") +#' ) +#' } +#' } +#' @export +bulk_rename_files <- function( + vol_id = 1, + session_id, + file_ids, + new_names, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer_vec(file_ids, "file_ids") + trimmed_names <- assert_bulk_names(new_names, "new_names") + assertthat::assert_that( + length(trimmed_names) == length(file_ids), + msg = "new_names must have the same length as file_ids" + ) + assertthat::assert_that( + !anyDuplicated(file_ids), + msg = "file_ids must be unique for bulk_rename_files()" + ) + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = file_ids, + fn = function(id) { + i <- match(id, file_ids) + patch_session_file( + vol_id = vol_id, + session_id = session_id, + file_id = id, + name = trimmed_names[[i]], + vb = vb, + rq = rq + ) + }, + is_failure = function(res) is.null(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} diff --git a/R/bulk_folders.R b/R/bulk_folders.R new file mode 100644 index 00000000..3b7adce5 --- /dev/null +++ b/R/bulk_folders.R @@ -0,0 +1,207 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Bulk Delete Folders from a Databrary Volume +#' +#' @description Soft-delete many folders from a single volume sequentially. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param folder_ids Numeric vector of folder identifiers. Must be positive +#' integers. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}. +#' +#' @seealso \code{\link{delete_folder}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_delete_folders(vol_id = 1, folder_ids = c(11, 12, 13)) +#' } +#' } +#' @export +bulk_delete_folders <- function( + vol_id = 1, + folder_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer_vec(folder_ids, "folder_ids") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = folder_ids, + fn = function(id) { + delete_folder(vol_id = vol_id, folder_id = id, vb = vb, rq = rq) + }, + is_failure = function(res) is.null(res) || isFALSE(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Rename Folders in a Databrary Volume +#' +#' @description Rename many folders sequentially via \code{\link{patch_folder}} +#' (\code{name} only). \code{folder_ids} must be unique. With +#' \code{\link{resume_bulk}}, pass \code{new_names} aligned to incomplete rows. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param folder_ids Numeric vector of folder identifiers (unique positive +#' integers). +#' @param new_names Character vector of new names, same length as +#' \code{folder_ids}. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +#' \code{input} is each folder id. +#' +#' @seealso \code{\link{patch_folder}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_rename_folders( +#' vol_id = 1, +#' folder_ids = c(11, 12), +#' new_names = c("Stimuli", "Protocols") +#' ) +#' } +#' } +#' @export +bulk_rename_folders <- function( + vol_id = 1, + folder_ids, + new_names, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer_vec(folder_ids, "folder_ids") + trimmed_names <- assert_bulk_names(new_names, "new_names") + assertthat::assert_that( + length(trimmed_names) == length(folder_ids), + msg = "new_names must have the same length as folder_ids" + ) + assertthat::assert_that( + !anyDuplicated(folder_ids), + msg = "folder_ids must be unique for bulk_rename_folders()" + ) + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = folder_ids, + fn = function(id) { + i <- match(id, folder_ids) + patch_folder( + vol_id = vol_id, + folder_id = id, + name = trimmed_names[[i]], + vb = vb, + rq = rq + ) + }, + is_failure = function(res) is.null(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Create Folders in a Databrary Volume +#' +#' @description Create many folders sequentially. \code{input} in the result +#' tibble is the folder name for that row (after trimming). \code{folder_names} +#' must be unique. Optional fields are recycled: length 1 or same length as +#' \code{folder_names}. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param folder_names Non-empty character vector of folder names (trimmed; +#' none may be empty after trimming). +#' @param release_level Optional character vector (length 1 or +#' \code{length(folder_names)}), passed per row to \code{\link{create_folder}}. +#' @param source_date Optional \code{Date}, ISO string, or vector thereof +#' (length 1 or \code{length(folder_names)}). +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}, +#' with \code{input} equal to the trimmed folder name for each row. +#' +#' @seealso \code{\link{create_folder}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_create_folders(vol_id = 1, folder_names = c("A", "B", "C")) +#' } +#' } +#' @export +bulk_create_folders <- function( + vol_id = 1, + folder_names, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + trimmed <- assert_bulk_names(folder_names, "folder_names") + n <- length(trimmed) + assertthat::assert_that( + !anyDuplicated(trimmed), + msg = "folder_names must be unique for bulk_create_folders() (required for resume_bulk)" + ) + assert_recyclable(release_level, n, "release_level") + assert_recyclable(source_date, n, "source_date") + + assert_positive_integer(vol_id, "vol_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = trimmed, + fn = function(nm) { + i <- match(nm, trimmed) + create_folder( + vol_id = vol_id, + name = nm, + release_level = recycle_i(release_level, i), + source_date = recycle_i(source_date, i), + vb = vb, + rq = rq + ) + }, + is_failure = function(res) is.null(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} diff --git a/R/bulk_records.R b/R/bulk_records.R new file mode 100644 index 00000000..4b8516ea --- /dev/null +++ b/R/bulk_records.R @@ -0,0 +1,259 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Bulk Create Records in a Databrary Volume +#' +#' @description Create many records sequentially via +#' \code{\link{create_volume_record}} with empty \code{measures} aside from the +#' resolved name metric. \code{record_names} must be unique (for +#' \code{\link{resume_bulk}}). \code{category_id} may be length 1 or match +#' \code{record_names}. Per-row \code{measures} / \code{participant} are not +#' supported; call \code{\link{create_volume_record}} for those cases. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param record_names Non-empty character vector of record display names (trimmed). +#' @param category_id Numeric category id(s); length 1 or \code{length(record_names)}. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +#' \code{input} is each trimmed record name. +#' +#' @seealso \code{\link{create_volume_record}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_create_records( +#' vol_id = 1, +#' record_names = c("P101", "P102"), +#' category_id = 6 +#' ) +#' } +#' } +#' @export +bulk_create_records <- function( + vol_id = 1, + record_names, + category_id, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + trimmed <- assert_bulk_names(record_names, "record_names") + n <- length(trimmed) + assertthat::assert_that( + !anyDuplicated(trimmed), + msg = "record_names must be unique for bulk_create_records() (required for resume_bulk)" + ) + if (length(category_id) == 1L) { + assert_positive_integer(category_id, "category_id") + } else { + assert_positive_integer_vec(category_id, "category_id") + } + assert_recyclable(category_id, n, "category_id") + + assert_positive_integer(vol_id, "vol_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = trimmed, + fn = function(nm) { + i <- match(nm, trimmed) + create_volume_record( + vol_id = vol_id, + category_id = recycle_i(category_id, i), + name = nm, + measures = list(), + participant = NULL, + vb = vb, + rq = rq + ) + }, + is_failure = function(res) is.null(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Delete Records from a Databrary Volume +#' +#' @description Soft-delete many volume records sequentially via +#' \code{\link{delete_volume_record}}. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param record_ids Numeric vector of record identifiers (positive integers). +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +#' \code{input} is each record id. +#' +#' @seealso \code{\link{delete_volume_record}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_delete_records(vol_id = 1, record_ids = c(101, 102)) +#' } +#' } +#' @export +bulk_delete_records <- function( + vol_id = 1, + record_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer_vec(record_ids, "record_ids") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = record_ids, + fn = function(id) { + delete_volume_record(vol_id = vol_id, record_id = id, vb = vb, rq = rq) + }, + is_failure = function(res) is.null(res) || isFALSE(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Assign Default Records to a Session +#' +#' @description For each record id, call \code{\link{add_default_record_to_session}} +#' so the record becomes a session default. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. +#' @param record_ids Numeric vector of record identifiers. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +#' \code{input} is each record id. +#' +#' @seealso \code{\link{add_default_record_to_session}}, +#' \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_assign_records(vol_id = 1, session_id = 42, record_ids = c(101, 102)) +#' } +#' } +#' @export +bulk_assign_records <- function( + vol_id = 1, + session_id, + record_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer_vec(record_ids, "record_ids") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = record_ids, + fn = function(id) { + add_default_record_to_session( + vol_id = vol_id, + session_id = session_id, + record_id = id, + vb = vb, + rq = rq + ) + }, + is_failure = function(res) isFALSE(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Unassign Default Records from a Session +#' +#' @description For each record id, call +#' \code{\link{remove_default_record_from_session}}. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. +#' @param record_ids Numeric vector of record identifiers. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +#' \code{input} is each record id. +#' +#' @seealso \code{\link{remove_default_record_from_session}}, +#' \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_unassign_records(vol_id = 1, session_id = 42, record_ids = c(101, 102)) +#' } +#' } +#' @export +bulk_unassign_records <- function( + vol_id = 1, + session_id, + record_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer_vec(record_ids, "record_ids") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = record_ids, + fn = function(id) { + remove_default_record_from_session( + vol_id = vol_id, + session_id = session_id, + record_id = id, + vb = vb, + rq = rq + ) + }, + is_failure = function(res) isFALSE(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} diff --git a/R/bulk_resume.R b/R/bulk_resume.R new file mode 100644 index 00000000..43b3ffd5 --- /dev/null +++ b/R/bulk_resume.R @@ -0,0 +1,129 @@ +#' Resume a Bulk Operation After a Failure +#' +#' @description When a \code{bulk_*} run ends with incomplete rows (either +#' because \code{on_error = "stop"} threw \code{databraryr_bulk_error} or +#' because \code{on_error = "collect"} left \code{"failed"} / \code{"pending"} +#' rows), \code{resume_bulk()} re-runs the supplied bulk function on those rows +#' and merges the result, preserving original input order. +#' +#' @param partial A tibble produced by a previous \code{bulk_*} call (typically +#' extracted from a \code{databraryr_bulk_error} condition via +#' \code{conditionMessage} / direct access to \code{cond$partial}). +#' @param fn The bulk function to re-invoke (e.g. \code{bulk_upload_files}). +#' @param ... Additional arguments forwarded to \code{fn} (for example +#' \code{vol_id}, \code{session_id}, \code{vb}, \code{rq}). The remaining +#' inputs are passed as the function's input vector argument under the name +#' \code{input_arg} (default: auto-detected from the function's formals). +#' @param input_arg Optional name of the input argument of \code{fn}. If +#' \code{NULL} (default), it is inferred as the first formal of \code{fn} +#' matching one of \code{file_paths}, \code{session_ids}, \code{folder_ids}, +#' \code{file_ids}, \code{session_names}, \code{folder_names}, +#' \code{record_ids}, \code{record_names}. +#' +#' @return A tibble of the same shape as \code{partial}, with rows from the +#' resumed run substituted in for previously incomplete rows. +#' +#' @details If \code{fn} itself fast-fails (\code{on_error = "stop"}), the +#' re-thrown \code{databraryr_bulk_error}'s \code{$partial} is the \strong{full +#' accumulated tibble} (outcomes from all prior runs merged with the latest +#' attempt), so you can safely pass it back to \code{resume_bulk()} in a loop +#' without losing rows that already succeeded. +#' +#' @seealso \code{\link{bulk_upload_files}}, \code{\link{bulk_delete_sessions}}, +#' \code{\link{bulk_delete_folders}}, \code{\link{bulk_delete_files}}, +#' \code{\link{bulk_create_sessions}}, \code{\link{bulk_create_folders}}, +#' \code{\link{bulk_rename_sessions}}, \code{\link{bulk_rename_folders}}, +#' \code{\link{bulk_rename_files}}, \code{\link{bulk_create_records}}, +#' \code{\link{bulk_delete_records}}, \code{\link{bulk_assign_records}}, +#' \code{\link{bulk_unassign_records}} +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' result <- tryCatch( +#' bulk_upload_files( +#' vol_id = 1, session_id = 42, +#' file_paths = c("/tmp/a.mp4", "/tmp/b.mp4") +#' ), +#' databraryr_bulk_error = function(e) e$partial +#' ) +#' # ... fix the failing file, then: +#' result <- resume_bulk(result, bulk_upload_files, +#' vol_id = 1, session_id = 42) +#' } +#' } +#' @export +resume_bulk <- function(partial, fn, ..., input_arg = NULL) { + assertthat::assert_that( + inherits(partial, "tbl_df"), + all(c("input", "status") %in% names(partial)), + msg = "partial must be a tibble produced by a bulk_* function" + ) + assertthat::assert_that(is.function(fn)) + + to_redo <- partial$status %in% c("pending", "failed") + if (!any(to_redo)) { + return(partial) + } + + if (is.null(input_arg)) { + input_arg <- detect_input_arg(fn) + } + + remaining <- partial$input[to_redo] + args <- list(...) + args[[input_arg]] <- remaining + + out <- partial + redo_idx <- which(to_redo) + + inner_result <- tryCatch( + list(ok = TRUE, val = do.call(fn, args)), + databraryr_bulk_error = function(e) list(ok = FALSE, err = e) + ) + + if (!isTRUE(inner_result$ok)) { + inner <- inner_result$err$partial + for (k in seq_along(redo_idx)) { + i <- redo_idx[k] + out$status[i] <- inner$status[k] + out$result[i] <- inner$result[k] + out$error[i] <- inner$error[k] + out$reason[i] <- inner$reason[k] + } + stop(databraryr_bulk_error( + message = inner_result$err$message, + partial = out, + failed_input = inner_result$err$failed_input + )) + } + + new_rows <- inner_result$val + for (k in seq_along(redo_idx)) { + i <- redo_idx[k] + out$status[i] <- new_rows$status[k] + out$result[i] <- new_rows$result[k] + out$error[i] <- new_rows$error[k] + out$reason[i] <- new_rows$reason[k] + } + out +} + +# Internal: infer which formal of a bulk_* function takes the vector of inputs. +#' @noRd +detect_input_arg <- function(fn) { + candidates <- c( + "file_paths", "session_ids", "folder_ids", "file_ids", + "session_names", "folder_names", + "record_ids", "record_names" + ) + hit <- intersect(names(formals(fn)), candidates) + assertthat::assert_that( + length(hit) == 1, + msg = paste0( + "Could not infer input argument of fn; pass `input_arg` explicitly. ", + "Looked for one of: ", paste(candidates, collapse = ", ") + ) + ) + hit +} diff --git a/R/bulk_sessions.R b/R/bulk_sessions.R new file mode 100644 index 00000000..7f66b982 --- /dev/null +++ b/R/bulk_sessions.R @@ -0,0 +1,212 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Bulk Delete Sessions from a Databrary Volume +#' +#' @description Soft-delete many sessions from a single volume sequentially. +#' With \code{on_error = "stop"} (default), fails fast and throws +#' \code{databraryr_bulk_error}; with \code{"collect"}, marks failed rows and +#' continues. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_ids Numeric vector of session identifiers. Must be positive +#' integers. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}. +#' +#' @seealso \code{\link{delete_session}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_delete_sessions(vol_id = 1, session_ids = c(101, 102, 103)) +#' } +#' } +#' @export +bulk_delete_sessions <- function( + vol_id = 1, + session_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer_vec(session_ids, "session_ids") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = session_ids, + fn = function(id) { + delete_session(vol_id = vol_id, session_id = id, vb = vb, rq = rq) + }, + is_failure = function(res) is.null(res) || isFALSE(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Rename Sessions in a Databrary Volume +#' +#' @description Rename many sessions sequentially via \code{\link{patch_session}} +#' (\code{name} only). \code{session_ids} must be unique so each row maps to one +#' name. With \code{\link{resume_bulk}}, pass \code{new_names} aligned to the +#' subset of ids being retried (same order as incomplete rows). +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_ids Numeric vector of session identifiers (unique positive +#' integers). +#' @param new_names Character vector of new names, same length as +#' \code{session_ids}. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +#' \code{input} is each session id. +#' +#' @seealso \code{\link{patch_session}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_rename_sessions( +#' vol_id = 1, +#' session_ids = c(101, 102), +#' new_names = c("Lab visit A", "Lab visit B") +#' ) +#' } +#' } +#' @export +bulk_rename_sessions <- function( + vol_id = 1, + session_ids, + new_names, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer_vec(session_ids, "session_ids") + trimmed_names <- assert_bulk_names(new_names, "new_names") + assertthat::assert_that( + length(trimmed_names) == length(session_ids), + msg = "new_names must have the same length as session_ids" + ) + assertthat::assert_that( + !anyDuplicated(session_ids), + msg = "session_ids must be unique for bulk_rename_sessions()" + ) + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = session_ids, + fn = function(id) { + i <- match(id, session_ids) + patch_session( + vol_id = vol_id, + session_id = id, + name = trimmed_names[[i]], + vb = vb, + rq = rq + ) + }, + is_failure = function(res) is.null(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} + +#' Bulk Create Sessions in a Databrary Volume +#' +#' @description Create many sessions sequentially. \code{input} in the result +#' tibble is the session name for that row (after trimming). \code{session_names} +#' must be unique. Optional fields are recycled. Structured \code{date}, +#' \code{date_precision}, and +#' \code{default_records} are not supported here; use \code{\link{create_session}} +#' per row if you need them. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_names Non-empty character vector of session names. +#' @param release_level Optional character vector (length 1 or +#' \code{length(session_names)}). +#' @param source_date Optional \code{Date}, ISO string, or vector thereof +#' (length 1 or \code{length(session_names)}). +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @param on_error \code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}. +#' @param max_retries Non-negative integer; extra attempts per input after the first failure. +#' @param retry_delay Seconds between retries. +#' +#' @return A \code{tibble} as documented in \code{\link{bulk_upload_files}}, +#' with \code{input} equal to the trimmed session name for each row. +#' +#' @seealso \code{\link{create_session}}, \code{\link{resume_bulk}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' bulk_create_sessions(vol_id = 1, session_names = c("S1", "S2")) +#' } +#' } +#' @export +bulk_create_sessions <- function( + vol_id = 1, + session_names, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) { + trimmed <- assert_bulk_names(session_names, "session_names") + n <- length(trimmed) + assertthat::assert_that( + !anyDuplicated(trimmed), + msg = "session_names must be unique for bulk_create_sessions() (required for resume_bulk)" + ) + assert_recyclable(release_level, n, "release_level") + assert_recyclable(source_date, n, "source_date") + + assert_positive_integer(vol_id, "vol_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + bulk_apply( + inputs = trimmed, + fn = function(nm) { + i <- match(nm, trimmed) + create_session( + vol_id = vol_id, + name = nm, + release_level = recycle_i(release_level, i), + source_date = recycle_i(source_date, i), + vb = vb, + rq = rq + ) + }, + is_failure = function(res) is.null(res), + on_error = on_error, + max_retries = max_retries, + retry_delay = retry_delay + ) +} diff --git a/R/check_duplicate_files_in_folder.R b/R/check_duplicate_files_in_folder.R new file mode 100644 index 00000000..15a7797e --- /dev/null +++ b/R/check_duplicate_files_in_folder.R @@ -0,0 +1,87 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Check Whether Filenames Already Exist in a Folder +#' +#' @description Ask the server which of the supplied filenames already +#' exist as files in the given folder. Useful before bulk uploads to detect +#' name collisions in advance. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param folder_id Numeric folder identifier. Must be a positive integer. +#' @param filenames Character vector of filenames to check. Length must be +#' at least 1; each element must be a non-empty string. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A \code{tibble} with columns \code{filename} (character) and +#' \code{exists} (logical), one row per input filename and in the same +#' order. Returns \code{NULL} if the request fails. Against current staging API, +#' a missing \code{folder_id} still yields a successful response with +#' \code{exists = FALSE} for each filename (nothing matches that folder). +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' check_duplicate_files_in_folder( +#' vol_id = 1, +#' folder_id = 42, +#' filenames = c("clip_001.mp4", "clip_002.mp4") +#' ) +#' } +#' } +#' @export +check_duplicate_files_in_folder <- function( # nolint: object_length_linter. + vol_id = 1, + folder_id, + filenames, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(folder_id, "folder_id") + + assertthat::assert_that( + is.character(filenames), + length(filenames) >= 1, + msg = "filenames must be a non-empty character vector" + ) + assertthat::assert_that( + !any(is.na(filenames)), + all(nzchar(trimws(filenames))), + msg = "filenames must not contain NA or empty strings" + ) + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # `as.list()` on a length-1 character would still serialize to a JSON array + # via httr2, but be explicit so the contract matches the server's expected + # `[...]` shape regardless of length. + body <- list(filenames = as.list(filenames)) + + result <- perform_api_post( + path = sprintf(API_FOLDER_CHECK_DUPLICATE_FILES, vol_id, folder_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(result) || isTRUE(result)) { + if (vb) { + message( + "Failed to check duplicate filenames in folder ", + folder_id, " of volume ", vol_id + ) + } + return(NULL) + } + + tibble::tibble( + filename = vapply(result, function(r) as.character(r$filename), character(1)), + exists = vapply(result, function(r) isTRUE(r$exists), logical(1)) + ) +} diff --git a/R/check_duplicate_files_in_session.R b/R/check_duplicate_files_in_session.R new file mode 100644 index 00000000..a535bbc2 --- /dev/null +++ b/R/check_duplicate_files_in_session.R @@ -0,0 +1,87 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Check Whether Filenames Already Exist in a Session +#' +#' @description Ask the server which of the supplied filenames already +#' exist as files in the given session. Useful before bulk uploads to detect +#' name collisions in advance. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param filenames Character vector of filenames to check. Length must be +#' at least 1; each element must be a non-empty string. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A \code{tibble} with columns \code{filename} (character) and +#' \code{exists} (logical), one row per input filename and in the same +#' order. Returns \code{NULL} if the request fails. The server answers +#' successfully even when \code{session_id} does not exist: every file is +#' reported as \code{exists = FALSE} (no rows match that session). +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' check_duplicate_files_in_session( +#' vol_id = 1, +#' session_id = 42, +#' filenames = c("clip_001.mp4", "clip_002.mp4") +#' ) +#' } +#' } +#' @export +check_duplicate_files_in_session <- function( # nolint: object_length_linter. + vol_id = 1, + session_id, + filenames, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + + assertthat::assert_that( + is.character(filenames), + length(filenames) >= 1, + msg = "filenames must be a non-empty character vector" + ) + assertthat::assert_that( + !any(is.na(filenames)), + all(nzchar(trimws(filenames))), + msg = "filenames must not contain NA or empty strings" + ) + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # `as.list()` on a length-1 character would still serialize to a JSON array + # via httr2, but be explicit so the contract matches the server's expected + # `[...]` shape regardless of length. + body <- list(filenames = as.list(filenames)) + + result <- perform_api_post( + path = sprintf(API_SESSION_CHECK_DUPLICATE_FILES, vol_id, session_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(result) || isTRUE(result)) { + if (vb) { + message( + "Failed to check duplicate filenames in session ", + session_id, " of volume ", vol_id + ) + } + return(NULL) + } + + tibble::tibble( + filename = vapply(result, function(r) as.character(r$filename), character(1)), + exists = vapply(result, function(r) isTRUE(r$exists), logical(1)) + ) +} diff --git a/R/check_ssl_certs.R b/R/check_ssl_certs.R index 9d49f773..bbb5b654 100644 --- a/R/check_ssl_certs.R +++ b/R/check_ssl_certs.R @@ -1,14 +1,14 @@ #' Check SSL Certificates For nyu.databary.org. -#' +#' #' `check_ssl_certs` checks the SSL certificates for nyu.databrary.org #' and returns a data frame with the relevant information. -#' +#' #' @param host Target URL. Defaults to 'nyu.databrary.org'. -#' +#' #' @returns A data frame with information about the SSL certificates. -#' +#' #' @examples -#' \donttest{ +#' \dontrun{ #' check_ssl_certs() #' } #' @export @@ -19,10 +19,10 @@ check_ssl_certs <- function(host = "nyu.databrary.org") { x <- openssl::download_ssl_cert(host) validity_dates <- lapply(x, `[[`, "validity") issuer <- lapply(x, `[[`, "issuer") - + df <- data.frame(issuer = unlist(issuer), - start_date = unlist(lapply(validity_dates, '[[', 1)), - exp_date = unlist(lapply(validity_dates, '[[', 2))) - + start_date = unlist(lapply(validity_dates, "[[", 1)), + exp_date = unlist(lapply(validity_dates, "[[", 2))) + df } diff --git a/R/complete_upload.R b/R/complete_upload.R new file mode 100644 index 00000000..487bdacf --- /dev/null +++ b/R/complete_upload.R @@ -0,0 +1,104 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Complete a Multipart Upload +#' +#' @description Tell the Databrary API that all parts of a multipart upload +#' have been PUT to S3 and the object can be assembled. The server forwards +#' the part list to S3's \code{CompleteMultipartUpload}, transitioning the +#' upload into the post-upload pipeline (virus scan, format probe). +#' +#' Only needed when \code{initiate_upload()} returned +#' \code{upload_type == "multipart"}. Single-PUT uploads complete implicitly +#' once the object lands in storage. +#' +#' @param upload_guid Character GUID returned in \code{initiate_upload()$upload_guid}. +#' @param s3_upload_id Character S3 upload ID returned in +#' \code{initiate_upload()$s3_upload_id}. +#' @param parts A list of one entry per part, each a list with +#' \code{part_number} (positive integer) and \code{etag} (character, +#' from the \code{ETag} response header of the part PUT). Order is not +#' significant -- the server sorts by \code{part_number}. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} on success, \code{NULL} on failure. +#' +#' @inheritParams options_params +#' +#' @seealso \code{\link{initiate_upload}}, \code{\link{upload_file}} +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' complete_upload( +#' upload_guid = "abc...", +#' s3_upload_id = "xyz...", +#' parts = list( +#' list(part_number = 1L, etag = "etag-of-part-1"), +#' list(part_number = 2L, etag = "etag-of-part-2") +#' ) +#' ) +#' } +#' } +#' @export +complete_upload <- function( + upload_guid, + s3_upload_id, + parts, + vb = options::opt("vb"), + rq = NULL +) { + assertthat::assert_that( + is.character(upload_guid), length(upload_guid) == 1, nzchar(upload_guid) + ) + assertthat::assert_that( + is.character(s3_upload_id), length(s3_upload_id) == 1, nzchar(s3_upload_id) + ) + assertthat::assert_that( + is.list(parts), length(parts) >= 1, + msg = "parts must be a non-empty list" + ) + + # Coerce each entry to the wire shape and validate. Mutates only the local + # copy. + parts <- lapply(parts, function(p) { + assertthat::assert_that( + is.list(p), !is.null(p$part_number), !is.null(p$etag), + msg = "each parts entry must be a list with part_number and etag" + ) + pn <- p$part_number + assertthat::assert_that( + is.numeric(pn), length(pn) == 1, pn >= 1, pn == floor(pn), + msg = "part_number must be a positive integer" + ) + assertthat::assert_that( + is.character(p$etag), length(p$etag) == 1, nzchar(p$etag), + msg = "etag must be a non-empty string" + ) + list(part_number = as.integer(pn), etag = unquote_etag(p$etag)) + }) + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + result <- perform_api_post( + path = API_UPLOADS_COMPLETE_MULTIPART, + body = list( + upload_guid = upload_guid, + s3_upload_id = s3_upload_id, + parts = parts + ), + rq = rq, + vb = vb + ) + + if (is.null(result)) { + if (vb) { + message("Failed to complete multipart upload ", upload_guid) + } + return(NULL) + } + TRUE +} diff --git a/R/create_folder.R b/R/create_folder.R new file mode 100644 index 00000000..a84e0d5d --- /dev/null +++ b/R/create_folder.R @@ -0,0 +1,90 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Create Folder in Databrary Volume +#' +#' @description Create a new folder in a Databrary volume. \code{name} is +#' required and must be non-empty. Folders group files together but, unlike +#' sessions, do not carry structured date / default-record metadata. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param name Display name for the folder. Required, non-empty after trim. +#' @param release_level Optional release level for the folder +#' (e.g. \code{"PRIVATE"}, \code{"SHARED"}, \code{"EXCERPTS"}, +#' \code{"PUBLIC"}). The server validates the choice. +#' @param source_date Optional folder date. A length-1 \code{Date} object or +#' ISO \code{"YYYY-MM-DD"} string. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the created folder's metadata (same shape as +#' \code{\link{get_folder_by_id}}), or \code{NULL} if creation fails. +#' +#' @seealso \code{\link{update_folder}}, \code{\link{patch_folder}}, +#' \code{\link{delete_folder}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Minimal folder +#' create_folder(vol_id = 1, name = "Stimuli") +#' +#' # Folder with a release level and date +#' create_folder( +#' vol_id = 1, +#' name = "Stimuli", +#' release_level = "SHARED", +#' source_date = as.Date("2024-03-15") +#' ) +#' } +#' } +#' @export +create_folder <- function( + vol_id = 1, + name, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + + assertthat::assert_that(is.character(name), length(name) == 1) + assertthat::assert_that(nzchar(trimws(name)), msg = "name must not be empty") + + if (!is.null(release_level)) { + assertthat::assert_that( + is.character(release_level), + length(release_level) == 1, + nzchar(trimws(release_level)) + ) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list(name = name) + if (!is.null(release_level)) body$release_level <- release_level + if (!is.null(source_date)) { + body$source_date <- coerce_iso_date(source_date, "source_date") + } + + folder <- perform_api_post( + path = sprintf(API_VOLUME_FOLDERS, vol_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(folder)) { + if (vb) { + message("Failed to create folder in volume ", vol_id) + } + return(NULL) + } + + folder +} diff --git a/R/create_session.R b/R/create_session.R new file mode 100644 index 00000000..4b7e9687 --- /dev/null +++ b/R/create_session.R @@ -0,0 +1,177 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Coerce a date-like argument to an ISO "YYYY-MM-DD" string. +#' +#' Accepts a `Date` object or a length-1 character already in ISO form. +#' +#' @noRd +coerce_iso_date <- function(value, name) { + if (inherits(value, "Date")) { + assertthat::assert_that( + length(value) == 1, + msg = paste(name, "must have length 1") + ) + return(format(value, "%Y-%m-%d")) + } + assertthat::assert_that( + is.character(value), + length(value) == 1, + nzchar(trimws(value)), + msg = paste(name, "must be a Date or non-empty 'YYYY-MM-DD' string") + ) + parsed <- tryCatch(as.Date(value), error = function(e) NA) + assertthat::assert_that( + !is.na(parsed), + msg = paste(name, "must parse as a date (e.g. '2024-03-15')") + ) + format(parsed, "%Y-%m-%d") +} + +#' Create Session in Databrary Volume +#' +#' @description Create a new session in a Databrary volume. A session (a.k.a. +#' "slot") groups files and metadata for a single recording or testing event. +#' \code{name} is required and must be non-empty. Provide either a flat +#' \code{source_date} or a structured \code{date} list (with optional +#' \code{date_precision}) to record when the session occurred -- not both. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param name Display name for the session. Required, non-empty after trim. +#' @param release_level Optional release level for the session +#' (e.g. \code{"PRIVATE"}, \code{"SHARED"}, \code{"EXCERPTS"}, +#' \code{"PUBLIC"}). The server validates the choice. +#' @param source_date Optional session date. A length-1 \code{Date} object or +#' ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}. +#' @param date Optional structured date list with named fields \code{year}, +#' \code{month}, \code{day}, and optional \code{is_estimated} (logical). +#' Mutually exclusive with \code{source_date}. +#' @param date_precision Optional precision for \code{date}: e.g. +#' \code{"FULL"}, \code{"YEAR"}. Server validates the choice. +#' @param default_records Optional integer vector of record IDs to set as +#' default records on the new session. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the created session's metadata (same shape as +#' \code{\link{get_session_by_id}}), or \code{NULL} if creation fails. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Minimal session +#' create_session(vol_id = 1, name = "Pilot 01") +#' +#' # Session with a flat date +#' create_session( +#' vol_id = 1, +#' name = "Pilot 02", +#' source_date = as.Date("2024-03-15") +#' ) +#' +#' # Session with a structured date and default records +#' create_session( +#' vol_id = 1, +#' name = "Pilot 03", +#' date = list(year = 2024, month = 3, day = 15, is_estimated = FALSE), +#' date_precision = "FULL", +#' default_records = c(101, 102) +#' ) +#' } +#' } +#' @export +create_session <- function( + vol_id = 1, + name, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + default_records = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + + assertthat::assert_that(is.character(name), length(name) == 1) + assertthat::assert_that(nzchar(trimws(name)), msg = "name must not be empty") + + if (!is.null(release_level)) { + assertthat::assert_that( + is.character(release_level), + length(release_level) == 1, + nzchar(trimws(release_level)) + ) + } + + assertthat::assert_that( + is.null(source_date) || is.null(date), + msg = "Provide either source_date or date, not both." + ) + + if (!is.null(date)) { + assertthat::assert_that( + is.list(date), + !is.null(names(date)), + msg = "date must be a named list (e.g. list(year=, month=, day=))" + ) + } + + if (!is.null(date_precision)) { + assertthat::assert_that( + is.character(date_precision), + length(date_precision) == 1, + nzchar(trimws(date_precision)) + ) + } + + if (!is.null(default_records)) { + assertthat::assert_that( + is.numeric(default_records), + length(default_records) >= 1, + all(default_records >= 1), + all(default_records == floor(default_records)), + msg = "default_records must be a vector of positive integers" + ) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list(name = name) + + if (!is.null(release_level)) { + body$release_level <- release_level + } + if (!is.null(source_date)) { + body$source_date <- coerce_iso_date(source_date, "source_date") + } + if (!is.null(date)) { + body$date <- date + } + if (!is.null(date_precision)) { + body$date_precision <- date_precision + } + if (!is.null(default_records)) { + body$default_records <- as.list(as.integer(default_records)) + } + + session <- perform_api_post( + path = sprintf(API_VOLUME_SESSIONS, vol_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(session)) { + if (vb) { + message("Failed to create session in volume ", vol_id) + } + return(NULL) + } + + session +} diff --git a/R/create_volume_record.R b/R/create_volume_record.R new file mode 100644 index 00000000..029cab60 --- /dev/null +++ b/R/create_volume_record.R @@ -0,0 +1,222 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Resolve the name/ID metric for a category in a volume +#' +#' @description Fetches the volume's enabled categories and metrics, then +#' finds the priority metric for the given category (name, id, or description). +#' Mirrors the frontend's \code{getPriorityMetric} logic. +#' +#' @param vol_id Target volume number. +#' @param category_id Category identifier. +#' @param vb Logical; if \code{TRUE}, print verbose messages. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' @return The metric ID (integer) for the name field, or \code{NULL} if not found. +#' @noRd +get_name_metric_id <- function(vol_id, + category_id, + vb = options::opt("vb"), + rq = NULL) { + volume <- perform_api_get( + path = sprintf(API_VOLUME_DETAIL, vol_id), + rq = rq, + vb = vb + ) + if (is.null(volume)) { + return(NULL) + } + + enabled_categories <- volume$enabled_categories + enabled_metrics <- volume$enabled_metrics + + if (is.null(enabled_categories) || is.null(enabled_metrics)) { + return(NULL) + } + + # Find the category + category <- NULL + for (cat in enabled_categories) { + if (identical(as.integer(cat$id), as.integer(category_id))) { + category <- cat + break + } + } + if (is.null(category)) { + return(NULL) + } + + category_metrics <- category$metrics + if (is.null(category_metrics) || length(category_metrics) == 0) { + return(NULL) + } + + # Get enabled metric IDs for this volume + enabled_metric_ids <- vapply( + enabled_metrics, + function(m) as.integer(m$id), + integer(1) + ) + + # Filter category metrics to those enabled for the volume + category_metric_ids <- vapply( + category_metrics, + function(m) as.integer(m$id), + integer(1) + ) + available_metrics <- category_metrics[ + category_metric_ids %in% enabled_metric_ids + ] + if (length(available_metrics) == 0) { + return(NULL) + } + + # Priority: required first, then name, id, description (same as frontend) + priority_names <- c("name", "id", "description") + + for (metric in available_metrics) { + if (isTRUE(metric$required)) { + return(as.integer(metric$id)) + } + } + for (pname in priority_names) { + for (metric in available_metrics) { + if (tolower(metric$name) == pname) { + return(as.integer(metric$id)) + } + } + } + + # Fallback: first available metric + as.integer(available_metrics[[1]]$id) +} + +#' Create Record in Databrary Volume +#' +#' @description Create a new record in a Databrary volume. Records contain +#' metadata organized by category (e.g., participant, condition, task) with +#' measures (field values) stored per metric. The \code{name} is required and +#' resolved to the category's name/ID metric automatically. Use \code{measures} +#' to add additional metric values. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param category_id Numeric category identifier for the record type +#' (e.g., participant, condition, task). +#' @param name Display name for the record (e.g., "P001", "Control group"). +#' Required; resolves to the category's name metric from volume configuration. +#' @param measures Optional named list mapping additional metric IDs (as strings) +#' to values. Values can be strings (for text metrics), numbers (for numeric +#' metrics), or lists with \code{year}, \code{month}, \code{day}, +#' optional \code{month} and \code{day} fields (for date metrics). +#' @param participant Optional list for participant records containing +#' \code{birthday} (with \code{year}, \code{month}, \code{day} fields) or +#' \code{age} (with \code{years}, \code{months}, \code{days} fields). Cannot +#' provide both \code{birthday} and \code{age}. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return Same shape as \code{\link{get_volume_record_by_id}}, or \code{NULL} +#' if creation fails. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Create a task record with name only +#' create_volume_record( +#' vol_id = 1, +#' category_id = 6, +#' name = "Control group" +#' ) +#' +#' # Create a record with name and additional measures +#' create_volume_record( +#' vol_id = 1, +#' category_id = 6, +#' name = "Task A", +#' measures = list("30" = "Extra value") +#' ) +#' +#' # Create a participant record with name and birthday +#' create_volume_record( +#' vol_id = 1, +#' category_id = 1, +#' name = "P001", +#' participant = list( +#' birthday = list(year = 2020, month = 3, day = 15) +#' ) +#' ) +#' } +#' } +#' @export +create_volume_record <- function( + vol_id = 1, + category_id, + name, + measures = list(), + participant = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(category_id, "category_id") + + assertthat::assert_that(is.character(name)) + assertthat::assert_that(length(name) == 1) + assertthat::assert_that(nzchar(trimws(name)), msg = "name must not be empty") + + assertthat::assert_that(is.list(measures)) + + if (!is.null(participant)) { + assertthat::assert_that(is.list(participant)) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Resolve name metric and build measures with name + name_metric_id <- get_name_metric_id( + vol_id = vol_id, + category_id = category_id, + vb = vb, + rq = rq + ) + + if (is.null(name_metric_id)) { + if (vb) { + message( + "Could not find name/ID metric for category ", category_id, + " in volume ", vol_id + ) + } + return(NULL) + } + + measures_with_name <- measures + measures_with_name[[as.character(name_metric_id)]] <- name + + # Build request body + body <- list(category_id = category_id, measures = measures_with_name) + + if (!is.null(participant)) { + body$participant <- participant + } + + # Perform API call + record <- perform_api_post( + path = sprintf(API_VOLUME_RECORDS, vol_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(record)) { + if (vb) { + message("Failed to create record in volume ", vol_id) + } + return(NULL) + } + + record_as_client_list(record) +} diff --git a/R/delete_folder.R b/R/delete_folder.R new file mode 100644 index 00000000..5b14a571 --- /dev/null +++ b/R/delete_folder.R @@ -0,0 +1,57 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Delete Folder from Databrary Volume +#' +#' @description Delete (soft-delete) a folder from a Databrary volume. The +#' folder and its associated metadata are marked as deleted but not +#' permanently removed from the database. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param folder_id Numeric folder identifier. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} if the folder was successfully deleted, \code{FALSE} +#' otherwise. +#' +#' @seealso \code{\link{create_folder}}, \code{\link{update_folder}}, +#' \code{\link{patch_folder}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' delete_folder(vol_id = 1, folder_id = 42) +#' } +#' } +#' @export +delete_folder <- function( + vol_id = 1, + folder_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(folder_id, "folder_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + success <- perform_api_delete( + path = sprintf(API_FOLDER_DETAIL, vol_id, folder_id), + rq = rq, + vb = vb + ) + + if (!success) { + if (vb) { + message( + "Failed to delete folder ", folder_id, " from volume ", vol_id + ) + } + } + + success +} diff --git a/R/delete_record_measure.R b/R/delete_record_measure.R new file mode 100644 index 00000000..9dd99c1f --- /dev/null +++ b/R/delete_record_measure.R @@ -0,0 +1,75 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Delete Measure from a Record +#' +#' @description Delete a single measure from a record. Note that the backend +#' will reject attempts to delete measures for required metrics. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer. +#' @param metric_id Numeric metric identifier. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} if the measure was successfully deleted, \code{FALSE} +#' otherwise. Deletion will fail for required metrics. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Delete a measure +#' delete_record_measure( +#' vol_id = 1, +#' record_id = 123, +#' metric_id = 5 +#' ) +#' +#' # Delete with verbose output +#' delete_record_measure( +#' vol_id = 1, +#' record_id = 123, +#' metric_id = 5, +#' vb = TRUE +#' ) +#' } +#' } +#' @export +delete_record_measure <- function( + vol_id = 1, + record_id, + metric_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(record_id, "record_id") + assert_positive_integer(metric_id, "metric_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Perform API call + success <- perform_api_delete( + path = sprintf(API_RECORD_MEASURES, vol_id, record_id, metric_id), + rq = rq, + vb = vb + ) + + if (!success) { + if (vb) { + message( + "Failed to delete measure for metric ", + metric_id, + " on record ", + record_id, + " in volume ", + vol_id + ) + } + } + + success +} diff --git a/R/delete_session.R b/R/delete_session.R new file mode 100644 index 00000000..5c41bf5e --- /dev/null +++ b/R/delete_session.R @@ -0,0 +1,61 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Delete Session from Databrary Volume +#' +#' @description Delete (soft-delete) a session from a Databrary volume. The +#' session and its associated metadata are marked as deleted but not +#' permanently removed from the database. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} if the session was successfully deleted, \code{FALSE} +#' otherwise. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Delete a session +#' delete_session(vol_id = 1, session_id = 42) +#' +#' # Delete with verbose output +#' delete_session(vol_id = 1, session_id = 42, vb = TRUE) +#' } +#' } +#' @export +delete_session <- function( + vol_id = 1, + session_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + success <- perform_api_delete( + path = sprintf(API_SESSION_DETAIL, vol_id, session_id), + rq = rq, + vb = vb + ) + + if (!success) { + if (vb) { + message( + "Failed to delete session ", + session_id, + " from volume ", + vol_id + ) + } + } + + success +} diff --git a/R/delete_session_file.R b/R/delete_session_file.R new file mode 100644 index 00000000..d4330c69 --- /dev/null +++ b/R/delete_session_file.R @@ -0,0 +1,62 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Delete a Session File from a Databrary Volume +#' +#' @description Delete (soft-delete) a file from a Databrary session. The file +#' is marked as deleted on the server but not permanently removed. A second +#' delete on the same file returns \code{FALSE}, not an error. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param file_id Numeric file identifier. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} if the file was successfully deleted, \code{FALSE} +#' otherwise. +#' +#' @seealso \code{\link{update_session_file}}, \code{\link{patch_session_file}}, +#' \code{\link{get_session_file}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' delete_session_file(vol_id = 1, session_id = 42, file_id = 99) +#' } +#' } +#' @export +delete_session_file <- function( + vol_id = 1, + session_id, + file_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer(file_id, "file_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + success <- perform_api_delete( + path = sprintf(API_SESSION_FILE_DETAIL, vol_id, session_id, file_id), + rq = rq, + vb = vb + ) + + if (!success) { + if (vb) { + message( + "Failed to delete file ", file_id, + " from session ", session_id, + " in volume ", vol_id + ) + } + } + + success +} diff --git a/R/delete_volume_record.R b/R/delete_volume_record.R new file mode 100644 index 00000000..7f9e7f0f --- /dev/null +++ b/R/delete_volume_record.R @@ -0,0 +1,62 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Delete Record from Databrary Volume +#' +#' @description Delete (soft-delete) a record from a Databrary volume. The +#' record and its measures are marked as deleted but not permanently removed +#' from the database. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} if the record was successfully deleted, \code{FALSE} +#' otherwise. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Delete a record +#' delete_volume_record(vol_id = 1, record_id = 123) +#' +#' # Delete with verbose output +#' delete_volume_record(vol_id = 1, record_id = 123, vb = TRUE) +#' } +#' } +#' @export +delete_volume_record <- function( + vol_id = 1, + record_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(record_id, "record_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Perform API call + success <- perform_api_delete( + path = sprintf(API_VOLUME_RECORD_DETAIL, vol_id, record_id), + rq = rq, + vb = vb + ) + + if (!success) { + if (vb) { + message( + "Failed to delete record ", + record_id, + " from volume ", + vol_id + ) + } + } + + success +} diff --git a/R/disable_volume_category.R b/R/disable_volume_category.R new file mode 100644 index 00000000..110caaa4 --- /dev/null +++ b/R/disable_volume_category.R @@ -0,0 +1,58 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Disable a Category for a Volume +#' +#' @description Remove a single category from a volume's enabled set. +#' Other enabled categories are preserved. No-op if the category is not +#' currently enabled. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param category_id Numeric category identifier to disable. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} on success (or if not currently enabled), \code{NULL} +#' on failure. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' disable_volume_category(vol_id = 1, category_id = 1) +#' } +#' } +#' @export +disable_volume_category <- function( + vol_id = 1, + category_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(category_id, "category_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + current <- get_volume_enabled_categories(vol_id = vol_id, vb = vb, rq = rq) + if (is.null(current)) { + current <- list() + } + + current_ids <- vapply(current, function(c) as.integer(c$id), integer(1)) + target <- as.integer(category_id) + if (!(target %in% current_ids)) { + if (vb) message("Category ", category_id, " is not enabled for volume ", vol_id) + return(TRUE) + } + + updated_ids <- current_ids[current_ids != target] + set_volume_enabled_categories( + vol_id = vol_id, + category_ids = updated_ids, + vb = vb, + rq = rq + ) +} diff --git a/R/download_folder_asset.R b/R/download_folder_asset.R new file mode 100644 index 00000000..c7de9f90 --- /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::assert_that(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..e5083386 --- /dev/null +++ b/R/download_folder_assets_fr_df.R @@ -0,0 +1,122 @@ +#' @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. Defaults to the result +#' of `list_folder_assets(vol_id = 1)`. Explicit `NULL` triggers the same +#' call using the current `vb` and `rq`. +#' @param target_dir Character string. Base directory for downloads. Defaults to +#' `tempdir()`. +#' @param add_folder_subdir Logical. When `TRUE`, creates a subdirectory per +#' 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(length(target_dir) == 1) + assertthat::assert_that(is.character(target_dir)) + + assertthat::assert_that(length(add_folder_subdir) == 1) + assertthat::assert_that(is.logical(add_folder_subdir)) + + assertthat::assert_that(length(overwrite) == 1) + assertthat::assert_that(is.logical(overwrite)) + + assertthat::assert_that(length(make_portable_fn) == 1) + assertthat::assert_that(is.logical(make_portable_fn)) + + assertthat::assert_that(assertthat::is.number(timeout_secs)) + assertthat::assert_that(length(timeout_secs) == 1) + assertthat::assert_that(timeout_secs > 0) + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + assertthat::assert_that(is.null(rq) || + ("httr2_request" %in% class(rq))) + + if (is.null(folder_df)) { + folder_df <- list_folder_assets(vol_id = 1, vb = vb, rq = rq) + } + + 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 + ) + } + + 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) + + if (vb) { + message("Downloading n=", nrow(folder_df), " files to ", target_dir) + } + + purrr::map( + seq_len(nrow(folder_df)), + download_folder_asset_from_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..f7d9ce4d --- /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..1fa83e33 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) - - assertthat::assert_that(is.character(target_dir)) + + if (!is.null(file_name)) { + assertthat::assert_that(length(file_name) == 1) + assertthat::assert_that(is.character(file_name)) + } + assertthat::assert_that(length(target_dir) == 1) + assertthat::assert_that(is.character(target_dir)) assertthat::assert_that(dir.exists(target_dir)) - - assertthat::is.number(timeout_secs) + + assertthat::assert_that(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) | + + 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() - } - - 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, - "." - ) - - 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)) + + path <- sprintf(API_FILES_DOWNLOAD_LINK, vol_id, session_id, asset_id) + link <- request_signed_download_link(path = path, rq = rq, vb = vb) + + if (is.null(link)) { return(NULL) } - - 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..00c3a141 100644 --- a/R/download_session_assets_fr_df.R +++ b/R/download_session_assets_fr_df.R @@ -3,43 +3,46 @@ #' 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. Defaults to the result +#' of `list_session_assets(session_id = 9224, vol_id = 1)`. Explicit `NULL` +#' triggers the same call using the current `vb` and `rq`. +#' @param target_dir Character string. Base directory for downloads. Defaults to +#' `tempdir()`. +#' @param add_session_subdir Logical. When `TRUE`, creates a subdirectory per +#' 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,61 +50,68 @@ 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)) - 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) - message("`overwrite` is FALSE. Cannot continue.") - return(NULL) - } - } - assertthat::is.writeable(target_dir) - + assertthat::assert_that(length(add_session_subdir) == 1) assertthat::assert_that(is.logical(add_session_subdir)) - + assertthat::assert_that(length(overwrite) == 1) assertthat::assert_that(is.logical(overwrite)) - + assertthat::assert_that(length(make_portable_fn) == 1) assertthat::assert_that(is.logical(make_portable_fn)) - - assertthat::is.number(timeout_secs) + + assertthat::assert_that(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) | + + 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 (is.null(session_df)) { + session_df <- list_session_assets(session_id = 9224, + vol_id = 1, + vb = vb, + rq = rq) + } + + assertthat::assert_that(is.data.frame(session_df)) + required_cols <- c("vol_id", "session_id", "asset_id", "asset_name") + missing_cols <- setdiff(required_cols, names(session_df)) + if (length(missing_cols) > 0) { + stop( + "session_df is missing required columns: ", + paste(missing_cols, collapse = ", "), + call. = FALSE + ) + } + + 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) + + if (vb) { + message("Downloading n=", nrow(session_df), " files to ", target_dir) + } + purrr::map( - 1:dim(session_df)[1], - download_single_session_asset_fr_df, - session_df, + seq_len(nrow(session_df)), + download_session_asset_from_df, + session_df = session_df, target_dir = target_dir, add_session_subdir = add_session_subdir, overwrite = overwrite, @@ -109,7 +119,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..c0ff2462 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..f6bb5179 100644 --- a/R/download_session_zip.R +++ b/R/download_session_zip.R @@ -3,125 +3,52 @@ #' 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) - + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) - - assertthat::assert_that(length(out_dir) == 1) - assertthat::assert_that(is.character(out_dir)) - - assertthat::assert_that(length(file_name) == 1) - assertthat::assert_that(is.character(file_name)) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | + + 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(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..e9a8bf49 --- /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_folder_asset_from_df <- function(i = NULL, + folder_df = NULL, + target_dir = tempdir(), + add_folder_subdir = TRUE, + overwrite = TRUE, + make_portable_fn = FALSE, + timeout_secs = REQUEST_TIMEOUT_VERY_LONG, + vb = options::opt("vb"), + rq = NULL) { + assertthat::assert_that(length(i) == 1) + assertthat::assert_that(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::assert_that(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::assert_that(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..b7ed5ac6 100644 --- a/R/download_single_session_asset_fr_df.R +++ b/R/download_single_session_asset_fr_df.R @@ -1,237 +1,150 @@ #' @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, - target_dir = tempdir(), - add_session_subdir = TRUE, - overwrite = TRUE, - make_portable_fn = FALSE, - timeout_secs = REQUEST_TIMEOUT_VERY_LONG, - vb = options::opt("vb"), - rq = NULL) { - # Check parameters +download_session_asset_from_df <- function(i = NULL, + session_df = NULL, + target_dir = tempdir(), + add_session_subdir = TRUE, + overwrite = TRUE, + make_portable_fn = FALSE, + timeout_secs = REQUEST_TIMEOUT_VERY_LONG, + vb = options::opt("vb"), + rq = NULL) { assertthat::assert_that(length(i) == 1) - assertthat::is.number(i) + assertthat::assert_that(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(assertthat::is.string(target_dir)) + assertthat::assert_that( + dir.exists(target_dir) || + dir.create(target_dir, recursive = TRUE, showWarnings = FALSE) + ) assertthat::is.writeable(target_dir) - - assertthat::assert_that(length(add_session_subdir) == 1) - assertthat::assert_that(is.logical(add_session_subdir)) - - assertthat::assert_that(length(overwrite) == 1) - assertthat::assert_that(is.logical(overwrite)) - + + validate_flag(add_session_subdir, "add_session_subdir") + validate_flag(overwrite, "overwrite") + + assertthat::assert_that(length(make_portable_fn) == 1) assertthat::assert_that(is.logical(make_portable_fn)) - - assertthat::is.number(timeout_secs) + + assertthat::assert_that(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) | + + validate_flag(vb, "vb") + + 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 } - - if (file.exists(full_fn)) { - if (vb) - message("File exists: ", full_fn) - if (!overwrite) { - if (vb) - message("Generating new unique (time-stamped) file name.") - full_fn <- file.path( - dirname(full_fn), - paste0( - this_asset$session_id, - "-", - this_asset$asset_id, - "-", - format(Sys.time(), "%F-%H%M-%S"), - paste0(".", this_asset$format_extension) - ) - ) - } else { - if (vb) - message("Will overwrite existing file.") + dir.create(dest_dir, recursive = TRUE, showWarnings = FALSE) + assertthat::assert_that(dir.exists(dest_dir)) + assertthat::is.writeable(dest_dir) + + base_name <- this_asset$asset_name + if (is.null(base_name) || is.na(base_name) || base_name == "") { + base_name <- paste0("asset-", this_asset$asset_id) + } + + extension <- "" + if ("format_extension" %in% names(this_asset)) { + ext_value <- this_asset$format_extension + if (!is.null(ext_value) && + !is.na(ext_value) && nzchar(ext_value)) { + if (tools::file_ext(base_name) != ext_value) { + extension <- paste0(".", ext_value) + } } } - + + candidate_name <- paste0(base_name, extension) + if (make_portable_fn) { - if (vb) - message("Making file name '", full_fn, "' portable.") - full_fn <- make_fn_portable(full_fn, vb = vb) - } - assertthat::is.string(full_fn) - - if (!dir.exists(dirname(full_fn))) { if (vb) { - message("Target directory not found: ", dirname(full_fn)) - message("Creating: ", dirname(full_fn)) - } - dir.create(dirname(full_fn), recursive = TRUE) - } else { - if (vb) - message("Target directory exists: ", dirname(full_fn)) - if (overwrite) { - if (vb) - message("Overwriting directory: ", dirname(full_fn)) - } else { - if (vb) - message("`overwrite` is FALSE. Skipping.") - return(NULL) + message("Making file name '", candidate_name, "' portable.") } + candidate_name <- make_fn_portable(candidate_name, vb = vb) } - assertthat::is.writeable(dirname(full_fn)) - - # Handle NULL rq - if (is.null(rq)) { + + dest_file <- file.path(dest_dir, candidate_name) + if (file.exists(dest_file) && !overwrite) { if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") + message("Generating new unique (time-stamped) file name.") } - rq <- databraryr::make_default_request() - } - - if (vb) - message( - "Downloading file with asset_id ", + candidate_name <- paste0( + this_asset$session_id, + "-", this_asset$asset_id, - " from session_id ", - this_asset$session_id + "-", + format(Sys.time(), "%F-%H%M-%S"), + ifelse( + nzchar(tools::file_ext(candidate_name)), + paste0(".", tools::file_ext(candidate_name)), + "" + ) ) - - # Up default timeout for possibly big files - rq <- - httr2::req_timeout(rq, seconds = timeout_secs) - - this_rq <- rq %>% - httr2::req_url(sprintf(DOWNLOAD_FILE, this_asset$session_id, this_asset$asset_id)) %>% - httr2::req_progress() - - resp <- tryCatch( - httr2::req_perform(this_rq), - httr2_error = function(cnd) - if (vb) - message( - "Error downloading asset ", - this_asset$asset_name, - " from session_id ", - this_asset$session_id - ), - NULL - ) - - if (is.null(resp)) { - message("Cannot access requested resource on Databrary. Exiting.") - return(resp) + dest_file <- file.path(dest_dir, candidate_name) } - - # if (is.null(resp)) { - # if (vb) - # message( - # "Download request for session ", - # this_asset$session_id, - # " asset ", - # this_asset$asset_id, - # " returned NULL. Skipping." - # ) - # return(NULL) - # } - - write_file <- tryCatch( - error = function(cnd) { - if (vb) - message("Failure writing file ", full_fn) - NULL - }, - { - file_con <- file(full_fn, "wb") - writeBin(resp$body, file_con) - close(file_con) - } + + download_session_asset( + vol_id = this_asset$vol_id, + session_id = this_asset$session_id, + asset_id = this_asset$asset_id, + file_name = candidate_name, + target_dir = dest_dir, + timeout_secs = timeout_secs, + vb = vb, + rq = rq ) - - if (!is.null(write_file)) { - full_fn - } else { - write_file - } } diff --git a/R/download_utils.R b/R/download_utils.R new file mode 100644 index 00000000..8e4decaa --- /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::assert_that(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..a5e63cb2 100644 --- a/R/download_video.R +++ b/R/download_video.R @@ -3,119 +3,81 @@ #' 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) - + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) - - assertthat::assert_that(length(file_name) == 1) - assertthat::assert_that(is.character(file_name)) - + + assertthat::assert_that(length(vol_id) == 1) + assertthat::assert_that(is.numeric(vol_id)) + assertthat::assert_that(vol_id >= 1) + + if (!is.null(file_name)) { + assertthat::assert_that(length(file_name) == 1) + assertthat::assert_that(is.character(file_name)) + if (!endsWith(tolower(file_name), ".mp4")) { + stop("file_name must end with '.mp4' when provided.", call. = FALSE) + } + } + assertthat::assert_that(length(target_dir) == 1) assertthat::assert_that(is.character(target_dir)) - assertthat::assert_that(dir.exists(target_dir)) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | + assertthat::assert_that( + dir.exists(target_dir) || + dir.create(target_dir, recursive = TRUE, showWarnings = FALSE) + ) + assertthat::is.writeable(target_dir) + + validate_flag(vb, "vb") + + assertthat::assert_that(is.null(rq) || ("httr2_request" %in% class(rq))) - - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - - this_rq <- rq %>% - httr2::req_url(sprintf(DOWNLOAD_FILE, session_id, asset_id)) %>% - httr2::req_progress() - - if (file.exists(file_name)) { - if (vb) - message("File exists. Generating new unique name.\n") - file_name <- file.path(tempdir(), - paste0( - session_id, - "-", - asset_id, - "-", - format(Sys.time(), "%F-%H%M-%S"), - ".mp4" - )) - } - - if (vb) - message("Attempting to download video with asset_id ", - asset_id, - " from session_id ", - session_id) - - resp <- tryCatch( - httr2::req_perform(this_rq), - httr2_error = function(cnd) { - if (vb) - message( - message( - "Error retrieving video with asset_id ", - asset_id, - " from session_id ", - session_id - ) - ) - NULL - } + + 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..ed6af949 100644 --- a/R/download_volume_zip.R +++ b/R/download_volume_zip.R @@ -1,114 +1,45 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL -#' Download Zip Archive of All Data in a Volume. +#' Request a Signed ZIP Download for a Volume. +#' +#' @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. #' -#' @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. +#' @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/enable_volume_category.R b/R/enable_volume_category.R new file mode 100644 index 00000000..aea91e60 --- /dev/null +++ b/R/enable_volume_category.R @@ -0,0 +1,57 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Enable a Category for a Volume +#' +#' @description Add a single category to a volume's enabled set. This is +#' additive -- existing enabled categories are preserved. No-op if the +#' category is already enabled. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param category_id Numeric category identifier to enable. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} on success (or if already enabled), \code{NULL} on +#' failure. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' enable_volume_category(vol_id = 1, category_id = 1) +#' } +#' } +#' @export +enable_volume_category <- function( + vol_id = 1, + category_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(category_id, "category_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + current <- get_volume_enabled_categories(vol_id = vol_id, vb = vb, rq = rq) + if (is.null(current)) { + current <- list() + } + + current_ids <- vapply(current, function(c) as.integer(c$id), integer(1)) + if (as.integer(category_id) %in% current_ids) { + if (vb) message("Category ", category_id, " is already enabled for volume ", vol_id) + return(TRUE) + } + + updated_ids <- c(current_ids, as.integer(category_id)) + set_volume_enabled_categories( + vol_id = vol_id, + category_ids = updated_ids, + vb = vb, + rq = rq + ) +} diff --git a/R/get_category_by_id.R b/R/get_category_by_id.R new file mode 100644 index 00000000..da0827fb --- /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..9827341f 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{ +#' \dontrun{ #' 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)) + ) + + stats <- perform_api_get( + path = API_ACTIVITY_SUMMARY, + rq = rq, + vb = vb ) - - if (is.null(resp)) { + + if (is.null(stats)) { message("Cannot access requested resource on Databrary. Exiting.") - return(resp) - } - - 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() - } + return(NULL) } -} -#------------------------------------------------------------------------------ -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 { + NA_integer_ + }, + total_volumes = if (!is.null(stats$total_volumes)) { + stats$total_volumes } else { - return(NULL) + 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..8b18809f --- /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..99ef910d --- /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..03490cb1 --- /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..e719560c --- /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 default filename when content-disposition lacks filename + 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) + } + NULL + }) +} diff --git a/R/get_institution_by_id.R b/R/get_institution_by_id.R new file mode 100644 index 00000000..9c7a9e7b --- /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")`. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' @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_institution_statistics.R b/R/get_institution_statistics.R new file mode 100644 index 00000000..a0af227d --- /dev/null +++ b/R/get_institution_statistics.R @@ -0,0 +1,73 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get statistics for an institution +#' +#' Retrieve aggregated statistics for an institution including volume count, +#' file count, and data footprints. Returns NULL (204 No Content) when +#' statistics have not been computed yet. +#' +#' @param institution_id Institution identifier. Must be a positive integer. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' @inheritParams options_params +#' +#' @return A list with institution statistics including: +#' - `institution_id`: The institution identifier +#' - `volumes_number`: Number of volumes +#' - `files_number`: Number of files +#' - `uploaded_data_footprint`: Size of uploaded data in bytes +#' - `transcoded_data_footprint`: Size of transcoded data in bytes +#' - `soft_deleted_uploaded_data_footprint`: Size of soft-deleted uploaded data +#' - `soft_deleted_transcoded_data_footprint`: Size of soft-deleted transcoded data +#' - `created_at`: Timestamp when statistics were created +#' - `updated_at`: Timestamp when statistics were last updated +#' Returns NULL when statistics have not been computed or institution is not found. +#' @export +get_institution_statistics <- function( + institution_id = 1, + vb = options::opt("vb"), + rq = NULL +) { + assertthat::assert_that( + is.numeric(institution_id), + length(institution_id) == 1, + institution_id > 0 + ) + + validate_flag(vb, "vb") + + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + stats <- perform_api_get( + path = sprintf(API_INSTITUTION_STATISTICS, institution_id), + rq = rq, + vb = vb + ) + + if (is.null(stats)) { + if (vb) { + message( + "Institution statistics for ", + institution_id, + " not found or not yet computed." + ) + } + return(NULL) + } + + tibble::tibble( + institution_id = stats$institution_id, + volumes_number = stats$volumes_number, + files_number = stats$files_number, + uploaded_data_footprint = stats$uploaded_data_footprint, + transcoded_data_footprint = stats$transcoded_data_footprint, + soft_deleted_uploaded_data_footprint = stats$soft_deleted_uploaded_data_footprint, + soft_deleted_transcoded_data_footprint = stats$soft_deleted_transcoded_data_footprint, + created_at = stats$created_at, + updated_at = stats$updated_at + ) |> + as.list() +} diff --git a/R/get_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..5a5ac236 100644 --- a/R/get_session_by_id.R +++ b/R/get_session_by_id.R @@ -1,13 +1,14 @@ #' @eval options::as_params() #' @name options_params -#' +#' 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.") - } - 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) + message("Cannot access requested session ", session_id, " in volume ", vol_id) } - - 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..8d039029 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) - - 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() - } - - #-------------------------------------------------------------------------- - extract_session_metadata <- function(volume_json) { - assertthat::assert_that(is.list(volume_json)) - - extract_single_session <- function(i, sessions) { - this_session <- sessions$value[[i]] - tibble::tibble(id = this_session$id, - top = this_session$top, - name = this_session$name) - } - - these_sessions <- tibble::enframe(volume_json$containers) - n_sessions <- dim(these_sessions)[1] - purrr::map(1:n_sessions, extract_single_session, these_sessions) %>% - purrr::list_rbind() - } - #-------------------------------------------------------------------------- - - volume_json <- NULL - volume_json <- get_volume_by_id(vol_id, vb, rq) - session_metadata <- extract_session_metadata(volume_json) - - name <- NULL - name_matches <- dplyr::filter(session_metadata, name == session_name) - - if (is.null(name_matches)) { - message("No matches") - return(NULL) - } - if (dim(name_matches)[1] == 0) { - message("Empty array") + + validate_flag(vb, "vb") + + assertthat::assert_that(is.null(rq) || + inherits(rq, "httr2_request")) + + sessions <- collect_paginated_get( + path = sprintf(API_VOLUME_SESSIONS, vol_id), + params = list(search = session_name), + rq = rq, + vb = vb + ) + + if (is.null(sessions) || length(sessions) == 0) { + if (vb) + message("No sessions named '", session_name, "' in volume ", vol_id) return(NULL) } - 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) - } \ No newline at end of file + + purrr::map(sessions, function(session) { + databraryr::get_session_by_id( + session_id = session$id, + vol_id = vol_id, + vb = vb, + rq = rq + ) + }) + } diff --git a/R/get_session_file.R b/R/get_session_file.R new file mode 100644 index 00000000..98798738 --- /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..356b13e7 --- /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_upload_status.R b/R/get_upload_status.R new file mode 100644 index 00000000..5c447aad --- /dev/null +++ b/R/get_upload_status.R @@ -0,0 +1,103 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get the Current Status of an Upload +#' +#' @description Poll the Databrary API for the lifecycle state of an upload +#' started with \code{\link{initiate_upload}}. The returned status reflects +#' both the storage-side transfer and the post-upload server pipeline +#' (e.g. virus scan, format probe). +#' +#' Accepts either the absolute \code{status_url} returned by +#' \code{initiate_upload()} (preferred -- avoids a second URL build) or +#' the upload's \code{upload_guid}. +#' +#' @param status_url Absolute URL returned by \code{initiate_upload()} under +#' \code{status_url}. Mutually exclusive with \code{upload_guid}. +#' @param upload_guid Character upload GUID. Mutually exclusive with +#' \code{status_url}. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A length-1 character string with the status (e.g. +#' \code{"scanning"}, \code{"completed"}, \code{"infected"}, +#' \code{"upload_failed"}, \code{"processing_failed"} on the AWS +#' deployment; raw \code{Upload.status} on the core deployment). Returns +#' \code{NULL} if the request fails. +#' +#' @inheritParams options_params +#' +#' @seealso \code{\link{initiate_upload}}, \code{\link{upload_file}} +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' init <- initiate_upload( +#' filename = "clip.mp4", +#' destination_type = "session", +#' object_id = 42 +#' ) +#' get_upload_status(status_url = init$status_url) +#' } +#' } +#' @export +get_upload_status <- function( + status_url = NULL, + upload_guid = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assertthat::assert_that( + xor(is.null(status_url), is.null(upload_guid)), + msg = "Provide exactly one of status_url or upload_guid" + ) + + if (!is.null(status_url)) { + assertthat::assert_that( + is.character(status_url), length(status_url) == 1, nzchar(status_url) + ) + path <- status_url + absolute <- grepl("^https?://", status_url) + } else { + assertthat::assert_that( + is.character(upload_guid), length(upload_guid) == 1, nzchar(upload_guid) + ) + path <- sprintf(API_UPLOADS_STATUS, upload_guid) + absolute <- FALSE + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # perform_api_get prepends DATABRARY_BASE_URL via ensure_leading_slash, so + # for absolute URLs we override the URL on the request after construction. + if (absolute) { + request <- rq + if (is.null(request)) { + request <- databraryr::make_default_request() + } + request <- httr2::req_url(request, path) + + response <- tryCatch( + httr2::req_perform(request), + httr2_error = function(cnd) { + if (vb) { + message("Status request failed for ", path, ": ", conditionMessage(cnd)) + } + NULL + } + ) + if (is.null(response)) { + return(NULL) + } + body <- httr2::resp_body_json(response) + } else { + body <- perform_api_get(path = path, rq = rq, vb = vb) + } + + if (is.null(body) || is.null(body$status)) { + return(NULL) + } + as.character(body$status) +} diff --git a/R/get_user_avatar.R b/R/get_user_avatar.R new file mode 100644 index 00000000..b61a60b5 --- /dev/null +++ b/R/get_user_avatar.R @@ -0,0 +1,180 @@ +#' @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)) + } + 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 (server may return 200 with an empty body) + avatar_bytes <- tryCatch( + httr2::resp_body_raw(resp), + error = function(e) { + if (vb) { + message( + "User avatar unavailable or empty response: ", + conditionMessage(e) + ) + } + NULL + } + ) + + if (is.null(avatar_bytes) || length(avatar_bytes) == 0L) { + if (vb) { + message("No avatar bytes returned for user ", user_id) + } + return(NULL) + } + + # If no destination path, return bytes + if (is.null(dest_path)) { + 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 default filename when content-disposition lacks filename + 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)) + } + NULL + }) +} diff --git a/R/get_user_by_id.R b/R/get_user_by_id.R new file mode 100644 index 00000000..11d972a1 --- /dev/null +++ b/R/get_user_by_id.R @@ -0,0 +1,52 @@ +#' @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")`. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' @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_user_statistics.R b/R/get_user_statistics.R new file mode 100644 index 00000000..9e2ed579 --- /dev/null +++ b/R/get_user_statistics.R @@ -0,0 +1,69 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get statistics for a user +#' +#' Retrieve aggregated statistics for a user including volume count, +#' file count, and data footprints. Returns NULL (204 No Content) when +#' statistics have not been computed yet. +#' +#' @param user_id User identifier. Must be a positive integer. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' @inheritParams options_params +#' +#' @return A list with user statistics including: +#' - `user_id`: The user identifier +#' - `volumes_number`: Number of volumes +#' - `files_number`: Number of files +#' - `uploaded_data_footprint`: Size of uploaded data in bytes +#' - `transcoded_data_footprint`: Size of transcoded data in bytes +#' - `soft_deleted_uploaded_data_footprint`: Size of soft-deleted uploaded data +#' - `soft_deleted_transcoded_data_footprint`: Size of soft-deleted transcoded data +#' - `created_at`: Timestamp when statistics were created +#' - `updated_at`: Timestamp when statistics were last updated +#' Returns NULL when statistics have not been computed or user is not found. +#' @export +get_user_statistics <- function(user_id, vb = options::opt("vb"), rq = NULL) { + assertthat::assert_that( + is.numeric(user_id), + length(user_id) == 1, + user_id > 0 + ) + + validate_flag(vb, "vb") + + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + stats <- perform_api_get( + path = sprintf(API_USER_STATISTICS, user_id), + rq = rq, + vb = vb + ) + + if (is.null(stats)) { + if (vb) { + message( + "User statistics for ", + user_id, + " not found or not yet computed." + ) + } + return(NULL) + } + + tibble::tibble( + user_id = stats$user_id, + volumes_number = stats$volumes_number, + files_number = stats$files_number, + uploaded_data_footprint = stats$uploaded_data_footprint, + transcoded_data_footprint = stats$transcoded_data_footprint, + soft_deleted_uploaded_data_footprint = stats$soft_deleted_uploaded_data_footprint, + soft_deleted_transcoded_data_footprint = stats$soft_deleted_transcoded_data_footprint, + created_at = stats$created_at, + updated_at = stats$updated_at + ) |> + as.list() +} diff --git a/R/get_volume_by_id.R b/R/get_volume_by_id.R index b9a8167b..c8c8e34a 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()`. @@ -15,7 +16,7 @@ NULL #' @inheritParams options_params #' #' @examples -#' \donttest{ +#' \dontrun{ #' get_volume_by_id() # Default is Volume 1 #' } #' @@ -26,35 +27,49 @@ get_volume_by_id <- function(vol_id = 1, assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) assertthat::assert_that(length(vol_id) == 1) - - 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) } -} \ No newline at end of file + + 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)) + ) +} diff --git a/R/get_volume_collaborator_by_id.R b/R/get_volume_collaborator_by_id.R new file mode 100644 index 00000000..f3f6f3be --- /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_enabled_categories.R b/R/get_volume_enabled_categories.R new file mode 100644 index 00000000..94d60bf0 --- /dev/null +++ b/R/get_volume_enabled_categories.R @@ -0,0 +1,48 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Get Enabled Categories for a Volume +#' +#' @description Retrieve the list of categories currently enabled for a +#' Databrary volume. Returns the \code{enabled_categories} field from the +#' volume detail endpoint. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list of category objects (each with \code{id}, \code{name}, +#' \code{metrics}, etc.), or \code{NULL} if the volume is not found. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' get_volume_enabled_categories(vol_id = 1) +#' } +#' } +#' @export +get_volume_enabled_categories <- function( + vol_id = 1, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + volume <- perform_api_get( + path = sprintf(API_VOLUME_DETAIL, vol_id), + rq = rq, + vb = vb + ) + + if (is.null(volume)) { + if (vb) message("Volume ", vol_id, " not found or inaccessible.") + return(NULL) + } + + volume$enabled_categories +} diff --git a/R/get_volume_record_by_id.R b/R/get_volume_record_by_id.R new file mode 100644 index 00000000..0abc88b8 --- /dev/null +++ b/R/get_volume_record_by_id.R @@ -0,0 +1,84 @@ +#' @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 aligned with the API record payload: `record_id`, `record_volume`, +#' `record_volume_name`, `record_category_id`, `measures`, `birthday`, `age`, +#' `default_sessions` (session ids/names where this record is a default), +#' `record_source_kind` (linked-content provenance, e.g. `native`, +#' `source_linked_file`). `record_volume` may differ from `vol_id` for linked +#' records. Returns `NULL` if the record is not found or inaccessible. +#' +#' @inheritParams options_params +#' +#' @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) + } + + record_as_client_list(record) +} diff --git a/R/initiate_upload.R b/R/initiate_upload.R new file mode 100644 index 00000000..83bd7068 --- /dev/null +++ b/R/initiate_upload.R @@ -0,0 +1,152 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Initiate a File Upload +#' +#' @description Ask the Databrary API to register a pending upload and return +#' the signed URL(s) needed to PUT file bytes directly to object storage. The +#' server decides whether to issue a single-PUT or a multipart upload based on +#' \code{file_size} and the deployment's storage backend (S3 multipart on the +#' AI/AWS deployment, single PUT on the on-prem core deployment). +#' +#' This is the first step of the upload pipeline; pass the returned object to +#' \code{\link{upload_file}} (high level) or use the returned URLs directly +#' with \code{httr2::req_perform()} for fine-grained control. +#' +#' @param filename Display filename. Required, non-empty. +#' @param destination_type Where the upload will live. One of +#' \code{"session"}, \code{"folder"}, \code{"linked_volume_session"}, +#' \code{"linked_volume_folder"} (server validates). Required. +#' @param object_id Positive integer ID of the destination object (session +#' or folder, depending on \code{destination_type}). Required. +#' @param file_size File size in bytes. Optional but strongly recommended: +#' the AWS deployment uses this to decide multipart vs single PUT. +#' @param content_type MIME type of the file (e.g. \code{"video/mp4"}). +#' Optional but recommended; some storage backends require it. +#' @param source_session_id Required when +#' \code{destination_type == "linked_volume_session"}; positive integer. +#' @param source_folder_id Required when +#' \code{destination_type == "linked_volume_folder"}; positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A named list describing the upload. Always contains +#' \code{status_url}. For a single PUT (the on-prem core deployment, or +#' any AWS upload smaller than the multipart threshold), contains +#' \code{signed_upload_url} and \code{required_headers} (may be empty). +#' For a multipart upload, contains \code{upload_type = "multipart"}, +#' \code{upload_guid}, \code{s3_upload_id}, \code{part_urls} (a list of +#' \code{list(part_number, url)}), and \code{part_size}. Returns +#' \code{NULL} if the request fails. +#' +#' @inheritParams options_params +#' +#' @seealso \code{\link{upload_file}}, \code{\link{get_upload_status}}, +#' \code{\link{complete_upload}} +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Initiate a small upload to a session +#' init <- initiate_upload( +#' filename = "clip_001.mp4", +#' destination_type = "session", +#' object_id = 42, +#' file_size = 1024L * 1024L, +#' content_type = "video/mp4" +#' ) +#' } +#' } +#' @export +initiate_upload <- function( + filename, + destination_type, + object_id, + file_size = NULL, + content_type = NULL, + source_session_id = NULL, + source_folder_id = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assertthat::assert_that( + is.character(filename), length(filename) == 1, nzchar(trimws(filename)), + msg = "filename must be a non-empty string" + ) + assertthat::assert_that( + is.character(destination_type), length(destination_type) == 1, + nzchar(trimws(destination_type)), + msg = "destination_type must be a non-empty string" + ) + assert_positive_integer(object_id, "object_id") + + if (!is.null(file_size)) { + assert_positive_integer(file_size, "file_size") + } + if (!is.null(content_type)) { + assertthat::assert_that( + is.character(content_type), length(content_type) == 1, + nzchar(trimws(content_type)) + ) + } + if (!is.null(source_session_id)) { + assert_positive_integer(source_session_id, "source_session_id") + } + if (!is.null(source_folder_id)) { + assert_positive_integer(source_folder_id, "source_folder_id") + } + + # Server enforces the linked-volume requirements, but fail fast client-side + # so users get a useful message before the round-trip. + if (identical(destination_type, "linked_volume_session")) { + assertthat::assert_that( + !is.null(source_session_id), + msg = "source_session_id required when destination_type == 'linked_volume_session'" + ) + } + if (identical(destination_type, "linked_volume_folder")) { + assertthat::assert_that( + !is.null(source_folder_id), + msg = "source_folder_id required when destination_type == 'linked_volume_folder'" + ) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list( + filename = filename, + destination_type = destination_type, + object_id = as.integer(object_id) + ) + if (!is.null(file_size)) body$file_size <- as.integer(file_size) + if (!is.null(content_type)) body$content_type <- content_type + if (!is.null(source_session_id)) { + body$source_session_id <- as.integer(source_session_id) + } + if (!is.null(source_folder_id)) { + body$source_folder_id <- as.integer(source_folder_id) + } + + result <- perform_api_post( + path = API_UPLOADS_INITIATE, + body = body, + rq = rq, + vb = vb + ) + + if (is.null(result) || isTRUE(result)) { + if (vb) { + message("Failed to initiate upload for filename ", filename) + } + return(NULL) + } + + # The on-prem core deployment omits `upload_type`; default it so callers + # can branch on a single field without checking presence. + if (is.null(result$upload_type)) { + result$upload_type <- "single" + } + result +} diff --git a/R/list_asset_formats.R b/R/list_asset_formats.R index 5720a8be..97d14290 100644 --- a/R/list_asset_formats.R +++ b/R/list_asset_formats.R @@ -1,33 +1,36 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL #' List Stored Assets (Files) By Type. -#' +#' +#' @description List the data (file) formats supported by Databrary. +#' +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' #' @returns A data frame with information about the data formats Databrary #' supports. -#' +#' #' @inheritParams options_params -#' +#' #' @examples -#' \donttest{ +#' \dontrun{ #' list_asset_formats() #' } #' @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() - + id <- NULL mimetype <- NULL extension <- NULL name <- NULL transcodable <- NULL - + if (!is.null(db_constants$format)) { purrr::map(db_constants$format, as.data.frame) %>% purrr::list_rbind() %>% diff --git a/R/list_authorized_investigators.R b/R/list_authorized_investigators.R index 43b1a73d..c81ea92e 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) - return(NULL) - } - - if (!("institution" %in% names(this_party))) { - if (vb) - message("Party ", party_id, " not an institution.") + assertthat::assert_that(is.numeric(institution_id), + length(institution_id) == 1, + institution_id > 0) + 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 (dim(as.data.frame(this_party$children))[1] == 0) { - if (vb) - message("Party ", party_id, " has no affiliates.") + + investigators <- affiliates |> dplyr::filter(.data$role == "investigator") + if (nrow(investigators) == 0) { return(NULL) } - - purrr::map(this_party$children, as.data.frame, .progress = TRUE) %>% - purrr::list_rbind() -} \ No newline at end of file + investigators +} diff --git a/R/list_categories.R b/R/list_categories.R new file mode 100644 index 00000000..481bd1c4 --- /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..6b1ee8f0 --- /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 = null_to_na_double(file[["duration"]]), + asset_created_at = file$created_at, + asset_updated_at = file$updated_at, + asset_uploader_id = uploader$id, + asset_uploader_first_name = uploader$first_name, + asset_uploader_last_name = uploader$last_name, + asset_sha1 = file$sha1, + asset_thumbnail_url = null_to_na_character(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..63d7c1c9 --- /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..1ab9923c --- /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 deleted file mode 100644 index abdf35a7..00000000 --- a/R/list_session_activity.R +++ /dev/null @@ -1,71 +0,0 @@ -#' @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. -#' -#' @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 -#' -#' @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) -#' } -#' } -#' @export -list_session_activity <- - function(session_id = 6256, - vb = options::opt("vb"), - rq = NULL) { - # Check parameters - assertthat::assert_that(length(session_id) == 1) - assertthat::assert_that(is.numeric(session_id)) - assertthat::assert_that(session_id > 0) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - rq <- rq %>% - httr2::req_url(sprintf(GET_SESSION_ACTIVITY, session_id)) - - if (vb) message("Retrieving activity for session id, ", session_id, ".") - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) { - NULL - } - ) - - 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_session_assets.R b/R/list_session_assets.R index c7e0a0e0..f6e341f1 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) } -} \ No newline at end of file + + 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 = null_to_na_double(file[["duration"]]), + asset_created_at = file$created_at, + asset_updated_at = file$updated_at, + asset_uploader_id = uploader$id, + asset_uploader_first_name = uploader$first_name, + asset_uploader_last_name = uploader$last_name, + asset_sha1 = file$sha1, + asset_thumbnail_url = null_to_na_character(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 + ) +} 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..1b41dc7a --- /dev/null +++ b/R/list_user_affiliates.R @@ -0,0 +1,46 @@ +#' @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..d1c9d3c2 --- /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..1af17b40 --- /dev/null +++ b/R/list_user_sponsors.R @@ -0,0 +1,57 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' List sponsorships for a user +#' +#' @param user_id User identifier. +#' @param rq An `httr2` request object. Defaults to `NULL`. +#' @inheritParams options_params +#' +#' @returns Tibble of sponsors for the user. +#' @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..ae6a1a56 --- /dev/null +++ b/R/list_user_volumes.R @@ -0,0 +1,58 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +utils::globalVariables("vol_id") + +#' 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..bee53fb2 --- /dev/null +++ b/R/list_users.R @@ -0,0 +1,107 @@ +#' @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", optional = TRUE) + validate_flag(exclude_self, "exclude_self", optional = TRUE) + validate_flag(is_authorized_investigator, "is_authorized_investigator", optional = TRUE) + validate_flag(has_api_access, "has_api_access", optional = TRUE) + + assertthat::assert_that(length(vb) == 1) + assertthat::assert_that(is.logical(vb)) + + 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..c813e5cb 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,54 +19,91 @@ 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 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)) + + validate_flag(vb, "vb") + + validate_flag(vb, "vb") if (vb) - message('list_volume_activity()...') - + 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..8eec11fe 100644 --- a/R/list_volume_assets.R +++ b/R/list_volume_assets.R @@ -5,10 +5,13 @@ 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. +#' @returns A tibble with one row per asset. Columns `asset_duration` and +#' `asset_thumbnail_url` are always present (as `NA` when the API omits them). +#' Other fields come from the volume sessions/files payload. #' #' @inheritParams options_params #' @@ -26,112 +29,66 @@ list_volume_assets <- function(vol_id = 1, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(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))) { + + validate_flag(vb, "vb") + + 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 - ) %>% + + 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 = null_to_na_double(file[["duration"]]), + asset_created_at = file$created_at, + asset_updated_at = file$updated_at, + asset_uploader_id = uploader$id, + asset_uploader_first_name = uploader$first_name, + asset_uploader_last_name = uploader$last_name, + asset_sha1 = file$sha1, + asset_thumbnail_url = null_to_na_character(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 (dim(this_volume_assets_df)[1] == 0) { + + 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..2521c149 --- /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..9a8c1bf9 --- /dev/null +++ b/R/list_volume_folders.R @@ -0,0 +1,73 @@ +#' @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 + } + + fc <- folder[["file_counts"]] + + tibble::tibble( + folder_id = folder$id, + folder_name = folder$name, + folder_release = folder$release_level, + folder_native_accessible = file_count_value(fc, "native_accessible"), + folder_native_inaccessible = file_count_value(fc, "native_inaccessible"), + folder_linked_accessible = file_count_value(fc, "linked_accessible"), + folder_linked_inaccessible = file_count_value(fc, "linked_inaccessible"), + folder_has_full_access = folder$has_full_access, + folder_contains_different_release_levels = folder$contains_different_release_levels, + folder_created_at = folder$created_at, + 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..b251525a 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. @@ -31,90 +32,47 @@ list_volume_funding <- function(vol_id = 1, # Check parameters assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(sum(vol_id >= 1) == length(vol_id)) - + assertthat::assert_that(length(add_id) == 1) assertthat::assert_that(is.logical(add_id)) - - 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() -} + out <- purrr::map(vol_id, function(id) { + fundings <- perform_api_get( + path = sprintf(API_VOLUME_FUNDINGS, id), + rq = rq, + vb = vb + ) -#------------------------------------------------------------------------------- -# 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() + if (is.null(fundings) || length(fundings) == 0) { + return(NULL) } - rq <- rq %>% - httr2::req_url(sprintf(GET_VOLUME_FUNDING, 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 { - 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 - } + + 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() -#------------------------------------------------------------------------------- -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() + if (is.null(out) || nrow(out) == 0L) { + return(NULL) } - tibble::tibble( - funder_id = funder_id, - funder_name = funder_name, - funder_award = funder_award - ) + tibble::as_tibble(out) } diff --git a/R/list_volume_info.R b/R/list_volume_info.R index abf77794..ce40175a 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. #' @@ -20,7 +21,7 @@ NULL #' list_volume_info() # Sessions in Volume 1 #' } #' } -#' +#' #' @export list_volume_info <- function(vol_id = 1, @@ -30,92 +31,70 @@ list_volume_info <- assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - + + 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..6d61eb29 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. @@ -26,38 +27,26 @@ list_volume_links <- function(vol_id = 1, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - rq <- rq %>% - httr2::req_url(sprintf(GET_VOLUME_LINKS, vol_id)) - - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) { - NULL - } + + validate_flag(vb, "vb") + + 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..5c4e8995 --- /dev/null +++ b/R/list_volume_records.R @@ -0,0 +1,204 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' @noRd +empty_volume_records_tibble <- function() { + tibble::tibble( + record_id = integer(0), + record_volume = integer(0), + record_volume_name = character(0), + record_category_id = integer(0), + record_measures = list(), + record_birthday = character(0), + age_years = integer(0), + age_months = integer(0), + age_days = integer(0), + age_total_days = integer(0), + age_formatted = character(0), + age_is_estimated = logical(0), + age_is_blurred = logical(0), + record_default_sessions = vector("list", 0), + record_source_kind = character(0) + ) +} + +#' 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 (aligned with core +#' \verb{RecordSerializer}): ids, owning volume (`record_volume`), owning volume +#' name (`record_volume_name`), category, measures, birthday, age columns, +#' default sessions (`record_default_sessions`, list column of \verb{id}/\verb{name}), +#' and linked-content provenance (`record_source_kind`). The `record_volume` +#' column may differ from `vol_id` when the volume lists linked records from +#' other volumes. Returns an empty tibble when the volume has no records, or +#' `NULL` when the API call fails (e.g. non-existent volume). +#' +#' @inheritParams options_params +#' +#' @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)) { + return(NULL) + } + + if (length(records) == 0) { + if (vb) { + cat_part <- if (is.null(category_id)) { + "(all categories)" + } else { + paste0("category_id = ", category_id) + } + message("No records found with ", cat_part, " for volume ", vol_id) + } + return(empty_volume_records_tibble()) + } + + # 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 + } + } + + ds_cell <- record$default_sessions + if (is.null(ds_cell)) { + ds_cell <- list() + } + + tibble::tibble( + record_id = record$id, + record_volume = record$volume, + record_volume_name = if (is.null(record$volume_name)) { + NA_character_ + } else { + as.character(record$volume_name) + }, + record_category_id = record$category_id, + record_measures = list(record$measures), + record_birthday = if (is.null(record$birthday)) { + NA_character_ + } else { + bc <- as.character(record$birthday) + if (length(bc) == 1L) { + bc + } else { + paste(bc, collapse = "; ") + } + }, + 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, + record_default_sessions = list(ds_cell), + record_source_kind = if (is.null(record$record_source_kind)) { + NA_character_ + } else { + as.character(record$record_source_kind) + } + ) + }) +} diff --git a/R/list_volume_session_assets.R b/R/list_volume_session_assets.R index 2dd1ea2a..234cc9e1 100644 --- a/R/list_volume_session_assets.R +++ b/R/list_volume_session_assets.R @@ -1,137 +1,109 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL #' List Assets in a Session from a Databrary volume. #' #'#' @description #' `r lifecycle::badge("experimental")` -#' +#' #' `list_volume_session_assets()` is a new name for the = 1) - + assertthat::assert_that(length(session_id) == 1) assertthat::assert_that(is.numeric(session_id)) assertthat::assert_that(session_id >= 1) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - + + 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) - - if (!("containers" %in% names(vol_list))) { + + session <- perform_api_get( + path = sprintf(API_SESSION_DETAIL, vol_id, session_id), + rq = rq, + vb = vb + ) + + if (is.null(session)) { if (vb) - message("No session/containers data from volume ", vol_id) + message("No matching session_id: ", session_id) return(NULL) } - - #-------------------------------------------------------------------------- - get_sessions <- function(volume_container) { - tibble::tibble(session_id = volume_container$id) - } - #-------------------------------------------------------------------------- - - # Select session info - these_sessions <- - purrr::map(vol_list$containers, get_sessions) %>% - purrr::list_rbind() - - session_match <- (session_id == these_sessions$session_id) - if (sum(session_match) == 0) { + + files <- collect_paginated_get( + path = sprintf(API_SESSION_FILES, vol_id, session_id), + rq = rq, + vb = vb + ) + + if (is.null(files) || length(files) == 0) { if (vb) - message("No matching session_id: ", session_id) + message("No assets in 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 = null_to_na_double(file[["duration"]]), + asset_created_at = file$created_at, + asset_updated_at = file$updated_at, + asset_uploader_id = uploader$id, + asset_uploader_first_name = uploader$first_name, + asset_uploader_last_name = uploader$last_name, + asset_sha1 = file$sha1, + asset_thumbnail_url = null_to_na_character(file[["thumbnail_url"]]), + session_id = session$id, + session_name = session$name, + session_release = session$release_level ) - - format_id <- NULL - format_mimetype <- NULL - format_extension <- NULL - format_name <- NULL - - # Gather asset format info - asset_formats_df <- list_asset_formats(vb = vb) %>% - dplyr::select(format_id, format_mimetype, format_extension, format_name) - - # Join assets with asset format info - out_df <- dplyr::left_join(assets_df, - asset_formats_df, - by = dplyr::join_by(asset_format_id == format_id)) - out_df + }) %>% + purrr::list_rbind() + + asset_rows } diff --git a/R/list_volume_sessions.R b/R/list_volume_sessions.R index c8feb025..efc8cfd0 100644 --- a/R/list_volume_sessions.R +++ b/R/list_volume_sessions.R @@ -1,19 +1,20 @@ #' @eval options::as_params() #' @name options_params -#' +#' 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. #' #' @returns A data frame with information about all assets in a volume. -#' +#' #' @inheritParams options_params #' #' @examples @@ -32,90 +33,64 @@ list_volume_sessions <- assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id >= 1) - + assertthat::assert_that(is.logical(include_vol_data)) assertthat::assert_that(length(include_vol_data) == 1) - - 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) { + fc <- session[["file_counts"]] + + tibble::tibble( + session_id = session$id, + session_name = session$name, + session_release = session$release_level, + session_source_date = session$source_date, + session_native_accessible = file_count_value(fc, "native_accessible"), + session_native_inaccessible = file_count_value(fc, "native_inaccessible"), + session_linked_accessible = file_count_value(fc, "linked_accessible"), + session_linked_inaccessible = file_count_value(fc, "linked_inaccessible"), + session_has_full_access = session$has_full_access + ) + }) + 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..696e9cd7 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. @@ -13,7 +14,7 @@ NULL #' @inheritParams options_params #' #' @examples -#' \donttest{ +#' \dontrun{ #' list_volume_tags() #' } #' @export @@ -24,42 +25,29 @@ list_volume_tags <- function(vol_id = 1, assertthat::assert_that(length(vol_id) == 1) assertthat::assert_that(is.numeric(vol_id)) assertthat::assert_that(vol_id > 0) - - 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..2720e21e --- /dev/null +++ b/R/list_volumes.R @@ -0,0 +1,91 @@ +#' @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..cb00ee73 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 +#' @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 @@ -28,151 +23,107 @@ NULL #'# The following shows how to use credentials that have been stored previously. #' #' login_db(email = "you@provider.com", store = TRUE) -#' +#' #' } #' } #' @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() - } - - # If the user wants to store or use their stored credentials, + service = KEYRING_SERVICE, + vb = options::opt("vb")) { + assertthat::assert_that(length(store) == 1, is.logical(store)) + validate_flag(overwrite, "overwrite") + validate_flag(vb, "vb") + assertthat::assert_that(length(service) == 1, is.character(service)) + + # 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..dae85120 100644 --- a/R/logout_db.R +++ b/R/logout_db.R @@ -1,41 +1,32 @@ #' @eval options::as_params() #' @name options_params -#' +#' 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. -#' +#' #' @inheritParams options_params -#' +#' #' @examples #' \donttest{ #' 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..5962e1af 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() +#' make_default_request(with_token = FALSE) #' @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 -} \ No newline at end of file +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)) +} diff --git a/R/make_login_client.R b/R/make_login_client.R index 338a9254..df2de348 100644 --- a/R/make_login_client.R +++ b/R/make_login_client.R @@ -1,6 +1,6 @@ #' @eval options::as_params() #' @name options_params -#' +#' NULL #' Log In To Databrary.org. @@ -8,14 +8,16 @@ NULL #' @param email Databrary account email address. #' @param password Databrary password (not recommended as it will displayed as you type) #' @param store A boolean value. If TRUE store/retrieve credentials from the system keyring/keychain. -#' @param overwrite A boolean value. If TRUE and store is TRUE, overwrite/ update stored credentials in keyring/keychain. -#' @param SERVICE A character label for stored credentials in the keyring. Default is "databrary" +#' @param overwrite A boolean value. If TRUE and store is TRUE, overwrite or +#' update stored credentials in keyring/keychain. +#' @param vb Show verbose feedback. Defaults to `options::opt("vb")`. +#' @param service A character label for stored credentials in the keyring. Default is "databrary" #' @param rq An `httr2` request object. Defaults to NULL. -#' +#' #' @returns Logical value indicating whether log in is successful or not. -#' +#' #' @inheritParams options_params -#' +#' #' @examplesIf interactive() #' make_login_client() # Queries user for email and password interactively. #' @examples @@ -26,32 +28,30 @@ NULL #' make_login_client(email = "you@provider.com", store = TRUE) #' } #' } -#' +#' #' @export make_login_client <- function(email = NULL, - password = NULL, - store = FALSE, - overwrite = FALSE, - vb = options::opt("vb"), - SERVICE = KEYRING_SERVICE, - rq = NULL) { - + password = NULL, + store = FALSE, + overwrite = FALSE, + vb = options::opt("vb"), + service = KEYRING_SERVICE, + rq = NULL) { + # Check parameters assertthat::assert_that(length(store) == 1) assertthat::assert_that(is.logical(store)) - - 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)) - + + validate_flag(store, "store") + validate_flag(overwrite, "overwrite") + validate_flag(vb, "vb") + + assertthat::assert_that(length(service) == 1) + assertthat::assert_that(is.character(service)) + assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - + # Handle NULL request if (is.null(rq)) { if (vb) { @@ -59,13 +59,13 @@ make_login_client <- function(email = NULL, } rq <- databraryr::make_default_request() } - + # If the user wants to store or use their stored credentials, check for keyring support if (store) { assertthat::assert_that(keyring::has_keyring_support(), msg = "No keyring support; please use store=FALSE") } - + # Check or get email if (!is.null(email)) { assertthat::assert_that(assertthat::is.string(email)) @@ -73,32 +73,32 @@ make_login_client <- function(email = NULL, message("Please enter your Databrary user ID (email).") email <- readline(prompt = "Email: ") } - + do_collect_password <- TRUE - + if (!is.null(password)) { assertthat::assert_that(assertthat::is.string(password)) do_collect_password <- FALSE } - + # If the user wants to store or use their stored credentials and # doesn't provide a password if (store && is.null(password) && !overwrite) { if (vb) message("Retrieving password for service='", - SERVICE, + service, "' from keyring.") - kl <- keyring::key_list(service = SERVICE) + kl <- keyring::key_list(service = service) # Make sure our service is in the keyring - if (exists('kl') && is.data.frame(kl)) { + if (exists("kl") && is.data.frame(kl)) { # If it is under the email entered, keep it to try later and not collect it here password <- - try(keyring::key_get(service = SERVICE, username = email), + try(keyring::key_get(service = service, username = email), silent = TRUE) if ("try-error" %in% class(password)) { do_collect_password <- TRUE if (vb) - message("No password found in keyring for service='", SERVICE, ".") + message("No password found in keyring for service='", service, ".") } else { do_collect_password <- FALSE if (vb) @@ -107,44 +107,45 @@ make_login_client <- function(email = NULL, } else { if (vb) message("Error retrieving keyring data for service='", - 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) + httr2_error = function(cnd) { NULL + } ) - + if (!is.null(resp)) { is_login_successful <- TRUE } else { return(NULL) } - - # If the username/password was successful and the user wanted to store + + # If the username/password was successful and the user wanted to store # their credentials # Store them in the keyring if (is_login_successful) { if (store && (do_collect_password || overwrite)) { - keyring::key_set_with_value(service = SERVICE, + keyring::key_set_with_value(service = service, username = email, password = password) if (vb) @@ -153,23 +154,21 @@ make_login_client <- function(email = NULL, if (vb) message(paste("Login successful.")) } - #return(resp) } - + if (store) { if (vb) message( paste0( - 'Login failed; nothing stored in keyring; HTTP status ', + "Login failed; nothing stored in keyring; HTTP status ", httr2::resp_status(resp), - '\n' + "\n" ) ) } else { if (vb) - message(paste0('Login failed; HTTP status ', - httr2::resp_status(resp), '\n')) + message(paste0("Login failed; HTTP status ", + httr2::resp_status(resp), "\n")) } resp - #return(FALSE) } diff --git a/R/misc_enums.R b/R/misc_enums.R new file mode 100644 index 00000000..78192dfd --- /dev/null +++ b/R/misc_enums.R @@ -0,0 +1,51 @@ +# 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 = paste0( + "This content is restricted to authorized Databrary users and ", + "may not be redistributed in any form." + ) + ), + list( + code = "learning_audiences", + description = paste0( + "This content is restricted to authorized Databrary users, who may ", + "use clips or images from it in presentations for informational or ", + "educational purposes. Such presentations may be videotaped or ", + "recorded and those videos or recordings may then be made available ", + "to the public via the internet (e.g., YouTube)." + ) + ), + list( + code = "public", + description = "This content is available to the public." + ) + ) + ) +} diff --git a/R/patch_folder.R b/R/patch_folder.R new file mode 100644 index 00000000..d87a299d --- /dev/null +++ b/R/patch_folder.R @@ -0,0 +1,101 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Partially Update a Folder in Databrary Volume +#' +#' @description Sends a PATCH request to update selected fields of an existing +#' folder. Only provided arguments are sent; omitted fields are left +#' unchanged on the server. The server rejects blanking out a previously +#' non-empty \code{name}. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param folder_id Numeric folder identifier. Must be a positive integer. +#' @param name Optional new folder name. If provided, must be a non-empty +#' length-1 string. +#' @param release_level Optional release level (e.g. \code{"PRIVATE"}, +#' \code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). Server validates +#' the choice. +#' @param source_date Optional folder date. A length-1 \code{Date} object or +#' ISO \code{"YYYY-MM-DD"} string. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the updated folder's metadata (same shape as +#' \code{\link{get_folder_by_id}}), or \code{NULL} if the update fails or +#' no fields were provided. +#' +#' @seealso \code{\link{update_folder}}, \code{\link{create_folder}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' patch_folder(vol_id = 1, folder_id = 42, name = "Renamed folder") +#' } +#' } +#' @export +patch_folder <- function( + vol_id = 1, + folder_id, + name = NULL, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(folder_id, "folder_id") + + if (!is.null(name)) { + assertthat::assert_that(is.character(name), length(name) == 1) + assertthat::assert_that( + nzchar(trimws(name)), + msg = "name must not be empty" + ) + } + + if (!is.null(release_level)) { + assertthat::assert_that( + is.character(release_level), + length(release_level) == 1, + nzchar(trimws(release_level)) + ) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list() + if (!is.null(name)) body$name <- name + if (!is.null(release_level)) body$release_level <- release_level + if (!is.null(source_date)) { + body$source_date <- coerce_iso_date(source_date, "source_date") + } + + if (length(body) == 0) { + if (vb) { + message("No fields provided to update for folder ", folder_id) + } + return(NULL) + } + + folder <- perform_api_patch( + path = sprintf(API_FOLDER_DETAIL, vol_id, folder_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(folder)) { + if (vb) { + message( + "Failed to update folder ", folder_id, " in volume ", vol_id + ) + } + return(NULL) + } + + folder +} diff --git a/R/patch_session.R b/R/patch_session.R new file mode 100644 index 00000000..76915d2a --- /dev/null +++ b/R/patch_session.R @@ -0,0 +1,159 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Partially Update a Session in Databrary Volume +#' +#' @description Sends a PATCH request to update selected fields of an existing +#' session. Only provided arguments are sent; omitted fields are left +#' unchanged on the server. Note that \code{default_records} is a full +#' replacement on the server -- supplying it overwrites the entire current set +#' of defaults; omit it to keep them. To change just one default record use +#' \code{\link{add_default_record_to_session}} or +#' \code{\link{remove_default_record_from_session}}. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param name Optional new session name. If provided, must be a non-empty +#' length-1 string. +#' @param release_level Optional release level (e.g. \code{"PRIVATE"}, +#' \code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). Server validates +#' the choice. +#' @param source_date Optional session date. A length-1 \code{Date} object or +#' ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}. +#' @param date Optional structured date list with named fields \code{year}, +#' \code{month}, \code{day}, and optional \code{is_estimated} (logical). +#' Mutually exclusive with \code{source_date}. +#' @param date_precision Optional precision for \code{date}: e.g. +#' \code{"FULL"}, \code{"YEAR"}. +#' @param default_records Optional integer vector of record IDs. The server +#' replaces the session's current default records with this set. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the updated session's metadata (same shape as +#' \code{\link{get_session_by_id}}), or \code{NULL} if the update fails or +#' no fields were provided. +#' +#' @seealso \code{\link{update_session}}, \code{\link{create_session}}, +#' \code{\link{add_default_record_to_session}}, +#' \code{\link{remove_default_record_from_session}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Rename a session +#' patch_session(vol_id = 1, session_id = 42, name = "Renamed session") +#' +#' # Update the date and precision +#' patch_session( +#' vol_id = 1, +#' session_id = 42, +#' date = list(year = 2024, month = 3, day = 15), +#' date_precision = "FULL" +#' ) +#' } +#' } +#' @export +patch_session <- function( + vol_id = 1, + session_id, + name = NULL, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + default_records = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + + if (!is.null(name)) { + assertthat::assert_that(is.character(name), length(name) == 1) + assertthat::assert_that( + nzchar(trimws(name)), + msg = "name must not be empty" + ) + } + + if (!is.null(release_level)) { + assertthat::assert_that( + is.character(release_level), + length(release_level) == 1, + nzchar(trimws(release_level)) + ) + } + + assertthat::assert_that( + is.null(source_date) || is.null(date), + msg = "Provide either source_date or date, not both." + ) + + if (!is.null(date)) { + assertthat::assert_that( + is.list(date), + !is.null(names(date)), + msg = "date must be a named list (e.g. list(year=, month=, day=))" + ) + } + + if (!is.null(date_precision)) { + assertthat::assert_that( + is.character(date_precision), + length(date_precision) == 1, + nzchar(trimws(date_precision)) + ) + } + + if (!is.null(default_records)) { + assertthat::assert_that( + is.numeric(default_records), + length(default_records) >= 1, + all(default_records >= 1), + all(default_records == floor(default_records)), + msg = "default_records must be a vector of positive integers" + ) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list() + if (!is.null(name)) body$name <- name + if (!is.null(release_level)) body$release_level <- release_level + if (!is.null(source_date)) body$source_date <- coerce_iso_date(source_date, "source_date") + if (!is.null(date)) body$date <- date + if (!is.null(date_precision)) body$date_precision <- date_precision + if (!is.null(default_records)) { + body$default_records <- as.list(as.integer(default_records)) + } + + if (length(body) == 0) { + if (vb) { + message("No fields provided to update for session ", session_id) + } + return(NULL) + } + + session <- perform_api_patch( + path = sprintf(API_SESSION_DETAIL, vol_id, session_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(session)) { + if (vb) { + message( + "Failed to update session ", session_id, " in volume ", vol_id + ) + } + return(NULL) + } + + session +} diff --git a/R/patch_session_file.R b/R/patch_session_file.R new file mode 100644 index 00000000..f4815423 --- /dev/null +++ b/R/patch_session_file.R @@ -0,0 +1,159 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Partially Update a Session File's Metadata +#' +#' @description Sends a PATCH request to update selected metadata fields of an +#' existing session file. Only provided arguments are sent; omitted fields are +#' left unchanged on the server. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param file_id Numeric file identifier. Must be a positive integer. +#' @param name Optional new file name. If provided, must be a non-empty +#' length-1 string. +#' @param release_level Optional release level (e.g. \code{"PRIVATE"}, +#' \code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). Server validates +#' the choice. +#' @param source_date Optional file date. A length-1 \code{Date} object or +#' ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}. +#' @param date Optional structured date list with named fields \code{year}, +#' \code{month}, \code{day}, and optional \code{is_estimated} (logical). +#' Mutually exclusive with \code{source_date}. +#' @param date_precision Optional precision for \code{date}: e.g. +#' \code{"FULL"}, \code{"YEAR"}. +#' @param is_estimated Optional logical flag indicating whether the date is +#' estimated. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the updated file's metadata (same shape as +#' \code{\link{get_session_file}}), or \code{NULL} if the update fails or +#' no fields were provided. +#' +#' @seealso \code{\link{update_session_file}}, \code{\link{delete_session_file}}, +#' \code{\link{get_session_file}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Rename a file +#' patch_session_file( +#' vol_id = 1, session_id = 42, file_id = 99, name = "Renamed.mp4" +#' ) +#' +#' # Update the date and precision +#' patch_session_file( +#' vol_id = 1, +#' session_id = 42, +#' file_id = 99, +#' date = list(year = 2024, month = 3, day = 15), +#' date_precision = "FULL" +#' ) +#' } +#' } +#' @export +patch_session_file <- function( + vol_id = 1, + session_id, + file_id, + name = NULL, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + is_estimated = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer(file_id, "file_id") + + if (!is.null(name)) { + assertthat::assert_that(is.character(name), length(name) == 1) + assertthat::assert_that( + nzchar(trimws(name)), + msg = "name must not be empty" + ) + } + + if (!is.null(release_level)) { + assertthat::assert_that( + is.character(release_level), + length(release_level) == 1, + nzchar(trimws(release_level)) + ) + } + + assertthat::assert_that( + is.null(source_date) || is.null(date), + msg = "Provide either source_date or date, not both." + ) + + if (!is.null(date)) { + assertthat::assert_that( + is.list(date), + !is.null(names(date)), + msg = "date must be a named list (e.g. list(year=, month=, day=))" + ) + } + + if (!is.null(date_precision)) { + assertthat::assert_that( + is.character(date_precision), + length(date_precision) == 1, + nzchar(trimws(date_precision)) + ) + } + + if (!is.null(is_estimated)) { + assertthat::assert_that(is.logical(is_estimated), length(is_estimated) == 1) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list() + if (!is.null(name)) body$name <- name + if (!is.null(release_level)) body$release_level <- release_level + if (!is.null(source_date)) { + body$source_date <- coerce_iso_date(source_date, "source_date") + } + if (!is.null(date)) body$date <- date + if (!is.null(date_precision)) body$date_precision <- date_precision + if (!is.null(is_estimated)) body$is_estimated <- is_estimated + + if (length(body) == 0) { + if (vb) { + message( + "No fields provided to update for file ", file_id, + " in session ", session_id + ) + } + return(NULL) + } + + file <- perform_api_patch( + path = sprintf(API_SESSION_FILE_DETAIL, vol_id, session_id, file_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(file)) { + if (vb) { + message( + "Failed to update file ", file_id, + " in session ", session_id, + " of volume ", vol_id + ) + } + return(NULL) + } + + file +} diff --git a/R/remove_default_record_from_session.R b/R/remove_default_record_from_session.R new file mode 100644 index 00000000..2a83377f --- /dev/null +++ b/R/remove_default_record_from_session.R @@ -0,0 +1,62 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Remove a Default Record from a Session +#' +#' @description Detach a record from a session's default records. The record +#' must currently be a default record on the session, otherwise the server +#' returns \code{404}. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} if the record was successfully removed, \code{FALSE} +#' otherwise. +#' +#' @seealso \code{\link{add_default_record_to_session}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' remove_default_record_from_session(vol_id = 1, session_id = 42, record_id = 101) +#' } +#' } +#' @export +remove_default_record_from_session <- function( # nolint: object_length_linter. + vol_id = 1, + session_id, + record_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer(record_id, "record_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + result <- perform_api_post( + path = sprintf(API_SESSION_REMOVE_DEFAULT_RECORD, vol_id, session_id), + body = list(record_id = record_id), + rq = rq, + vb = vb + ) + + if (is.null(result)) { + if (vb) { + message( + "Failed to remove default record ", record_id, + " from session ", session_id, " in volume ", vol_id + ) + } + return(FALSE) + } + + TRUE +} diff --git a/R/search_for_funder.R b/R/search_for_funder.R index b6267939..2d3f7b49 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. @@ -13,51 +16,66 @@ NULL #' @inheritParams options_params #' #' @examples -#' \donttest{ +#' \dontrun{ #' search_for_funder("national+science+foundation") #' } #' #' @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)) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - + search_string <- gsub("[+]", " ", search_string) + pattern <- stringr::str_trim(search_string) + + validate_flag(approved_only, "approved_only") + validate_flag(vb, "vb") + assertthat::assert_that(is.null(rq) | ("httr2_request" %in% class(rq))) - - 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 (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() + + if (is.null(funders) || length(funders) == 0) { + if (vb) message("No funders available from API.") + return(NULL) } + + 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..4a0c6751 100644 --- a/R/search_for_tags.R +++ b/R/search_for_tags.R @@ -1,15 +1,16 @@ #' @eval options::as_params() #' @name options_params -#' +#' 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. -#' +#' #' @inheritParams options_params #' #' @examples @@ -25,34 +26,31 @@ search_for_tags <- # 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)) - + + 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(resp)) { - httr2::resp_body_string(resp) - } else { - resp + + if (is.null(results) || length(results) == 0) { + if (vb) message("No volumes tagged '", search_string, "'.") + return(NULL) } - #TODO: Reformat search data; handle multiple tags (separate with '+') + + purrr::map_dfr(results, function(entry) { + tibble::tibble( + vol_id = entry$id, + vol_title = entry$title, + vol_sharing_level = entry$sharing_level, + vol_tags = list(entry$tags), + score = entry$score + ) + }) } diff --git a/R/search_institutions.R b/R/search_institutions.R new file mode 100644 index 00000000..bf2672c5 --- /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..fb44ea44 --- /dev/null +++ b/R/search_users.R @@ -0,0 +1,62 @@ +#' @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..3ec73fcd --- /dev/null +++ b/R/search_volumes.R @@ -0,0 +1,80 @@ +#' @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/set_record_measure.R b/R/set_record_measure.R new file mode 100644 index 00000000..b338de8e --- /dev/null +++ b/R/set_record_measure.R @@ -0,0 +1,100 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Set Measure for a Record +#' +#' @description Create or update a single measure for a record. This performs +#' an upsert operation - if the measure exists for this metric, it is updated; +#' otherwise, a new measure is created. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer. +#' @param metric_id Numeric metric identifier. Must be a positive integer. +#' @param value The measure value. Can be a string (for text metrics), a number +#' (for numeric metrics), or a list with \code{year}, \code{month}, \code{day}, +#' optional \code{month} and \code{day} fields (for date metrics). +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return The measure data on success, or \code{NULL} if the operation fails. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Set a text measure +#' set_record_measure( +#' vol_id = 1, +#' record_id = 123, +#' metric_id = 2, +#' value = "Female" +#' ) +#' +#' # Set a numeric measure +#' set_record_measure( +#' vol_id = 1, +#' record_id = 123, +#' metric_id = 5, +#' value = 24.5 +#' ) +#' +#' # Set a date measure +#' set_record_measure( +#' vol_id = 1, +#' record_id = 123, +#' metric_id = 4, +#' value = list(year = 2020, month = 3, day = 15) +#' ) +#' } +#' } +#' @export +set_record_measure <- function( + vol_id = 1, + record_id, + metric_id, + value, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(record_id, "record_id") + assert_positive_integer(metric_id, "metric_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Build request body + # For date measures, value is already a list with year/month/day + # For text/numeric measures, wrap in list(value = ...) + body <- if (is.list(value) && !is.null(names(value))) { + # Assume it's a date measure with named fields + value + } else { + list(value = value) + } + + # Perform API call + measure <- perform_api_post( + path = sprintf(API_RECORD_MEASURES, vol_id, record_id, metric_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(measure)) { + if (vb) { + message( + "Failed to set measure for metric ", + metric_id, + " on record ", + record_id, + " in volume ", + vol_id + ) + } + return(NULL) + } + + measure +} diff --git a/R/set_volume_enabled_categories.R b/R/set_volume_enabled_categories.R new file mode 100644 index 00000000..60de40bb --- /dev/null +++ b/R/set_volume_enabled_categories.R @@ -0,0 +1,59 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Set Enabled Categories for a Volume +#' +#' @description Replace the full set of enabled categories for a Databrary +#' volume. This is a destructive replacement -- categories not in the provided +#' list will be disabled. Pass an empty vector to disable all categories. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param category_ids Integer vector of category IDs to enable. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} on success, \code{NULL} on failure. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Enable participant (1) and task (6) categories +#' set_volume_enabled_categories(vol_id = 1, category_ids = c(1, 6)) +#' +#' # Disable all categories +#' set_volume_enabled_categories(vol_id = 1, category_ids = integer(0)) +#' } +#' } +#' @export +set_volume_enabled_categories <- function( + vol_id = 1, + category_ids, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assertthat::assert_that(is.numeric(category_ids) || length(category_ids) == 0) + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- as.integer(category_ids) + + result <- perform_api_post( + path = sprintf(API_VOLUME_CATEGORIES, vol_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(result)) { + if (vb) { + message("Failed to update categories for volume ", vol_id) + } + return(NULL) + } + + TRUE +} diff --git a/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/unassign_record_from_file.R b/R/unassign_record_from_file.R new file mode 100644 index 00000000..1069ca59 --- /dev/null +++ b/R/unassign_record_from_file.R @@ -0,0 +1,76 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Unassign Record from Session File +#' +#' @description Remove the association between a record and a session file. +#' If the record is not assigned to the file, this operation will fail. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param file_id Numeric file identifier. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return \code{TRUE} if the record was successfully unassigned, \code{FALSE} +#' otherwise. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Unassign a record from a file +#' unassign_record_from_file( +#' vol_id = 1, +#' session_id = 10, +#' file_id = 20, +#' record_id = 123 +#' ) +#' } +#' } +#' @export +unassign_record_from_file <- function( + vol_id = 1, + session_id, + file_id, + record_id, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer(file_id, "file_id") + assert_positive_integer(record_id, "record_id") + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + # Build request body + body <- list(record_id = record_id) + + # Perform API call (unassign returns 204 No Content) + success <- perform_api_post( + path = sprintf(API_SESSION_FILE_UNASSIGN, vol_id, session_id, file_id), + body = body, + rq = rq, + vb = vb + ) + if (is.null(success)) success <- FALSE + + if (!success && vb) { + message( + "Failed to unassign record ", + record_id, + " from file ", + file_id, + " in session ", + session_id, + " of volume ", + vol_id + ) + } + + success +} diff --git a/R/update_folder.R b/R/update_folder.R new file mode 100644 index 00000000..f68471cb --- /dev/null +++ b/R/update_folder.R @@ -0,0 +1,86 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Replace a Folder in Databrary Volume (PUT) +#' +#' @description Sends a PUT request to fully replace a folder's writable +#' fields. \code{name} is required (non-empty); other fields are optional and +#' default to server-side values when omitted (the underlying serializer +#' marks them \code{required=FALSE}). Use \code{\link{patch_folder}} for +#' partial updates when you don't want full-replacement semantics. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param folder_id Numeric folder identifier. Must be a positive integer. +#' @param name New folder name. Required, non-empty after trim. +#' @param release_level Optional release level (e.g. \code{"PRIVATE"}, +#' \code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). +#' @param source_date Optional folder date. A length-1 \code{Date} object or +#' ISO \code{"YYYY-MM-DD"} string. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the updated folder's metadata (same shape as +#' \code{\link{get_folder_by_id}}), or \code{NULL} if the update fails. +#' +#' @seealso \code{\link{patch_folder}}, \code{\link{create_folder}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' update_folder(vol_id = 1, folder_id = 42, name = "Replacement name") +#' } +#' } +#' @export +update_folder <- function( + vol_id = 1, + folder_id, + name, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(folder_id, "folder_id") + + assertthat::assert_that(is.character(name), length(name) == 1) + assertthat::assert_that(nzchar(trimws(name)), msg = "name must not be empty") + + if (!is.null(release_level)) { + assertthat::assert_that( + is.character(release_level), + length(release_level) == 1, + nzchar(trimws(release_level)) + ) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list(name = name) + if (!is.null(release_level)) body$release_level <- release_level + if (!is.null(source_date)) { + body$source_date <- coerce_iso_date(source_date, "source_date") + } + + folder <- perform_api_put( + path = sprintf(API_FOLDER_DETAIL, vol_id, folder_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(folder)) { + if (vb) { + message( + "Failed to replace folder ", folder_id, " in volume ", vol_id + ) + } + return(NULL) + } + + folder +} diff --git a/R/update_session.R b/R/update_session.R new file mode 100644 index 00000000..c5461dc9 --- /dev/null +++ b/R/update_session.R @@ -0,0 +1,132 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Replace a Session in Databrary Volume (PUT) +#' +#' @description Sends a PUT request to fully replace a session's writable +#' fields. \code{name} is required (non-empty); other fields are optional and +#' default to server-side values when omitted (the underlying serializer +#' marks them \code{required=FALSE}). Use \code{\link{patch_session}} for +#' partial updates when you don't want full-replacement semantics. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param name New session name. Required, non-empty after trim. +#' @param release_level Optional release level (e.g. \code{"PRIVATE"}, +#' \code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). +#' @param source_date Optional session date. A length-1 \code{Date} object or +#' ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}. +#' @param date Optional structured date list with named fields \code{year}, +#' \code{month}, \code{day}, and optional \code{is_estimated} (logical). +#' Mutually exclusive with \code{source_date}. +#' @param date_precision Optional precision for \code{date}: e.g. +#' \code{"FULL"}, \code{"YEAR"}. +#' @param default_records Optional integer vector of record IDs. The server +#' replaces the session's current default records with this set; omit to +#' leave them unchanged. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the updated session's metadata (same shape as +#' \code{\link{get_session_by_id}}), or \code{NULL} if the update fails. +#' +#' @seealso \code{\link{patch_session}}, \code{\link{create_session}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Rename a session via PUT +#' update_session(vol_id = 1, session_id = 42, name = "Replacement name") +#' } +#' } +#' @export +update_session <- function( + vol_id = 1, + session_id, + name, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + default_records = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + + assertthat::assert_that(is.character(name), length(name) == 1) + assertthat::assert_that(nzchar(trimws(name)), msg = "name must not be empty") + + if (!is.null(release_level)) { + assertthat::assert_that( + is.character(release_level), + length(release_level) == 1, + nzchar(trimws(release_level)) + ) + } + + assertthat::assert_that( + is.null(source_date) || is.null(date), + msg = "Provide either source_date or date, not both." + ) + + if (!is.null(date)) { + assertthat::assert_that( + is.list(date), + !is.null(names(date)), + msg = "date must be a named list (e.g. list(year=, month=, day=))" + ) + } + + if (!is.null(date_precision)) { + assertthat::assert_that( + is.character(date_precision), + length(date_precision) == 1, + nzchar(trimws(date_precision)) + ) + } + + if (!is.null(default_records)) { + assertthat::assert_that( + is.numeric(default_records), + length(default_records) >= 1, + all(default_records >= 1), + all(default_records == floor(default_records)), + msg = "default_records must be a vector of positive integers" + ) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list(name = name) + if (!is.null(release_level)) body$release_level <- release_level + if (!is.null(source_date)) body$source_date <- coerce_iso_date(source_date, "source_date") + if (!is.null(date)) body$date <- date + if (!is.null(date_precision)) body$date_precision <- date_precision + if (!is.null(default_records)) { + body$default_records <- as.list(as.integer(default_records)) + } + + session <- perform_api_put( + path = sprintf(API_SESSION_DETAIL, vol_id, session_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(session)) { + if (vb) { + message( + "Failed to replace session ", session_id, " in volume ", vol_id + ) + } + return(NULL) + } + + session +} diff --git a/R/update_session_file.R b/R/update_session_file.R new file mode 100644 index 00000000..77a530b5 --- /dev/null +++ b/R/update_session_file.R @@ -0,0 +1,136 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Replace a Session File's Metadata (PUT) +#' +#' @description Sends a PUT request to fully replace a session file's writable +#' metadata fields. \code{name} is required (non-empty); other fields are +#' optional and default to server-side values when omitted. Use +#' \code{\link{patch_session_file}} for partial updates when you don't want +#' full-replacement semantics. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param session_id Numeric session identifier. Must be a positive integer. +#' @param file_id Numeric file identifier. Must be a positive integer. +#' @param name New file name. Required, non-empty after trim. +#' @param release_level Optional release level (e.g. \code{"PRIVATE"}, +#' \code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). +#' @param source_date Optional file date. A length-1 \code{Date} object or +#' ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}. +#' @param date Optional structured date list with named fields \code{year}, +#' \code{month}, \code{day}, and optional \code{is_estimated} (logical). +#' Mutually exclusive with \code{source_date}. +#' @param date_precision Optional precision for \code{date}: e.g. +#' \code{"FULL"}, \code{"YEAR"}. +#' @param is_estimated Optional logical flag indicating whether the date is +#' estimated. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A list with the updated file's metadata (same shape as +#' \code{\link{get_session_file}}), or \code{NULL} if the update fails. +#' +#' @seealso \code{\link{patch_session_file}}, \code{\link{delete_session_file}}, +#' \code{\link{get_session_file}} +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Rename a file via PUT +#' update_session_file( +#' vol_id = 1, +#' session_id = 42, +#' file_id = 99, +#' name = "Replacement name.mp4" +#' ) +#' } +#' } +#' @export +update_session_file <- function( + vol_id = 1, + session_id, + file_id, + name, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + is_estimated = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(session_id, "session_id") + assert_positive_integer(file_id, "file_id") + + assertthat::assert_that(is.character(name), length(name) == 1) + assertthat::assert_that(nzchar(trimws(name)), msg = "name must not be empty") + + if (!is.null(release_level)) { + assertthat::assert_that( + is.character(release_level), + length(release_level) == 1, + nzchar(trimws(release_level)) + ) + } + + assertthat::assert_that( + is.null(source_date) || is.null(date), + msg = "Provide either source_date or date, not both." + ) + + if (!is.null(date)) { + assertthat::assert_that( + is.list(date), + !is.null(names(date)), + msg = "date must be a named list (e.g. list(year=, month=, day=))" + ) + } + + if (!is.null(date_precision)) { + assertthat::assert_that( + is.character(date_precision), + length(date_precision) == 1, + nzchar(trimws(date_precision)) + ) + } + + if (!is.null(is_estimated)) { + assertthat::assert_that(is.logical(is_estimated), length(is_estimated) == 1) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list(name = name) + if (!is.null(release_level)) body$release_level <- release_level + if (!is.null(source_date)) { + body$source_date <- coerce_iso_date(source_date, "source_date") + } + if (!is.null(date)) body$date <- date + if (!is.null(date_precision)) body$date_precision <- date_precision + if (!is.null(is_estimated)) body$is_estimated <- is_estimated + + file <- perform_api_put( + path = sprintf(API_SESSION_FILE_DETAIL, vol_id, session_id, file_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(file)) { + if (vb) { + message( + "Failed to replace file ", file_id, + " in session ", session_id, + " of volume ", vol_id + ) + } + return(NULL) + } + + file +} diff --git a/R/update_volume_record.R b/R/update_volume_record.R new file mode 100644 index 00000000..5ccef963 --- /dev/null +++ b/R/update_volume_record.R @@ -0,0 +1,107 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Update Record in Databrary Volume +#' +#' @description Sends a PATCH request to update a record. The HTTP method is +#' partial in principle, but the API validates \code{measures} as a complete +#' snapshot of \strong{required} metrics for the record's category: every +#' required metric must appear in \code{measures}, or the server returns +#' \code{400} (\verb{Missing required measures...}). The server then replaces +#' stored values for each metric key you send (it does not merge your list with +#' existing measures before that check). To change a single metric without +#' assembling the full required set, use \code{\link{set_record_measure}}. +#' +#' @param vol_id Target volume number. Must be a positive integer. +#' @param record_id Numeric record identifier. Must be a positive integer. +#' @param measures Optional named list mapping metric IDs (as strings) to values. +#' Values can be strings (for text metrics), numbers (for numeric metrics), +#' or lists with \code{year} and optional \code{month}, \code{day} +#' fields (for date metrics). When supplied, must include all required metrics +#' for the record's category (use \code{\link{get_volume_enabled_categories}} +#' or \code{\link{get_volume_record_by_id}} to discover ids and current values). +#' @param participant Optional list for participant records containing +#' \code{birthday} (with \code{year}, \code{month}, \code{day} fields) or +#' \code{age} (with \code{years}, \code{months}, \code{days} fields). Sending +#' only \code{participant} without a complete \code{measures} map may still +#' fail validation for categories with required metrics; include required +#' measures or use \code{\link{set_record_measure}} for targeted edits. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @seealso \code{\link{set_record_measure}}, \code{\link{get_volume_record_by_id}} +#' +#' @return A list with the updated record's metadata (same shape as +#' \code{\link{get_volume_record_by_id}}), or \code{NULL} if update fails. +#' +#' @inheritParams options_params +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' # Prefer for a single metric (no need to list all required measures) +#' set_record_measure(vol_id = 1, record_id = 123, metric_id = 2, value = "Male") +#' +#' # PATCH with measures: merge current values with changes so required metrics stay present +#' rec <- get_volume_record_by_id(vol_id = 1, record_id = 123) +#' new_measures <- utils::modifyList(rec$measures, list("2" = "Updated label")) +#' update_volume_record(vol_id = 1, record_id = 123, measures = new_measures) +#' } +#' } +#' @export +update_volume_record <- function( + vol_id = 1, + record_id, + measures = NULL, + participant = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assert_positive_integer(vol_id, "vol_id") + assert_positive_integer(record_id, "record_id") + + if (!is.null(measures)) { + assertthat::assert_that(is.list(measures)) + } + + if (!is.null(participant)) { + assertthat::assert_that(is.list(participant)) + } + + assertthat::assert_that(is.logical(vb), length(vb) == 1) + assertthat::assert_that(is.null(rq) || inherits(rq, "httr2_request")) + + body <- list() + + if (!is.null(measures)) { + body$measures <- measures + } + + if (!is.null(participant)) { + body$participant <- participant + } + + if (length(body) == 0) { + if (vb) { + message("No fields provided to update for record ", record_id) + } + return(NULL) + } + + record <- perform_api_patch( + path = sprintf(API_VOLUME_RECORD_DETAIL, vol_id, record_id), + body = body, + rq = rq, + vb = vb + ) + + if (is.null(record)) { + if (vb) { + message("Failed to update record ", record_id, " in volume ", vol_id) + } + return(NULL) + } + + record_as_client_list(record) +} diff --git a/R/upload_file.R b/R/upload_file.R new file mode 100644 index 00000000..23ed2661 --- /dev/null +++ b/R/upload_file.R @@ -0,0 +1,206 @@ +#' @eval options::as_params() +#' @name options_params +#' +NULL + +#' Guess the MIME type of a local file from its extension. +#' @noRd +guess_content_type <- function(path) { + ext <- tolower(tools::file_ext(path)) + if (!nzchar(ext)) { + return("application/octet-stream") + } + mimes <- list( + mp4 = "video/mp4", mov = "video/quicktime", avi = "video/x-msvideo", + mkv = "video/x-matroska", webm = "video/webm", + mp3 = "audio/mpeg", wav = "audio/wav", m4a = "audio/mp4", + jpg = "image/jpeg", jpeg = "image/jpeg", png = "image/png", + gif = "image/gif", tiff = "image/tiff", + pdf = "application/pdf", csv = "text/csv", + txt = "text/plain", json = "application/json", + zip = "application/zip" + ) + mt <- mimes[[ext]] + if (is.null(mt)) "application/octet-stream" else mt +} + +#' PUT each part of a multipart upload and collect ETags. +#' @noRd +put_multipart_parts <- function(path, part_urls, part_size, file_size, vb) { + parts_meta <- normalize_part_urls(part_urls) + results <- vector("list", length(parts_meta)) + + for (i in seq_along(parts_meta)) { + pn <- as.integer(parts_meta[[i]]$part_number) + url <- parts_meta[[i]]$url + offset <- (pn - 1L) * as.numeric(part_size) + remaining <- file_size - offset + n <- min(as.numeric(part_size), remaining) + + if (vb) { + message(sprintf( + "Uploading part %d/%d (%.2f MB)", + pn, length(parts_meta), n / 1024 / 1024 + )) + } + + bytes <- read_file_chunk(path, offset = offset, n = n) + resp <- put_signed_url(url, bytes, vb = vb) + if (is.null(resp)) { + if (vb) message("Aborting: part ", pn, " failed to upload.") + return(NULL) + } + + etag <- httr2::resp_header(resp, "ETag") + if (is.null(etag) || !nzchar(etag)) { + if (vb) message("Aborting: part ", pn, " returned no ETag.") + return(NULL) + } + results[[i]] <- list(part_number = pn, etag = unquote_etag(etag)) + } + + results +} + +#' Upload a Local File to Databrary +#' +#' @description High-level wrapper around the upload pipeline: +#' \code{\link{initiate_upload}} -> PUT bytes to the signed URL(s) -> +#' \code{\link{complete_upload}} (multipart only). Returns the metadata +#' needed to poll progress with \code{\link{get_upload_status}}. +#' +#' Picks the upload mode the server returned: single PUT on the on-prem +#' core deployment or for small files on AWS, S3 multipart for large files +#' on AWS. +#' +#' @param path Path to the local file. Must exist and be readable. +#' @param destination_type See \code{\link{initiate_upload}}. +#' @param object_id See \code{\link{initiate_upload}}. +#' @param filename Optional display filename; defaults to \code{basename(path)}. +#' @param content_type Optional MIME type; auto-detected from the file +#' extension when not supplied. +#' @param source_session_id See \code{\link{initiate_upload}}. +#' @param source_folder_id See \code{\link{initiate_upload}}. +#' @param rq An \code{httr2} request object. Defaults to \code{NULL}. +#' +#' @return A named list with \code{upload_guid} (when known), +#' \code{status_url}, and \code{upload_type}. Returns \code{NULL} if any +#' step fails. +#' +#' @inheritParams options_params +#' +#' @seealso \code{\link{initiate_upload}}, \code{\link{get_upload_status}}, +#' \code{\link{complete_upload}} +#' +#' @examples +#' \donttest{ +#' \dontrun{ +#' info <- upload_file( +#' path = "/tmp/clip.mp4", +#' destination_type = "session", +#' object_id = 42 +#' ) +#' get_upload_status(status_url = info$status_url) +#' } +#' } +#' @export +upload_file <- function( + path, + destination_type, + object_id, + filename = NULL, + content_type = NULL, + source_session_id = NULL, + source_folder_id = NULL, + vb = options::opt("vb"), + rq = NULL +) { + assertthat::assert_that( + is.character(path), length(path) == 1, nzchar(path), + file.exists(path), + msg = "path must point to an existing local file" + ) + if (is.null(filename)) { + filename <- basename(path) + } + if (is.null(content_type)) { + content_type <- guess_content_type(path) + } + file_size <- file.info(path)$size + assertthat::assert_that( + !is.na(file_size), file_size > 0, + msg = paste("file is empty or unreadable:", path) + ) + + init <- initiate_upload( + filename = filename, + destination_type = destination_type, + object_id = object_id, + file_size = file_size, + content_type = content_type, + source_session_id = source_session_id, + source_folder_id = source_folder_id, + vb = vb, + rq = rq + ) + if (is.null(init)) { + return(NULL) + } + + if (identical(init$upload_type, "multipart")) { + parts <- put_multipart_parts( + path = path, + part_urls = init$part_urls, + part_size = init$part_size, + file_size = file_size, + vb = vb + ) + if (is.null(parts)) { + return(NULL) + } + + ok <- complete_upload( + upload_guid = init$upload_guid, + s3_upload_id = init$s3_upload_id, + parts = parts, + vb = vb, + rq = rq + ) + if (is.null(ok)) { + return(NULL) + } + + return(list( + upload_guid = init$upload_guid, + status_url = init$status_url, + upload_type = "multipart" + )) + } + + # Single PUT path -- AWS deployment returns required_headers (e.g. KMS + # SSE headers); on-prem core returns no header map. + headers <- init$required_headers + if (is.null(headers)) headers <- list() + # required_headers may arrive as a named list; httr2::req_headers wants a + # named character vector or `...` so coerce. + if (is.list(headers) && length(headers) > 0) { + headers <- vapply(headers, as.character, character(1)) + } + + bytes <- readBin(path, what = "raw", n = file_size) + resp <- put_signed_url( + url = init$signed_upload_url, + body = bytes, + headers = headers, + vb = vb + ) + if (is.null(resp)) { + return(NULL) + } + + list( + upload_guid = init$upload_guid, + status_url = init$status_url, + upload_type = "single" + ) +} diff --git a/R/upload_utils.R b/R/upload_utils.R new file mode 100644 index 00000000..43f64379 --- /dev/null +++ b/R/upload_utils.R @@ -0,0 +1,94 @@ +# Internal helpers for the file upload pipeline (initiate / PUT / complete). + +#' Read a byte range from a file as a raw vector. +#' +#' Used to slice a part for multipart upload. Reads at most `n` bytes +#' starting at `offset`; the last part may return fewer bytes than `n`. +#' @noRd +read_file_chunk <- function(path, offset, n) { + assertthat::assert_that( + assertthat::is.string(path), + file.exists(path) + ) + assertthat::assert_that( + is.numeric(offset), length(offset) == 1, offset >= 0 + ) + assertthat::assert_that( + is.numeric(n), length(n) == 1, n >= 0 + ) + + con <- file(path, "rb") + on.exit(close(con), add = TRUE) + if (offset > 0) { + seek(con, where = offset, origin = "start") + } + readBin(con, what = "raw", n = n) +} + +#' Strip surrounding quotes from an S3 ETag header value. +#' +#' S3 returns the ETag wrapped in double quotes (e.g. `"abc123"`); the +#' completion endpoint accepts either form, but stripping keeps the value +#' tidy and matches the boto example in the service layer. +#' @noRd +unquote_etag <- function(etag) { + if (is.null(etag) || !nzchar(etag)) { + return(etag) + } + gsub('^"|"$', "", etag) +} + +#' PUT a raw byte payload to a signed URL. +#' +#' Builds a *fresh* httr2 request (no Databrary auth headers) because the +#' presigned URL embeds its own signature; sending extra Authorization +#' headers would invalidate it on both S3 and GCS. +#' +#' @param url Signed upload URL. +#' @param body Raw vector to upload. +#' @param headers Optional named character vector of headers (e.g. the +#' `required_headers` returned by `initiate_upload()` for single PUTs). +#' @param vb Verbose logging flag. +#' @return The httr2 response object on success, `NULL` on failure. +#' @noRd +put_signed_url <- function(url, body, headers = NULL, vb = FALSE) { + assertthat::assert_that(assertthat::is.string(url)) + assertthat::assert_that(is.raw(body)) + + request <- httr2::request(url) + request <- httr2::req_method(request, "PUT") + request <- httr2::req_body_raw(request, body) + if (!is.null(headers) && length(headers) > 0) { + request <- do.call(httr2::req_headers, c(list(request), as.list(headers))) + } + request <- httr2::req_timeout(request, REQUEST_TIMEOUT_VERY_LONG) + request <- httr2::req_retry( + request, + max_tries = RETRY_LIMIT, + backoff = function(i) RETRY_WAIT_TIME * RETRY_BACKOFF^(i - 1) + ) + + tryCatch( + httr2::req_perform(request), + httr2_error = function(cnd) { + if (vb) { + message("PUT failed for signed URL: ", conditionMessage(cnd)) + } + NULL + } + ) +} + +#' Normalize the `part_urls` element returned by `initiate_upload()`. +#' +#' Each entry is `list(part_number = int, url = string)`. We sort by +#' part_number to be defensive against server ordering. +#' @noRd +normalize_part_urls <- function(part_urls) { + assertthat::assert_that( + is.list(part_urls), length(part_urls) >= 1, + msg = "part_urls must be a non-empty list" + ) + numbers <- vapply(part_urls, function(p) as.integer(p$part_number), integer(1)) + part_urls[order(numbers)] +} diff --git a/R/utils.R b/R/utils.R index af9a6cdb..247e6ab3 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,6 +1,6 @@ -# R/utils.R -# -# Utility functions. +# Utility functions for the databraryr package. + +utils::globalVariables(c("name", "id", "category")) #------------------------------------------------------------------------------ #' @eval options::as_params() @@ -8,363 +8,117 @@ #' NULL -#' Get Duration (In ms) Of A File. + +#---------------------------------------------------------------------------- +#' Extract Databrary Permission Levels. +#' +#' @returns An array with the permission levels that can be assigned to data. #' -#' @param asset_id Asset number. -#' @param types_w_durations Asset types that have valid durations. -#' @param rq An `httr2` request object. Default is NULL. +#' @inheritParams options_params #' -#' @returns Duration of a file in ms. +#' @examples +#' \donttest{ +#' get_permission_levels() +#' } +#' +#' @export +get_permission_levels <- function(vb = options::opt("vb")) { + validate_flag(vb, "vb") + enums <- get_permission_levels_enums() + enums$volume_access_levels +} + +#---------------------------------------------------------------------------- +#' Show Databrary Release Levels +#' +#' @returns A data frame with Databrary's release levels. #' #' @inheritParams options_params #' #' @examples #' \donttest{ -#' get_file_duration() # default is the test video from databrary.org/volume/1 +#' get_release_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() - } - 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) - } else { - asset_df <- httr2::resp_body_json(resp) - if (asset_df$format %in% types_w_durations) { - asset_df$duration - } - } +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)) } - - #---------------------------------------------------------------------------- - #' 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 - ) - 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 - } + +#---------------------------------------------------------------------------- +#' Extracts File Types Supported by Databrary. +#' +#' +#' @returns A data frame with the file types permitted on Databrary. +#' +#' @inheritParams options_params +#' +#' @examples +#' \dontrun{ +#' get_supported_file_types() +#' } +#' +#' @export +get_supported_file_types <- function(vb = options::opt("vb")) { + validate_flag(vb, "vb") + constants <- assign_constants(vb = vb) + if (is.null(constants)) { + return(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() + df <- constants$format_df + if (is.null(df) || !is.data.frame(df)) { + return(NULL) } - - #---------------------------------------------------------------------------- - #' 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 + req_names <- c("name", "id", "category") + if (length(setdiff(req_names, names(df))) > 0L) { + return(NULL) } - - #---------------------------------------------------------------------------- - #' 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, + df |> + dplyr::rename( + asset_type = name, + asset_type_id = id, + asset_category = category + ) +} + +#---------------------------------------------------------------------------- +#' Make Portable File Names +#' +#' @param fn Databrary party ID +#' @param replace_regex A character string. A regular expression to capture +#' the "non-portable" characters in fn. +#' @param replacement_char A character string. The character(s) that will +#' replace the non-portable characters. +#' +#' @returns A "cleaned" portable file name +#' +#' @inheritParams options_params +#' +make_fn_portable <- function(fn, vb = options::opt("vb"), - rq = NULL) { - assertthat::assert_that(is.numeric(party_id)) - assertthat::assert_that(party_id > 0) - assertthat::assert_that(length(party_id) == 1) - - assertthat::assert_that(is.logical(vb)) - assertthat::assert_that(length(vb) == 1) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - - # Handle NULL rq - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - message("Not logged in. Only public information will be returned.") - } - rq <- databraryr::make_default_request() - } - - party_info <- databraryr::get_party_by_id(party_id = party_id, - vb = vb, - rq = rq) - - if (("institution" %in% names(party_info)) && - (!is.null(party_info[['institution']]))) { - TRUE - } else { - FALSE - } - } - - #---------------------------------------------------------------------------- - #' Is This Party A Person? - #' - #' @param party_id Databrary party ID - #' @param rq An `httr2` request object. - #' - #' @returns TRUE if the party is a person, FALSE otherwise. - #' - #' @inheritParams options_params - #' - #' @examples - #' \donttest{ - #' is_person() - #' } - #' - #' @export - is_person <- function(party_id = 7, - vb = options::opt("vb"), - rq = NULL) { - return(!is_institution( - party_id = party_id, - vb = vb, - rq = rq - )) - } - - #---------------------------------------------------------------------------- - #' 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 + replace_regex = "[ &\\!\\)\\(\\}\\{\\[\\]\\+\\=@#\\$%\\^\\*]", + replacement_char = "_") { + assertthat::assert_that(assertthat::is.string(fn)) + assertthat::assert_that(!is.numeric(fn)) + assertthat::assert_that(!is.logical(fn)) + assertthat::assert_that(length(fn) == 1) + + validate_flag(vb, "vb") + + assertthat::assert_that(assertthat::is.string(replace_regex)) + assertthat::assert_that(length(replace_regex) == 1) + + assertthat::assert_that(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) } - \ 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..5c513488 --- /dev/null +++ b/R/whoami.R @@ -0,0 +1,78 @@ +#' 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) + bundle <- get_token_bundle() + token <- if (is.null(bundle) || is.null(bundle$access_token)) { + "" + } else { + bundle$access_token + } + auth_desc <- if (nzchar(token)) { + paste0("Bearer ", substr(token, 1L, 8L), "...") + } else { + "" + } + message("whoami -> authorization header: ", auth_desc) + } + NULL + } + ) + + 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..2891e67c 100644 --- a/README.Rmd +++ b/README.Rmd @@ -1,6 +1,3 @@ ---- -output: github_document ---- @@ -15,9 +12,7 @@ knitr::opts_chunk$set( # databraryr -```{r include=FALSE} -usethis::use_cran_badge() -usethis::use_lifecycle_badge("stable") +```{r include=FALSE, eval=FALSE} ``` [![CRAN status](https://www.r-pkg.org/badges/version/databraryr)](https://CRAN.R-project.org/package=databraryr) [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) @@ -48,18 +43,147 @@ 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 require OAuth2 authentication. Before +running the examples below, ensure you have set the following environment variables +or stored values with `login_db(store = TRUE)`: -```{r example} +- `DATABRARY_CLIENT_ID` +- `DATABRARY_CLIENT_SECRET` +- `DATABRARY_LOGIN` (your Databrary account email) +- `DATABRARY_PASSWORD` (optional; prompted securely via **getPass** if missing and not in the keyring) +- `DATABRARY_BASE_URL` (optional; defaults to `https://api.databrary.org`; use this for staging or a custom API host) + +You can put these in your user or project `.Renviron` (for example `file.edit("~/.Renviron")` in R, or `usethis::edit_r_environ()` if you use the **usethis** package). + +```{r example, eval=FALSE} library(databraryr) +login_db() + +whoami() + get_db_stats() -list_volume_assets() |> +list_volume_assets(vol_id = 1) |> head() ``` +Illustrative output (depends on your account, API host, and when you run the code): + +``` text +#> Welcome to the databraryr package. + +#> # A tibble: 1 × 11 +#> date institutions affiliates investigators hours_of_recordings +#> +#> 1 2026-05-18 12:05:57 120 3400 2100 95000 +#> # ℹ 6 more variables: authorized_users , total_volumes , +#> # public_volumes , total_files , total_duration_hours , +#> # total_storage_tb +#> # (from get_db_stats(); default type aggregates summary counters) + +#> # A tibble: 6 × 19 +#> asset_id asset_name asset_permission asset_size asset_mime_type +#> +#> 1 9826 Introduction public 88610655 video/mp4 +#> 2 9828 Databrary demo public 917124852 video/mp4 +#> 3 9830 Databrary 1 public 899912341 video/mp4 +#> 4 9832 Datavyu public 764340542 video/mp4 +#> 5 22412 Slides public 4573426 application/pdf +#> 6 9834 Overview and Policy Upda… public 1301079971 video/mp4 +#> # ℹ 14 more variables: asset_format_id , asset_format_name , +#> # asset_duration , asset_created_at , asset_updated_at , +#> # asset_sha1 , asset_thumbnail_url , session_id , +#> # session_name , session_date , session_release , +#> # asset_uploader_id , asset_uploader_first_name , +#> # asset_uploader_last_name +#> # (`asset_duration` / `asset_thumbnail_url` are NA when the API omits them.) +``` + +## Bulk operations + +Functions whose names start with `bulk_*` run many API requests in order (sessions, folders, session files, volume records). Each returns a **tibble** with one row per item you asked to process: + +| Column | Meaning | +|--------|---------| +| `input` | That row’s key (e.g. local path, session id, folder name) | +| `status` | `"success"`, `"failed"`, `"skipped"` (e.g. duplicate basename on upload preflight), or `"pending"` | +| `result` | List column with the API payload when `status` is `"success"` | +| `error` | Error message when `status` is `"failed"` | +| `reason` | Extra detail when relevant (e.g. `"duplicate"` for skipped uploads) | + +### `on_error`, retries, and conditions + +- **`on_error = "stop"`** (default): first failed row stops execution with an error of class **`databraryr_bulk_error`**. In **`tryCatch(..., databraryr_bulk_error = function(e) e$partial)`**, use **`e$partial`** for the tibble of all rows so far (`"failed"` / `"pending"` for rows after the stop). +- **`on_error = "collect"`**: every row is attempted; failures stay `"failed"` and the function returns the full tibble instead of throwing. +- **`max_retries`** / **`retry_delay`**: optional per-row retries before counting a row as failed. + +### Resuming with `resume_bulk()` + +Use **`resume_bulk()`** to run the **same** bulk function again on only **incomplete** rows (`"pending"` or `"failed"`), and merge those outcomes back into the original tibble (order preserved). + +Typical pattern after **`on_error = "stop"`**: + +```{r, eval = FALSE} +partial <- tryCatch( + bulk_upload_files(vol_id = 1, session_id = 42, file_paths = my_paths), + databraryr_bulk_error = function(e) e$partial +) + +# Fix data or environment, then: +partial <- resume_bulk(partial, bulk_upload_files, vol_id = 1, session_id = 42) +``` + +Looping fix-and-resume (safe: each `e$partial` always reflects the full job, not only the last retried subset): + +```{r, eval = FALSE} +partial <- tryCatch( + bulk_upload_files(vol_id = 1, session_id = 42, file_paths = my_paths), + databraryr_bulk_error = function(e) e$partial +) +while (any(partial$status %in% c("pending", "failed"))) { + # fix whatever caused the failure, then: + partial <- tryCatch( + resume_bulk(partial, bulk_upload_files, vol_id = 1, session_id = 42), + databraryr_bulk_error = function(e) e$partial + ) +} +``` + +Pass every argument the bulk function needs via `...` except the **vector argument that defines rows** (`file_paths`, `session_ids`, `folder_ids`, `file_ids`, `session_names`, `folder_names`, `record_ids`, or `record_names`). That vector is filled automatically from `partial$input` for incomplete rows; pass **`input_arg = "..."`** if auto-detection is wrong. + +**Rename helpers** (`bulk_rename_sessions`, `bulk_rename_folders`, `bulk_rename_files`) also take **`new_names`** parallel to the ids being renamed. `resume_bulk()` only forwards the id/file vector—you must pass **`new_names`** (subset to match the incomplete rows, in the same order) yourself. + +**Creates-from-names** helpers (`bulk_create_sessions`, `bulk_create_folders`, `bulk_create_records`) require **unique** names so each row’s `input` stays identifiable when resuming. + +See `?resume_bulk` and the individual `bulk_*` help pages for details. + +## Testing + +The test suite includes integration tests that run against the Databrary API. +These tests require the following environment variables to be set: + +| Variable | Description | +|---|---| +| `DATABRARY_LOGIN` | Email address for the account | +| `DATABRARY_PASSWORD` | Password for the account | +| `DATABRARY_CLIENT_ID` | OAuth client ID | +| `DATABRARY_CLIENT_SECRET` | OAuth client secret | +| `DATABRARY_BASE_URL` | *(optional)* API base URL; defaults to `https://api.databrary.org`. Integration tests use NYU staging (`https://api.stg-databrary.its.nyu.edu`) when this variable is **unset**. | + +Tests that require authentication are automatically skipped when these variables are not available. + +The recommended way to provide them is a project-level `.Renviron` file in the package root: + +```bash +DATABRARY_LOGIN=you@example.com +DATABRARY_PASSWORD=your-password +DATABRARY_CLIENT_ID=your-client-id +DATABRARY_CLIENT_SECRET=your-client-secret +``` + +R loads this file automatically on startup, so `devtools::test()` and `devtools::check()` will pick up the credentials without any extra steps. + ## Lifecycle Rick Gilmore has been using experimental versions of databraryr for many years, but the package was only released to CRAN in the fall of 2023. diff --git a/README.md b/README.md index c279fb50..5a0dfb0c 100644 --- a/README.md +++ b/README.md @@ -1,26 +1,25 @@ + + # databraryr -[![CRAN -status](https://www.r-pkg.org/badges/version/databraryr)](https://CRAN.R-project.org/package=databraryr) -[![Lifecycle: -stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) +[![CRAN status](https://www.r-pkg.org/badges/version/databraryr)](https://CRAN.R-project.org/package=databraryr) +[![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) [![R-CMD-check](https://github.com/databrary/databraryr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/databrary/databraryr/actions/workflows/R-CMD-check.yaml) ## Overview -databraryr is a wrapper for the [Databrary](https://databrary.org) data -library’s application programming interface (API). The package can be -used to create reproducible data wrangling, analysis, and visualization -pipelines from data stored and shared on Databrary. +databraryr is a wrapper for the [Databrary](https://databrary.org) data library's application programming interface (API). +The package can be used to create reproducible data wrangling, analysis, and visualization pipelines from data stored and shared on Databrary. ## Installation + ``` r # The easiest way to install databraryr is from CRAN install.packages("databraryr") @@ -32,61 +31,156 @@ pak::pak("databrary/databraryr") ## Usage -Databrary ([databrary.org](https://databrary.org)) is a -restricted-access research data library specialized for storing and -sharing video with capabilities of storing [other -types](https://nyu.databrary.org/asset/formats/) of associated data. -Access to restricted data requires registration and formal approval by -an institution. The registration process involves the creation of an -(email-account-based) user account and secure password. Once -institutional authorization has been granted, a user may gain access to -shared video, audio, and other data. See - for more information about gaining -access to restricted data. - -However, many commands in the `databraryr` package return meaningful -results *without* or *prior to* formal authorization. These commands -access public data or metadata. +Databrary ([databrary.org](https://databrary.org)) is a restricted-access research data library specialized for storing and sharing video with capabilities of storing [other types](https://nyu.databrary.org/asset/formats/) of associated data. +Access to restricted data requires registration and formal approval by an institution. +The registration process involves the creation of an (email-account-based) user account and secure password. +Once institutional authorization has been granted, a user may gain access to shared video, audio, and other data. +See for more information about gaining access to restricted data. + +All API calls require OAuth2 authentication. Before +running the examples below, ensure you have set the following environment variables +or stored values with `login_db(store = TRUE)`: + +- `DATABRARY_CLIENT_ID` +- `DATABRARY_CLIENT_SECRET` +- `DATABRARY_LOGIN` (your Databrary account email) +- `DATABRARY_PASSWORD` (optional; prompted securely via **getPass** if missing and not in the keyring) +- `DATABRARY_BASE_URL` (optional; defaults to `https://api.databrary.org`; use this for staging or a custom API host) + +You can put these in your user or project `.Renviron` (for example `file.edit("~/.Renviron")` in R, or `usethis::edit_r_environ()` if you use the **usethis** package). + ``` r library(databraryr) -#> Welcome to the databraryr package. + +login_db() + +whoami() get_db_stats() -#> # A tibble: 1 × 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 - -list_volume_assets() |> + +list_volume_assets(vol_id = 1) |> 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 ``` +Illustrative output (depends on your account, API host, and when you run the code): + +``` text +#> Welcome to the databraryr package. + +#> # A tibble: 1 × 11 +#> date institutions affiliates investigators hours_of_recordings +#> +#> 1 2026-05-18 12:05:57 120 3400 2100 95000 +#> # ℹ 6 more variables: authorized_users , total_volumes , +#> # public_volumes , total_files , total_duration_hours , +#> # total_storage_tb +#> # (from get_db_stats(); default type aggregates summary counters) + +#> # A tibble: 6 × 19 +#> asset_id asset_name asset_permission asset_size asset_mime_type +#> +#> 1 9826 Introduction public 88610655 video/mp4 +#> 2 9828 Databrary demo public 917124852 video/mp4 +#> 3 9830 Databrary 1 public 899912341 video/mp4 +#> 4 9832 Datavyu public 764340542 video/mp4 +#> 5 22412 Slides public 4573426 application/pdf +#> 6 9834 Overview and Policy Upda… public 1301079971 video/mp4 +#> # ℹ 14 more variables: asset_format_id , asset_format_name , +#> # asset_duration , asset_created_at , asset_updated_at , +#> # asset_sha1 , asset_thumbnail_url , session_id , +#> # session_name , session_date , session_release , +#> # asset_uploader_id , asset_uploader_first_name , +#> # asset_uploader_last_name +#> # (`asset_duration` / `asset_thumbnail_url` are NA when the API omits them.) +``` + +## Bulk operations + +Functions whose names start with `bulk_*` run many API requests in order (sessions, folders, session files, volume records). Each returns a **tibble** with one row per item you asked to process: + +| Column | Meaning | +|--------|---------| +| `input` | That row’s key (e.g. local path, session id, folder name) | +| `status` | `"success"`, `"failed"`, `"skipped"` (e.g. duplicate basename on upload preflight), or `"pending"` | +| `result` | List column with the API payload when `status` is `"success"` | +| `error` | Error message when `status` is `"failed"` | +| `reason` | Extra detail when relevant (e.g. `"duplicate"` for skipped uploads) | + +### `on_error`, retries, and conditions + +- **`on_error = "stop"`** (default): first failed row stops execution with an error of class **`databraryr_bulk_error`**. In **`tryCatch(..., databraryr_bulk_error = function(e) e$partial)`**, use **`e$partial`** for the tibble of all rows so far (`"failed"` / `"pending"` for rows after the stop). +- **`on_error = "collect"`**: every row is attempted; failures stay `"failed"` and the function returns the full tibble instead of throwing. +- **`max_retries`** / **`retry_delay`**: optional per-row retries before counting a row as failed. + +### Resuming with `resume_bulk()` + +Use **`resume_bulk()`** to run the **same** bulk function again on only **incomplete** rows (`"pending"` or `"failed"`), and merge those outcomes back into the original tibble (order preserved). + +Typical pattern after **`on_error = "stop"`**: + + +``` r +partial <- tryCatch( + bulk_upload_files(vol_id = 1, session_id = 42, file_paths = my_paths), + databraryr_bulk_error = function(e) e$partial +) + +# Fix data or environment, then: +partial <- resume_bulk(partial, bulk_upload_files, vol_id = 1, session_id = 42) +``` + +Looping fix-and-resume (safe: each `e$partial` always reflects the full job, not only the last retried subset): + +``` r +partial <- tryCatch( + bulk_upload_files(vol_id = 1, session_id = 42, file_paths = my_paths), + databraryr_bulk_error = function(e) e$partial +) +while (any(partial$status %in% c("pending", "failed"))) { + # fix whatever caused the failure, then: + partial <- tryCatch( + resume_bulk(partial, bulk_upload_files, vol_id = 1, session_id = 42), + databraryr_bulk_error = function(e) e$partial + ) +} +``` + +Pass every argument the bulk function needs via `...` except the **vector argument that defines rows** (`file_paths`, `session_ids`, `folder_ids`, `file_ids`, `session_names`, `folder_names`, `record_ids`, or `record_names`). That vector is filled automatically from `partial$input` for incomplete rows; pass **`input_arg = "..."`** if auto-detection is wrong. + +**Rename helpers** (`bulk_rename_sessions`, `bulk_rename_folders`, `bulk_rename_files`) also take **`new_names`** parallel to the ids being renamed. `resume_bulk()` only forwards the id/file vector—you must pass **`new_names`** (subset to match the incomplete rows, in the same order) yourself. + +**Creates-from-names** helpers (`bulk_create_sessions`, `bulk_create_folders`, `bulk_create_records`) require **unique** names so each row’s `input` stays identifiable when resuming. + +See `?resume_bulk` and the individual `bulk_*` help pages for details. + +## Testing + +The test suite includes integration tests that run against the Databrary API. +These tests require the following environment variables to be set: + +| Variable | Description | +|---|---| +| `DATABRARY_LOGIN` | Email address for the account | +| `DATABRARY_PASSWORD` | Password for the account | +| `DATABRARY_CLIENT_ID` | OAuth client ID | +| `DATABRARY_CLIENT_SECRET` | OAuth client secret | +| `DATABRARY_BASE_URL` | *(optional)* API base URL; defaults to `https://api.databrary.org`. Integration tests use NYU staging (`https://api.stg-databrary.its.nyu.edu`) when this variable is **unset**. | + +Tests that require authentication are automatically skipped when these variables are not available. + +The recommended way to provide them is a project-level `.Renviron` file in the package root: + +```bash +DATABRARY_LOGIN=you@example.com +DATABRARY_PASSWORD=your-password +DATABRARY_CLIENT_ID=your-client-id +DATABRARY_CLIENT_SECRET=your-client-secret +``` + +R loads this file automatically on startup, so `devtools::test()` and `devtools::check()` will pick up the credentials without any extra steps. + ## Lifecycle -Rick Gilmore has been using experimental versions of databraryr for many -years, but the package was only released to CRAN in the fall of 2023. +Rick Gilmore has been using experimental versions of databraryr for many years, but the package was only released to CRAN in the fall of 2023. Some new features are on the roadmap, but the package is largely stable. diff --git a/man/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/HHMMSSmmm_to_ms.Rd b/man/HHMMSSmmm_to_ms.Rd deleted file mode 100644 index 4396e5a6..00000000 --- a/man/HHMMSSmmm_to_ms.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/utils.R -\name{HHMMSSmmm_to_ms} -\alias{HHMMSSmmm_to_ms} -\title{Convert Timestamp String To ms.} -\usage{ -HHMMSSmmm_to_ms(HHMMSSmmm = "01:01:01:333") -} -\arguments{ -\item{HHMMSSmmm}{a string in the format "HH:MM:SS:mmm"} -} -\value{ -A numeric value in ms from the input string. -} -\description{ -Convert Timestamp String To ms. -} -\examples{ -HHMMSSmmm_to_ms() # 01:01:01:333 in ms -} diff --git a/man/add_default_record_to_session.Rd b/man/add_default_record_to_session.Rd new file mode 100644 index 00000000..49184f5c --- /dev/null +++ b/man/add_default_record_to_session.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/add_default_record_to_session.R +\name{add_default_record_to_session} +\alias{add_default_record_to_session} +\title{Add a Default Record to a Session} +\usage{ +add_default_record_to_session( + vol_id = 1, + session_id, + record_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} if the record was successfully added, \code{FALSE} +otherwise. +} +\description{ +Attach a record to a session as a default record. Default +records apply to all files in the session unless overridden. The record +must either belong to the destination volume or be accessible to it via a +linked volume; the server enforces this and returns \code{403} otherwise. +} +\examples{ +\donttest{ +\dontrun{ +add_default_record_to_session(vol_id = 1, session_id = 42, record_id = 101) +} +} +} +\seealso{ +\code{\link{remove_default_record_from_session}} +} diff --git a/man/assign_constants.Rd b/man/assign_constants.Rd index 7ba52784..b276ae0e 100644 --- a/man/assign_constants.Rd +++ b/man/assign_constants.Rd @@ -7,7 +7,7 @@ assign_constants(vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to NULL.} } @@ -18,7 +18,7 @@ A data frame with the constants. Download Databrary Constants From API. } \examples{ -\donttest{ +\dontrun{ assign_constants() } } diff --git a/man/assign_record_to_file.Rd b/man/assign_record_to_file.Rd new file mode 100644 index 00000000..9612ec77 --- /dev/null +++ b/man/assign_record_to_file.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/assign_record_to_file.R +\name{assign_record_to_file} +\alias{assign_record_to_file} +\title{Assign Record to Session File} +\usage{ +assign_record_to_file( + vol_id = 1, + session_id, + file_id, + record_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{file_id}{Numeric file identifier. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer and +must belong to the specified volume.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +The response data on success, or \code{NULL} if the operation fails. +} +\description{ +Assign a record to a session file, creating a record-file +association. This operation is idempotent - calling it multiple times with +the same parameters will not create duplicate associations. +} +\examples{ +\donttest{ +\dontrun{ +# Assign a participant record to a video file +assign_record_to_file( + vol_id = 1, + session_id = 10, + file_id = 20, + record_id = 123 +) +} +} +} diff --git a/man/bulk_assign_records.Rd b/man/bulk_assign_records.Rd new file mode 100644 index 00000000..a7f6f3f3 --- /dev/null +++ b/man/bulk_assign_records.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_records.R +\name{bulk_assign_records} +\alias{bulk_assign_records} +\title{Bulk Assign Default Records to a Session} +\usage{ +bulk_assign_records( + vol_id = 1, + session_id, + record_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier.} + +\item{record_ids}{Numeric vector of record identifiers.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +\code{input} is each record id. +} +\description{ +For each record id, call \code{\link{add_default_record_to_session}} +so the record becomes a session default. +} +\examples{ +\donttest{ +\dontrun{ +bulk_assign_records(vol_id = 1, session_id = 42, record_ids = c(101, 102)) +} +} +} +\seealso{ +\code{\link{add_default_record_to_session}}, +\code{\link{resume_bulk}} +} diff --git a/man/bulk_create_folders.Rd b/man/bulk_create_folders.Rd new file mode 100644 index 00000000..08ae3075 --- /dev/null +++ b/man/bulk_create_folders.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_folders.R +\name{bulk_create_folders} +\alias{bulk_create_folders} +\title{Bulk Create Folders in a Databrary Volume} +\usage{ +bulk_create_folders( + vol_id = 1, + folder_names, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{folder_names}{Non-empty character vector of folder names (trimmed; +none may be empty after trimming).} + +\item{release_level}{Optional character vector (length 1 or +\code{length(folder_names)}), passed per row to \code{\link{create_folder}}.} + +\item{source_date}{Optional \code{Date}, ISO string, or vector thereof +(length 1 or \code{length(folder_names)}).} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}, +with \code{input} equal to the trimmed folder name for each row. +} +\description{ +Create many folders sequentially. \code{input} in the result +tibble is the folder name for that row (after trimming). \code{folder_names} +must be unique. Optional fields are recycled: length 1 or same length as +\code{folder_names}. +} +\examples{ +\donttest{ +\dontrun{ +bulk_create_folders(vol_id = 1, folder_names = c("A", "B", "C")) +} +} +} +\seealso{ +\code{\link{create_folder}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_create_records.Rd b/man/bulk_create_records.Rd new file mode 100644 index 00000000..d53976f7 --- /dev/null +++ b/man/bulk_create_records.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_records.R +\name{bulk_create_records} +\alias{bulk_create_records} +\title{Bulk Create Records in a Databrary Volume} +\usage{ +bulk_create_records( + vol_id = 1, + record_names, + category_id, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{record_names}{Non-empty character vector of record display names (trimmed).} + +\item{category_id}{Numeric category id(s); length 1 or \code{length(record_names)}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +\code{input} is each trimmed record name. +} +\description{ +Create many records sequentially via +\code{\link{create_volume_record}} with empty \code{measures} aside from the +resolved name metric. \code{record_names} must be unique (for +\code{\link{resume_bulk}}). \code{category_id} may be length 1 or match +\code{record_names}. Per-row \code{measures} / \code{participant} are not +supported; call \code{\link{create_volume_record}} for those cases. +} +\examples{ +\donttest{ +\dontrun{ +bulk_create_records( + vol_id = 1, + record_names = c("P101", "P102"), + category_id = 6 +) +} +} +} +\seealso{ +\code{\link{create_volume_record}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_create_sessions.Rd b/man/bulk_create_sessions.Rd new file mode 100644 index 00000000..b35ba61b --- /dev/null +++ b/man/bulk_create_sessions.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_sessions.R +\name{bulk_create_sessions} +\alias{bulk_create_sessions} +\title{Bulk Create Sessions in a Databrary Volume} +\usage{ +bulk_create_sessions( + vol_id = 1, + session_names, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_names}{Non-empty character vector of session names.} + +\item{release_level}{Optional character vector (length 1 or +\code{length(session_names)}).} + +\item{source_date}{Optional \code{Date}, ISO string, or vector thereof +(length 1 or \code{length(session_names)}).} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}, +with \code{input} equal to the trimmed session name for each row. +} +\description{ +Create many sessions sequentially. \code{input} in the result +tibble is the session name for that row (after trimming). \code{session_names} +must be unique. Optional fields are recycled. Structured \code{date}, +\code{date_precision}, and +\code{default_records} are not supported here; use \code{\link{create_session}} +per row if you need them. +} +\examples{ +\donttest{ +\dontrun{ +bulk_create_sessions(vol_id = 1, session_names = c("S1", "S2")) +} +} +} +\seealso{ +\code{\link{create_session}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_delete_files.Rd b/man/bulk_delete_files.Rd new file mode 100644 index 00000000..3ab0977b --- /dev/null +++ b/man/bulk_delete_files.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_files.R +\name{bulk_delete_files} +\alias{bulk_delete_files} +\title{Bulk Delete Files from a Databrary Session} +\usage{ +bulk_delete_files( + vol_id = 1, + session_id, + file_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{file_ids}{Numeric vector of file identifiers. Must be positive +integers.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}. +} +\description{ +Soft-delete many files from a single session sequentially. +} +\examples{ +\donttest{ +\dontrun{ +bulk_delete_files(vol_id = 1, session_id = 42, file_ids = c(1001, 1002)) +} +} +} +\seealso{ +\code{\link{delete_session_file}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_delete_folders.Rd b/man/bulk_delete_folders.Rd new file mode 100644 index 00000000..c22b7e5c --- /dev/null +++ b/man/bulk_delete_folders.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_folders.R +\name{bulk_delete_folders} +\alias{bulk_delete_folders} +\title{Bulk Delete Folders from a Databrary Volume} +\usage{ +bulk_delete_folders( + vol_id = 1, + folder_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{folder_ids}{Numeric vector of folder identifiers. Must be positive +integers.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}. +} +\description{ +Soft-delete many folders from a single volume sequentially. +} +\examples{ +\donttest{ +\dontrun{ +bulk_delete_folders(vol_id = 1, folder_ids = c(11, 12, 13)) +} +} +} +\seealso{ +\code{\link{delete_folder}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_delete_records.Rd b/man/bulk_delete_records.Rd new file mode 100644 index 00000000..da93af73 --- /dev/null +++ b/man/bulk_delete_records.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_records.R +\name{bulk_delete_records} +\alias{bulk_delete_records} +\title{Bulk Delete Records from a Databrary Volume} +\usage{ +bulk_delete_records( + vol_id = 1, + record_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{record_ids}{Numeric vector of record identifiers (positive integers).} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +\code{input} is each record id. +} +\description{ +Soft-delete many volume records sequentially via +\code{\link{delete_volume_record}}. +} +\examples{ +\donttest{ +\dontrun{ +bulk_delete_records(vol_id = 1, record_ids = c(101, 102)) +} +} +} +\seealso{ +\code{\link{delete_volume_record}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_delete_sessions.Rd b/man/bulk_delete_sessions.Rd new file mode 100644 index 00000000..9ec838ab --- /dev/null +++ b/man/bulk_delete_sessions.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_sessions.R +\name{bulk_delete_sessions} +\alias{bulk_delete_sessions} +\title{Bulk Delete Sessions from a Databrary Volume} +\usage{ +bulk_delete_sessions( + vol_id = 1, + session_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_ids}{Numeric vector of session identifiers. Must be positive +integers.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}. +} +\description{ +Soft-delete many sessions from a single volume sequentially. +With \code{on_error = "stop"} (default), fails fast and throws +\code{databraryr_bulk_error}; with \code{"collect"}, marks failed rows and +continues. +} +\examples{ +\donttest{ +\dontrun{ +bulk_delete_sessions(vol_id = 1, session_ids = c(101, 102, 103)) +} +} +} +\seealso{ +\code{\link{delete_session}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_rename_files.Rd b/man/bulk_rename_files.Rd new file mode 100644 index 00000000..7d2dc5af --- /dev/null +++ b/man/bulk_rename_files.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_files.R +\name{bulk_rename_files} +\alias{bulk_rename_files} +\title{Bulk Rename Files in a Databrary Session} +\usage{ +bulk_rename_files( + vol_id = 1, + session_id, + file_ids, + new_names, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier containing the files.} + +\item{file_ids}{Numeric vector of file identifiers (unique positive integers).} + +\item{new_names}{Character vector of new names, same length as \code{file_ids}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +\code{input} is each file id. +} +\description{ +Rename many session files sequentially via +\code{\link{patch_session_file}} (\code{name} only). \code{file_ids} must be +unique. Folder assets are not supported here (no folder file PATCH helper). +With \code{\link{resume_bulk}}, pass \code{new_names} aligned to incomplete +rows. +} +\examples{ +\donttest{ +\dontrun{ +bulk_rename_files( + vol_id = 1, + session_id = 42, + file_ids = c(1001, 1002), + new_names = c("clip_a.mp4", "clip_b.mp4") +) +} +} +} +\seealso{ +\code{\link{patch_session_file}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_rename_folders.Rd b/man/bulk_rename_folders.Rd new file mode 100644 index 00000000..8d69aa01 --- /dev/null +++ b/man/bulk_rename_folders.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_folders.R +\name{bulk_rename_folders} +\alias{bulk_rename_folders} +\title{Bulk Rename Folders in a Databrary Volume} +\usage{ +bulk_rename_folders( + vol_id = 1, + folder_ids, + new_names, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{folder_ids}{Numeric vector of folder identifiers (unique positive +integers).} + +\item{new_names}{Character vector of new names, same length as +\code{folder_ids}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +\code{input} is each folder id. +} +\description{ +Rename many folders sequentially via \code{\link{patch_folder}} +(\code{name} only). \code{folder_ids} must be unique. With +\code{\link{resume_bulk}}, pass \code{new_names} aligned to incomplete rows. +} +\examples{ +\donttest{ +\dontrun{ +bulk_rename_folders( + vol_id = 1, + folder_ids = c(11, 12), + new_names = c("Stimuli", "Protocols") +) +} +} +} +\seealso{ +\code{\link{patch_folder}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_rename_sessions.Rd b/man/bulk_rename_sessions.Rd new file mode 100644 index 00000000..50e249f5 --- /dev/null +++ b/man/bulk_rename_sessions.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_sessions.R +\name{bulk_rename_sessions} +\alias{bulk_rename_sessions} +\title{Bulk Rename Sessions in a Databrary Volume} +\usage{ +bulk_rename_sessions( + vol_id = 1, + session_ids, + new_names, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_ids}{Numeric vector of session identifiers (unique positive +integers).} + +\item{new_names}{Character vector of new names, same length as +\code{session_ids}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +\code{input} is each session id. +} +\description{ +Rename many sessions sequentially via \code{\link{patch_session}} +(\code{name} only). \code{session_ids} must be unique so each row maps to one +name. With \code{\link{resume_bulk}}, pass \code{new_names} aligned to the +subset of ids being retried (same order as incomplete rows). +} +\examples{ +\donttest{ +\dontrun{ +bulk_rename_sessions( + vol_id = 1, + session_ids = c(101, 102), + new_names = c("Lab visit A", "Lab visit B") +) +} +} +} +\seealso{ +\code{\link{patch_session}}, \code{\link{resume_bulk}} +} diff --git a/man/bulk_unassign_records.Rd b/man/bulk_unassign_records.Rd new file mode 100644 index 00000000..24c23e9f --- /dev/null +++ b/man/bulk_unassign_records.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_records.R +\name{bulk_unassign_records} +\alias{bulk_unassign_records} +\title{Bulk Unassign Default Records from a Session} +\usage{ +bulk_unassign_records( + vol_id = 1, + session_id, + record_ids, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier.} + +\item{record_ids}{Numeric vector of record identifiers.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} or \code{"collect"}; see \code{\link{bulk_upload_files}}.} + +\item{max_retries}{Non-negative integer; extra attempts per input after the first failure.} + +\item{retry_delay}{Seconds between retries.} +} +\value{ +A \code{tibble} as documented in \code{\link{bulk_upload_files}}; +\code{input} is each record id. +} +\description{ +For each record id, call +\code{\link{remove_default_record_from_session}}. +} +\examples{ +\donttest{ +\dontrun{ +bulk_unassign_records(vol_id = 1, session_id = 42, record_ids = c(101, 102)) +} +} +} +\seealso{ +\code{\link{remove_default_record_from_session}}, +\code{\link{resume_bulk}} +} diff --git a/man/bulk_upload_files.Rd b/man/bulk_upload_files.Rd new file mode 100644 index 00000000..4a2a20aa --- /dev/null +++ b/man/bulk_upload_files.Rd @@ -0,0 +1,85 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_files.R +\name{bulk_upload_files} +\alias{bulk_upload_files} +\title{Bulk Upload Files to a Databrary Session or Folder} +\usage{ +bulk_upload_files( + vol_id = 1, + session_id = NULL, + file_paths, + folder_id = NULL, + preflight = TRUE, + vb = options::opt("vb"), + rq = NULL, + on_error = c("stop", "collect"), + max_retries = 0L, + retry_delay = 0 +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Session id when uploading to a session. Exactly one of +\code{session_id} and \code{folder_id} must be non-\code{NULL}.} + +\item{file_paths}{Character vector of local file paths to upload. Each must +point to an existing file.} + +\item{folder_id}{Folder id when uploading to a folder. Exactly one of +\code{session_id} and \code{folder_id} must be non-\code{NULL}.} + +\item{preflight}{Logical; if \code{TRUE} (default), skip files whose basename +already exists in the target session or folder (via +\code{\link{check_duplicate_files_in_session}} or +\code{\link{check_duplicate_files_in_folder}}).} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} + +\item{on_error}{\code{"stop"} (default) throws \code{databraryr_bulk_error} +on first failure after retries; \code{"collect"} marks failed rows and +continues.} + +\item{max_retries}{Non-negative integer: extra attempts per input after the +first failure (default \code{0}).} + +\item{retry_delay}{Seconds to sleep between retries (default \code{0}).} +} +\value{ +A \code{tibble} with one row per input file and columns: +\code{input} (path), \code{status} (\code{"success"}, \code{"failed"}, +\code{"skipped"}, or \code{"pending"}), \code{result} (list-column with +the per-file API response or \code{NULL}), \code{error} (character +message on failure), and \code{reason} (e.g. \code{"duplicate"}). +} +\description{ +Upload many files sequentially to a single session or a single +folder. Optionally runs a preflight check for duplicate basenames and skips +those uploads. With \code{on_error = "stop"} (default), fails fast on the +first error and throws \code{databraryr_bulk_error} with a partial tibble for +\code{\link{resume_bulk}}. +} +\examples{ +\donttest{ +\dontrun{ +result <- bulk_upload_files( + vol_id = 1, + session_id = 42, + file_paths = c("/tmp/a.mp4", "/tmp/b.mp4") +) +result <- bulk_upload_files( + vol_id = 1, + file_paths = c("/tmp/a.mp4", "/tmp/b.mp4"), + folder_id = 7 +) +} +} +} +\seealso{ +\code{\link{upload_file}}, +\code{\link{check_duplicate_files_in_session}}, +\code{\link{check_duplicate_files_in_folder}}, +\code{\link{resume_bulk}} +} diff --git a/man/check_duplicate_files_in_folder.Rd b/man/check_duplicate_files_in_folder.Rd new file mode 100644 index 00000000..39b7cee7 --- /dev/null +++ b/man/check_duplicate_files_in_folder.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/check_duplicate_files_in_folder.R +\name{check_duplicate_files_in_folder} +\alias{check_duplicate_files_in_folder} +\title{Check Whether Filenames Already Exist in a Folder} +\usage{ +check_duplicate_files_in_folder( + vol_id = 1, + folder_id, + filenames, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{folder_id}{Numeric folder identifier. Must be a positive integer.} + +\item{filenames}{Character vector of filenames to check. Length must be +at least 1; each element must be a non-empty string.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A \code{tibble} with columns \code{filename} (character) and +\code{exists} (logical), one row per input filename and in the same +order. Returns \code{NULL} if the request fails. Against current staging API, +a missing \code{folder_id} still yields a successful response with +\code{exists = FALSE} for each filename (nothing matches that folder). +} +\description{ +Ask the server which of the supplied filenames already +exist as files in the given folder. Useful before bulk uploads to detect +name collisions in advance. +} +\examples{ +\donttest{ +\dontrun{ +check_duplicate_files_in_folder( + vol_id = 1, + folder_id = 42, + filenames = c("clip_001.mp4", "clip_002.mp4") +) +} +} +} diff --git a/man/check_duplicate_files_in_session.Rd b/man/check_duplicate_files_in_session.Rd new file mode 100644 index 00000000..f4d6086d --- /dev/null +++ b/man/check_duplicate_files_in_session.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/check_duplicate_files_in_session.R +\name{check_duplicate_files_in_session} +\alias{check_duplicate_files_in_session} +\title{Check Whether Filenames Already Exist in a Session} +\usage{ +check_duplicate_files_in_session( + vol_id = 1, + session_id, + filenames, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{filenames}{Character vector of filenames to check. Length must be +at least 1; each element must be a non-empty string.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A \code{tibble} with columns \code{filename} (character) and +\code{exists} (logical), one row per input filename and in the same +order. Returns \code{NULL} if the request fails. The server answers +successfully even when \code{session_id} does not exist: every file is +reported as \code{exists = FALSE} (no rows match that session). +} +\description{ +Ask the server which of the supplied filenames already +exist as files in the given session. Useful before bulk uploads to detect +name collisions in advance. +} +\examples{ +\donttest{ +\dontrun{ +check_duplicate_files_in_session( + vol_id = 1, + session_id = 42, + filenames = c("clip_001.mp4", "clip_002.mp4") +) +} +} +} diff --git a/man/check_ssl_certs.Rd b/man/check_ssl_certs.Rd index 3978b43a..5f023fce 100644 --- a/man/check_ssl_certs.Rd +++ b/man/check_ssl_certs.Rd @@ -17,7 +17,7 @@ A data frame with information about the SSL certificates. and returns a data frame with the relevant information. } \examples{ -\donttest{ +\dontrun{ check_ssl_certs() } } diff --git a/man/complete_upload.Rd b/man/complete_upload.Rd new file mode 100644 index 00000000..a52623ad --- /dev/null +++ b/man/complete_upload.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/complete_upload.R +\name{complete_upload} +\alias{complete_upload} +\title{Complete a Multipart Upload} +\usage{ +complete_upload( + upload_guid, + s3_upload_id, + parts, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{upload_guid}{Character GUID returned in \code{initiate_upload()$upload_guid}.} + +\item{s3_upload_id}{Character S3 upload ID returned in +\code{initiate_upload()$s3_upload_id}.} + +\item{parts}{A list of one entry per part, each a list with +\code{part_number} (positive integer) and \code{etag} (character, +from the \code{ETag} response header of the part PUT). Order is not +significant -- the server sorts by \code{part_number}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} on success, \code{NULL} on failure. +} +\description{ +Tell the Databrary API that all parts of a multipart upload +have been PUT to S3 and the object can be assembled. The server forwards +the part list to S3's \code{CompleteMultipartUpload}, transitioning the +upload into the post-upload pipeline (virus scan, format probe). + +Only needed when \code{initiate_upload()} returned +\code{upload_type == "multipart"}. Single-PUT uploads complete implicitly +once the object lands in storage. +} +\examples{ +\donttest{ +\dontrun{ +complete_upload( + upload_guid = "abc...", + s3_upload_id = "xyz...", + parts = list( + list(part_number = 1L, etag = "etag-of-part-1"), + list(part_number = 2L, etag = "etag-of-part-2") + ) +) +} +} +} +\seealso{ +\code{\link{initiate_upload}}, \code{\link{upload_file}} +} diff --git a/man/create_folder.Rd b/man/create_folder.Rd new file mode 100644 index 00000000..76931abf --- /dev/null +++ b/man/create_folder.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/create_folder.R +\name{create_folder} +\alias{create_folder} +\title{Create Folder in Databrary Volume} +\usage{ +create_folder( + vol_id = 1, + name, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{name}{Display name for the folder. Required, non-empty after trim.} + +\item{release_level}{Optional release level for the folder +(e.g. \code{"PRIVATE"}, \code{"SHARED"}, \code{"EXCERPTS"}, +\code{"PUBLIC"}). The server validates the choice.} + +\item{source_date}{Optional folder date. A length-1 \code{Date} object or +ISO \code{"YYYY-MM-DD"} string.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the created folder's metadata (same shape as +\code{\link{get_folder_by_id}}), or \code{NULL} if creation fails. +} +\description{ +Create a new folder in a Databrary volume. \code{name} is +required and must be non-empty. Folders group files together but, unlike +sessions, do not carry structured date / default-record metadata. +} +\examples{ +\donttest{ +\dontrun{ +# Minimal folder +create_folder(vol_id = 1, name = "Stimuli") + +# Folder with a release level and date +create_folder( + vol_id = 1, + name = "Stimuli", + release_level = "SHARED", + source_date = as.Date("2024-03-15") +) +} +} +} +\seealso{ +\code{\link{update_folder}}, \code{\link{patch_folder}}, +\code{\link{delete_folder}} +} diff --git a/man/create_session.Rd b/man/create_session.Rd new file mode 100644 index 00000000..7760b25e --- /dev/null +++ b/man/create_session.Rd @@ -0,0 +1,79 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/create_session.R +\name{create_session} +\alias{create_session} +\title{Create Session in Databrary Volume} +\usage{ +create_session( + vol_id = 1, + name, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + default_records = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{name}{Display name for the session. Required, non-empty after trim.} + +\item{release_level}{Optional release level for the session +(e.g. \code{"PRIVATE"}, \code{"SHARED"}, \code{"EXCERPTS"}, +\code{"PUBLIC"}). The server validates the choice.} + +\item{source_date}{Optional session date. A length-1 \code{Date} object or +ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}.} + +\item{date}{Optional structured date list with named fields \code{year}, +\code{month}, \code{day}, and optional \code{is_estimated} (logical). +Mutually exclusive with \code{source_date}.} + +\item{date_precision}{Optional precision for \code{date}: e.g. +\code{"FULL"}, \code{"YEAR"}. Server validates the choice.} + +\item{default_records}{Optional integer vector of record IDs to set as +default records on the new session.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the created session's metadata (same shape as +\code{\link{get_session_by_id}}), or \code{NULL} if creation fails. +} +\description{ +Create a new session in a Databrary volume. A session (a.k.a. +"slot") groups files and metadata for a single recording or testing event. +\code{name} is required and must be non-empty. Provide either a flat +\code{source_date} or a structured \code{date} list (with optional +\code{date_precision}) to record when the session occurred -- not both. +} +\examples{ +\donttest{ +\dontrun{ +# Minimal session +create_session(vol_id = 1, name = "Pilot 01") + +# Session with a flat date +create_session( + vol_id = 1, + name = "Pilot 02", + source_date = as.Date("2024-03-15") +) + +# Session with a structured date and default records +create_session( + vol_id = 1, + name = "Pilot 03", + date = list(year = 2024, month = 3, day = 15, is_estimated = FALSE), + date_precision = "FULL", + default_records = c(101, 102) +) +} +} +} diff --git a/man/create_volume_record.Rd b/man/create_volume_record.Rd new file mode 100644 index 00000000..ae752ad4 --- /dev/null +++ b/man/create_volume_record.Rd @@ -0,0 +1,80 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/create_volume_record.R +\name{create_volume_record} +\alias{create_volume_record} +\title{Create Record in Databrary Volume} +\usage{ +create_volume_record( + vol_id = 1, + category_id, + name, + measures = list(), + participant = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{category_id}{Numeric category identifier for the record type +(e.g., participant, condition, task).} + +\item{name}{Display name for the record (e.g., "P001", "Control group"). +Required; resolves to the category's name metric from volume configuration.} + +\item{measures}{Optional named list mapping additional metric IDs (as strings) +to values. Values can be strings (for text metrics), numbers (for numeric +metrics), or lists with \code{year}, \code{month}, \code{day}, +optional \code{month} and \code{day} fields (for date metrics).} + +\item{participant}{Optional list for participant records containing +\code{birthday} (with \code{year}, \code{month}, \code{day} fields) or +\code{age} (with \code{years}, \code{months}, \code{days} fields). Cannot +provide both \code{birthday} and \code{age}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +Same shape as \code{\link{get_volume_record_by_id}}, or \code{NULL} +if creation fails. +} +\description{ +Create a new record in a Databrary volume. Records contain +metadata organized by category (e.g., participant, condition, task) with +measures (field values) stored per metric. The \code{name} is required and +resolved to the category's name/ID metric automatically. Use \code{measures} +to add additional metric values. +} +\examples{ +\donttest{ +\dontrun{ +# Create a task record with name only +create_volume_record( + vol_id = 1, + category_id = 6, + name = "Control group" +) + +# Create a record with name and additional measures +create_volume_record( + vol_id = 1, + category_id = 6, + name = "Task A", + measures = list("30" = "Extra value") +) + +# Create a participant record with name and birthday +create_volume_record( + vol_id = 1, + category_id = 1, + name = "P001", + participant = list( + birthday = list(year = 2020, month = 3, day = 15) + ) +) +} +} +} diff --git a/man/databraryr-package.Rd b/man/databraryr-package.Rd index e743c6b8..ce3dcf64 100644 --- a/man/databraryr-package.Rd +++ b/man/databraryr-package.Rd @@ -25,12 +25,14 @@ Useful links: Authors: \itemize{ \item Jeffrey Spies \email{cran@jeffspies.com} + \item Pawel pawel.armatys@montrosesoftware.com Armatys } Other contributors: \itemize{ \item National Science Foundation OAC-2032713 [funder] \item National Institutes of Health R01HD094830 [funder] + \item National Science Foundation BCS 2444730, 2444731 [funder] } } diff --git a/man/delete_folder.Rd b/man/delete_folder.Rd new file mode 100644 index 00000000..ad26c630 --- /dev/null +++ b/man/delete_folder.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/delete_folder.R +\name{delete_folder} +\alias{delete_folder} +\title{Delete Folder from Databrary Volume} +\usage{ +delete_folder(vol_id = 1, folder_id, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{folder_id}{Numeric folder identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} if the folder was successfully deleted, \code{FALSE} +otherwise. +} +\description{ +Delete (soft-delete) a folder from a Databrary volume. The +folder and its associated metadata are marked as deleted but not +permanently removed from the database. +} +\examples{ +\donttest{ +\dontrun{ +delete_folder(vol_id = 1, folder_id = 42) +} +} +} +\seealso{ +\code{\link{create_folder}}, \code{\link{update_folder}}, +\code{\link{patch_folder}} +} diff --git a/man/delete_record_measure.Rd b/man/delete_record_measure.Rd new file mode 100644 index 00000000..18fc478a --- /dev/null +++ b/man/delete_record_measure.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/delete_record_measure.R +\name{delete_record_measure} +\alias{delete_record_measure} +\title{Delete Measure from a Record} +\usage{ +delete_record_measure( + vol_id = 1, + record_id, + metric_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer.} + +\item{metric_id}{Numeric metric identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} if the measure was successfully deleted, \code{FALSE} +otherwise. Deletion will fail for required metrics. +} +\description{ +Delete a single measure from a record. Note that the backend +will reject attempts to delete measures for required metrics. +} +\examples{ +\donttest{ +\dontrun{ +# Delete a measure +delete_record_measure( + vol_id = 1, + record_id = 123, + metric_id = 5 +) + +# Delete with verbose output +delete_record_measure( + vol_id = 1, + record_id = 123, + metric_id = 5, + vb = TRUE +) +} +} +} diff --git a/man/delete_session.Rd b/man/delete_session.Rd new file mode 100644 index 00000000..9c073b2f --- /dev/null +++ b/man/delete_session.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/delete_session.R +\name{delete_session} +\alias{delete_session} +\title{Delete Session from Databrary Volume} +\usage{ +delete_session(vol_id = 1, session_id, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} if the session was successfully deleted, \code{FALSE} +otherwise. +} +\description{ +Delete (soft-delete) a session from a Databrary volume. The +session and its associated metadata are marked as deleted but not +permanently removed from the database. +} +\examples{ +\donttest{ +\dontrun{ +# Delete a session +delete_session(vol_id = 1, session_id = 42) + +# Delete with verbose output +delete_session(vol_id = 1, session_id = 42, vb = TRUE) +} +} +} diff --git a/man/delete_session_file.Rd b/man/delete_session_file.Rd new file mode 100644 index 00000000..8f62616d --- /dev/null +++ b/man/delete_session_file.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/delete_session_file.R +\name{delete_session_file} +\alias{delete_session_file} +\title{Delete a Session File from a Databrary Volume} +\usage{ +delete_session_file( + vol_id = 1, + session_id, + file_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{file_id}{Numeric file identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} if the file was successfully deleted, \code{FALSE} +otherwise. +} +\description{ +Delete (soft-delete) a file from a Databrary session. The file +is marked as deleted on the server but not permanently removed. A second +delete on the same file returns \code{FALSE}, not an error. +} +\examples{ +\donttest{ +\dontrun{ +delete_session_file(vol_id = 1, session_id = 42, file_id = 99) +} +} +} +\seealso{ +\code{\link{update_session_file}}, \code{\link{patch_session_file}}, +\code{\link{get_session_file}} +} diff --git a/man/delete_volume_record.Rd b/man/delete_volume_record.Rd new file mode 100644 index 00000000..9be5776a --- /dev/null +++ b/man/delete_volume_record.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/delete_volume_record.R +\name{delete_volume_record} +\alias{delete_volume_record} +\title{Delete Record from Databrary Volume} +\usage{ +delete_volume_record(vol_id = 1, record_id, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} if the record was successfully deleted, \code{FALSE} +otherwise. +} +\description{ +Delete (soft-delete) a record from a Databrary volume. The +record and its measures are marked as deleted but not permanently removed +from the database. +} +\examples{ +\donttest{ +\dontrun{ +# Delete a record +delete_volume_record(vol_id = 1, record_id = 123) + +# Delete with verbose output +delete_volume_record(vol_id = 1, record_id = 123, vb = TRUE) +} +} +} diff --git a/man/disable_volume_category.Rd b/man/disable_volume_category.Rd new file mode 100644 index 00000000..103e0176 --- /dev/null +++ b/man/disable_volume_category.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/disable_volume_category.R +\name{disable_volume_category} +\alias{disable_volume_category} +\title{Disable a Category for a Volume} +\usage{ +disable_volume_category( + vol_id = 1, + category_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{category_id}{Numeric category identifier to disable.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} on success (or if not currently enabled), \code{NULL} +on failure. +} +\description{ +Remove a single category from a volume's enabled set. +Other enabled categories are preserved. No-op if the category is not +currently enabled. +} +\examples{ +\donttest{ +\dontrun{ +disable_volume_category(vol_id = 1, category_id = 1) +} +} +} diff --git a/man/download_folder_asset.Rd b/man/download_folder_asset.Rd new file mode 100644 index 00000000..c662673b --- /dev/null +++ b/man/download_folder_asset.Rd @@ -0,0 +1,59 @@ +% 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 = 9807, + asset_id = 1, + file_name = "video.mp4", + 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 9807, +the Materials folder for Volume 1.} + +\item{asset_id}{Integer. Asset identifier within the folder. Default is 1, a +demo video called 'counting_demo_video.mp4'.} + +\item{file_name}{Optional character string. File name to use when saving the +asset. Defaults to the API-provided file name.} + +\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 feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Default is \code{NULL}, in which case a +default authenticated request is generated.} +} +\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 = 9807, asset_id = 1, + file_name = "video.mp4") +} +} + +} diff --git a/man/download_folder_asset_from_df.Rd b/man/download_folder_asset_from_df.Rd new file mode 100644 index 00000000..f1f9f710 --- /dev/null +++ b/man/download_folder_asset_from_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_folder_asset_from_df} +\alias{download_folder_asset_from_df} +\title{Download a Single Folder Asset From a Data Frame Row.} +\usage{ +download_folder_asset_from_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 feedback. Defaults to \code{options::opt("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_folder_assets_fr_df.Rd b/man/download_folder_assets_fr_df.Rd new file mode 100644 index 00000000..3dba7e00 --- /dev/null +++ b/man/download_folder_assets_fr_df.Rd @@ -0,0 +1,60 @@ +% 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. Defaults to the result +of \code{list_folder_assets(vol_id = 1)}. Explicit \code{NULL} triggers the same +call using the current \code{vb} and \code{rq}.} + +\item{target_dir}{Character string. Base directory for downloads. Defaults to +\code{tempdir()}.} + +\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 feedback. Defaults to \code{options::opt("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..09ff1eab --- /dev/null +++ b/man/download_folder_zip.Rd @@ -0,0 +1,43 @@ +% 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 = 9807, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Volume identifier for the folder. Must be a positive integer. +Default is 1.} + +\item{folder_id}{Folder identifier scoped within the specified volume. Must +be a positive integer. Default is 9807.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Default is \code{NULL}, in which case a +default authenticated request is generated.} +} +\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() # Volume 1, folder 9807 +} +} + +} 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..5e9fccf3 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{vb}{Show verbose feedback. Defaults to \code{options::opt("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_asset_from_df.Rd b/man/download_session_asset_from_df.Rd new file mode 100644 index 00000000..9253a26d --- /dev/null +++ b/man/download_session_asset_from_df.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/download_single_session_asset_fr_df.R +\name{download_session_asset_from_df} +\alias{download_session_asset_from_df} +\title{Download a Single Asset From a Session Data Frame Row.} +\usage{ +download_session_asset_from_df( + i = NULL, + session_df = NULL, + target_dir = tempdir(), + add_session_subdir = TRUE, + overwrite = TRUE, + make_portable_fn = FALSE, + timeout_secs = REQUEST_TIMEOUT_VERY_LONG, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{i}{Integer. Index of the asset within \code{session_df}.} + +\item{session_df}{Data frame containing asset metadata.} + +\item{target_dir}{Base directory for downloads.} + +\item{add_session_subdir}{Logical. When \code{TRUE}, creates a subdirectory per +session 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 feedback. Defaults to \code{options::opt("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_session_assets_fr_df()} to fetch a single asset via +the signed-download workflow. +} diff --git a/man/download_session_assets_fr_df.Rd b/man/download_session_assets_fr_df.Rd index f9548650..edfcb2e4 100644 --- a/man/download_session_assets_fr_df.Rd +++ b/man/download_session_assets_fr_df.Rd @@ -2,10 +2,10 @@ % 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(), + session_df = list_session_assets(session_id = 9224, vol_id = 1), target_dir = tempdir(), add_session_subdir = TRUE, overwrite = TRUE, @@ -16,44 +16,44 @@ 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. Defaults to the result +of \code{list_session_assets(session_id = 9224, vol_id = 1)}. Explicit \code{NULL} +triggers the same call using the current \code{vb} and \code{rq}.} -\item{target_dir}{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{vb}{Show verbose feedback. Defaults to \code{options::opt("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 = 9224) +download_session_assets_fr_df(assets, vb = TRUE) } } } diff --git a/man/download_session_csv.Rd b/man/download_session_csv.Rd index 039448f3..6d67cc74 100644 --- a/man/download_session_csv.Rd +++ b/man/download_session_csv.Rd @@ -2,46 +2,45 @@ % 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 2.} -\item{file_name}{A character string. Name for the output file. -Default is 'test.csv'.} +\item{session_id}{Optional integer. When provided, requests a session-level +CSV export. When \code{NULL}, a volume-level CSV export is requested. Default is +9.} -\item{target_dir}{A character string. Directory to save downloaded file. -Default is \code{tempdir()}.} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} -\item{as_df}{A logical value. Convert the data from a list to a data frame. -Default is FALSE.} - -\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() # CSV for default volume 2 + +# Request a session-specific CSV export +download_session_csv(vol_id = 2, session_id = 9) } } diff --git a/man/download_session_zip.Rd b/man/download_session_zip.Rd index c7c5c9b0..a53f0902 100644 --- a/man/download_session_zip.Rd +++ b/man/download_session_zip.Rd @@ -2,40 +2,41 @@ % 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. Must be a positive +integer. Default is 31.} -\item{session_id}{Slot/session number.} +\item{session_id}{Session identifier within the volume. Must be a positive +integer. Default is 9803.} -\item{out_dir}{Directory to save output file.} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} -\item{file_name}{Name for downloaded file, default is 'test.zip'.} - -\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_session_asset_fr_df.Rd b/man/download_single_session_asset_fr_df.Rd deleted file mode 100644 index 72d3a795..00000000 --- a/man/download_single_session_asset_fr_df.Rd +++ /dev/null @@ -1,69 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/download_single_session_asset_fr_df.R -\name{download_single_session_asset_fr_df} -\alias{download_single_session_asset_fr_df} -\title{Download Single Asset From Databrary} -\usage{ -download_single_session_asset_fr_df( - i = NULL, - session_df = NULL, - target_dir = tempdir(), - add_session_subdir = TRUE, - overwrite = TRUE, - make_portable_fn = FALSE, - timeout_secs = REQUEST_TIMEOUT_VERY_LONG, - vb = options::opt("vb"), - rq = NULL -) -} -\arguments{ -\item{i}{An integer. Index into a row of the session asset data frame. -Default is NULL.} - -\item{session_df}{A row from a data frame from \code{list_session_assets()} -or \code{list_volume_assets()}. Default is NULL>} - -\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{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{overwrite}{A logical value. Overwrite an existing file. Default is TRUE.} - -\item{make_portable_fn}{A logical value. Replace characters in file names -that are not broadly portable across file systems. Default is FALSE.} - -\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{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.} -} -\value{ -Full file name to the asset or NULL. -} -\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) - -} -} -} diff --git a/man/download_video.Rd b/man/download_video.Rd index f958cf82..a48eebe1 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{vb}{Show verbose feedback. Defaults to \code{options::opt("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..1bfc95ed 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{vol_id}{An integer. Volume identifier. Default is 31.} -\item{out_dir}{Directory to save output file.} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} -\item{file_name}{Name for downloaded file, default is 'test.mp4'.} - -\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/enable_volume_category.Rd b/man/enable_volume_category.Rd new file mode 100644 index 00000000..fbaf96cb --- /dev/null +++ b/man/enable_volume_category.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/enable_volume_category.R +\name{enable_volume_category} +\alias{enable_volume_category} +\title{Enable a Category for a Volume} +\usage{ +enable_volume_category( + vol_id = 1, + category_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{category_id}{Numeric category identifier to enable.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} on success (or if already enabled), \code{NULL} on +failure. +} +\description{ +Add a single category to a volume's enabled set. This is +additive -- existing enabled categories are preserved. No-op if the +category is already enabled. +} +\examples{ +\donttest{ +\dontrun{ +enable_volume_category(vol_id = 1, category_id = 1) +} +} +} diff --git a/man/get_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..ff27efda --- /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 feedback. Defaults to \code{options::opt("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_db_stats.Rd b/man/get_db_stats.Rd index 7011ec67..369672ff 100644 --- a/man/get_db_stats.Rd +++ b/man/get_db_stats.Rd @@ -2,14 +2,14 @@ % Please edit documentation in R/get_db_stats.R \name{get_db_stats} \alias{get_db_stats} -\title{Get Stats About Databrary.} +\title{Get Stats About Databrary} \usage{ get_db_stats(type = "stats", vb = options::opt("vb"), rq = NULL) } \arguments{ \item{type}{Type of Databrary report to run "institutions", "people", "data"} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose messages. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object.} } @@ -18,14 +18,12 @@ A data frame with the requested data or NULL if there is no new information. } \description{ -\code{get_db_stats} returns basic summary information about -the institutions, people, and data hosted on 'Databrary.org'. +Returns basic summary information about +the institutions, people, and video data hosted on Databrary. } \examples{ -\donttest{ +\dontrun{ get_db_stats() get_db_stats("stats") -get_db_stats("people") # Information about the newest authorized investigators. -get_db_stats("places") # Information about the newest institutions. } } diff --git a/man/get_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..e42bb1e1 --- /dev/null +++ b/man/get_folder_by_id.Rd @@ -0,0 +1,37 @@ +% 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 = 9807, + vol_id = 1, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{folder_id}{Folder identifier within the specified volume. Default is +9807, the Materials folder for Volume 1.} + +\item{vol_id}{Volume identifier containing the folder. Default is 1.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list 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..522d5cda --- /dev/null +++ b/man/get_folder_file.Rd @@ -0,0 +1,44 @@ +% 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 = 1, + 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. Default is 1.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An httr2 request object.} +} +\value{ +A JSON blob with the file data. If the user has previously logged +in to Databrary via \code{login_db()}, then files that have restricted access +can be downloaded, subject to the sharing release levels on those files. +} +\description{ +Databrary volumes have folders where study or collection-wide files +can be stored and shared. \code{get_folder_file()} returns metadata about +specific files stored in a volume folder. +} +\examples{ +\donttest{ +\dontrun{ +get_folder_file() # Data about file_id 1 from folder_id 9807 in Volume 1. +get_folder_file(vol_id = 2, folder_id = 9819, file_id = 16) # A PDF from Volume 2. +} +} +} diff --git a/man/get_funder_by_id.Rd b/man/get_funder_by_id.Rd new file mode 100644 index 00000000..a063202c --- /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 feedback. Defaults to \code{options::opt("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..91cbb58f --- /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 feedback. Defaults to \code{options::opt("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..a36c5328 --- /dev/null +++ b/man/get_institution_by_id.Rd @@ -0,0 +1,21 @@ +% 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. Must be a positive integer.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +List of institution metadata or NULL when inaccessible. +} +\description{ +Get institution metadata +} diff --git a/man/get_institution_statistics.Rd b/man/get_institution_statistics.Rd new file mode 100644 index 00000000..3dbc772d --- /dev/null +++ b/man/get_institution_statistics.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_institution_statistics.R +\name{get_institution_statistics} +\alias{get_institution_statistics} +\title{Get statistics for an institution} +\usage{ +get_institution_statistics( + institution_id = 1, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{institution_id}{Institution identifier. Must be a positive integer.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with institution statistics including: +\itemize{ +\item \code{institution_id}: The institution identifier +\item \code{volumes_number}: Number of volumes +\item \code{files_number}: Number of files +\item \code{uploaded_data_footprint}: Size of uploaded data in bytes +\item \code{transcoded_data_footprint}: Size of transcoded data in bytes +\item \code{soft_deleted_uploaded_data_footprint}: Size of soft-deleted uploaded data +\item \code{soft_deleted_transcoded_data_footprint}: Size of soft-deleted transcoded data +\item \code{created_at}: Timestamp when statistics were created +\item \code{updated_at}: Timestamp when statistics were last updated +Returns NULL when statistics have not been computed or institution is not found. +} +} +\description{ +Retrieve aggregated statistics for an institution including volume count, +file count, and data footprints. Returns NULL (204 No Content) when +statistics have not been computed yet. +} diff --git a/man/get_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_by_id.Rd b/man/get_session_by_id.Rd index 0648ee79..500aad0d 100644 --- a/man/get_session_by_id.Rd +++ b/man/get_session_by_id.Rd @@ -5,7 +5,7 @@ \title{Get Session (Slot) Data From A Databrary Volume} \usage{ get_session_by_id( - session_id = 9807, + session_id = 6256, vol_id = 1, vb = options::opt("vb"), rq = NULL @@ -13,11 +13,11 @@ get_session_by_id( } \arguments{ \item{session_id}{An integer indicating a valid session/slot identifier -linked to a volume. Default value is 9807, the materials folder for volume 1.} +linked to a volume. Default value is 6256 in volume 1.} \item{vol_id}{An integer indicating the volume identifier. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An httr2 request object.} } diff --git a/man/get_session_by_name.Rd b/man/get_session_by_name.Rd index 9ef0b913..9117ddd9 100644 --- a/man/get_session_by_name.Rd +++ b/man/get_session_by_name.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/get_session_by_name.R \name{get_session_by_name} \alias{get_session_by_name} -\title{Get Session (Slot) Data From A Databrary Volume By Session Name.} +\title{Get Session Data From A Databrary Volume By Session Name.} \usage{ get_session_by_name( session_name = "Advisory Board Meeting", @@ -15,9 +15,9 @@ get_session_by_name( \item{session_name}{A string. The name of the target session. Defaults to "Advisory Board Meeting", the name of several of the sessions in the public Volume 1.} -\item{vol_id}{An integer indicating the volume identifier. Default is 1.} +\item{vol_id}{Volume identifier. Must be an integer. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An httr2 request, such as that generated by \code{make_default_request()}.} } @@ -26,7 +26,7 @@ One or more JSON blobs (as lists) whose session name(s) match \code{name} in the given volume. } \description{ -Get Session (Slot) Data From A Databrary Volume By Session Name. +Get Session Data From A Databrary Volume By Session Name. } \examples{ \donttest{ diff --git a/man/get_session_file.Rd b/man/get_session_file.Rd new file mode 100644 index 00000000..86493e21 --- /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 = 9578, + file_id = 27227, + 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 9578.} + +\item{file_id}{An integer indicating the file identifier. The default is +27227.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An httr2 request object.} +} +\value{ +Metadata about the file if the user has read privileges. +} +\description{ +Get Session File Data From A Databrary Volume +} +\examples{ +\donttest{ +\dontrun{ +get_session_file(vol_id = 2, session_id = 11, file_id = 3) +# A video from volume 1, session 11. +} +} +} diff --git a/man/get_supported_file_types.Rd b/man/get_supported_file_types.Rd index 428f008a..9f004d4f 100644 --- a/man/get_supported_file_types.Rd +++ b/man/get_supported_file_types.Rd @@ -16,7 +16,7 @@ A data frame with the file types permitted on Databrary. Extracts File Types Supported by Databrary. } \examples{ -\donttest{ +\dontrun{ get_supported_file_types() } diff --git a/man/get_tag_by_id.Rd b/man/get_tag_by_id.Rd new file mode 100644 index 00000000..74381393 --- /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 feedback. Defaults to \code{options::opt("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_upload_status.Rd b/man/get_upload_status.Rd new file mode 100644 index 00000000..c1ed07bb --- /dev/null +++ b/man/get_upload_status.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_upload_status.R +\name{get_upload_status} +\alias{get_upload_status} +\title{Get the Current Status of an Upload} +\usage{ +get_upload_status( + status_url = NULL, + upload_guid = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{status_url}{Absolute URL returned by \code{initiate_upload()} under +\code{status_url}. Mutually exclusive with \code{upload_guid}.} + +\item{upload_guid}{Character upload GUID. Mutually exclusive with +\code{status_url}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A length-1 character string with the status (e.g. +\code{"scanning"}, \code{"completed"}, \code{"infected"}, +\code{"upload_failed"}, \code{"processing_failed"} on the AWS +deployment; raw \code{Upload.status} on the core deployment). Returns +\code{NULL} if the request fails. +} +\description{ +Poll the Databrary API for the lifecycle state of an upload +started with \code{\link{initiate_upload}}. The returned status reflects +both the storage-side transfer and the post-upload server pipeline +(e.g. virus scan, format probe). + +Accepts either the absolute \code{status_url} returned by +\code{initiate_upload()} (preferred -- avoids a second URL build) or +the upload's \code{upload_guid}. +} +\examples{ +\donttest{ +\dontrun{ +init <- initiate_upload( + filename = "clip.mp4", + destination_type = "session", + object_id = 42 +) +get_upload_status(status_url = init$status_url) +} +} +} +\seealso{ +\code{\link{initiate_upload}}, \code{\link{upload_file}} +} diff --git a/man/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..dad3bbc9 --- /dev/null +++ b/man/get_user_by_id.Rd @@ -0,0 +1,21 @@ +% 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. Must be a positive integer. Default is 6.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the user's public metadata. +} +\description{ +Get public profile information for a Databrary user +} diff --git a/man/get_user_statistics.Rd b/man/get_user_statistics.Rd new file mode 100644 index 00000000..930f1b9f --- /dev/null +++ b/man/get_user_statistics.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_user_statistics.R +\name{get_user_statistics} +\alias{get_user_statistics} +\title{Get statistics for a user} +\usage{ +get_user_statistics(user_id, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{user_id}{User identifier. Must be a positive integer.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with user statistics including: +\itemize{ +\item \code{user_id}: The user identifier +\item \code{volumes_number}: Number of volumes +\item \code{files_number}: Number of files +\item \code{uploaded_data_footprint}: Size of uploaded data in bytes +\item \code{transcoded_data_footprint}: Size of transcoded data in bytes +\item \code{soft_deleted_uploaded_data_footprint}: Size of soft-deleted uploaded data +\item \code{soft_deleted_transcoded_data_footprint}: Size of soft-deleted transcoded data +\item \code{created_at}: Timestamp when statistics were created +\item \code{updated_at}: Timestamp when statistics were last updated +Returns NULL when statistics have not been computed or user is not found. +} +} +\description{ +Retrieve aggregated statistics for a user including volume count, +file count, and data footprints. Returns NULL (204 No Content) when +statistics have not been computed yet. +} diff --git a/man/get_volume_by_id.Rd b/man/get_volume_by_id.Rd index 01d71a72..6b24e545 100644 --- a/man/get_volume_by_id.Rd +++ b/man/get_volume_by_id.Rd @@ -7,9 +7,9 @@ get_volume_by_id(vol_id = 1, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vol_id}{Volume ID.} +\item{vol_id}{Volume ID. Must be a positive integer. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. If NULL (the default), a new request is generated using \code{make_default_request()}. To access restricted data, @@ -22,7 +22,7 @@ A tibble with summary information about a volume. Get Summary Data About A Databrary Volume } \examples{ -\donttest{ +\dontrun{ get_volume_by_id() # Default is Volume 1 } diff --git a/man/get_volume_collaborator_by_id.Rd b/man/get_volume_collaborator_by_id.Rd new file mode 100644 index 00000000..9cfeda45 --- /dev/null +++ b/man/get_volume_collaborator_by_id.Rd @@ -0,0 +1,46 @@ +% 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. Default is 1.} + +\item{collaborator_id}{Numeric collaborator identifier. +Must be a positive integer. Default is 1.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the 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_enabled_categories.Rd b/man/get_volume_enabled_categories.Rd new file mode 100644 index 00000000..ee849c40 --- /dev/null +++ b/man/get_volume_enabled_categories.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_volume_enabled_categories.R +\name{get_volume_enabled_categories} +\alias{get_volume_enabled_categories} +\title{Get Enabled Categories for a Volume} +\usage{ +get_volume_enabled_categories(vol_id = 1, vb = options::opt("vb"), rq = NULL) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list of category objects (each with \code{id}, \code{name}, +\code{metrics}, etc.), or \code{NULL} if the volume is not found. +} +\description{ +Retrieve the list of categories currently enabled for a +Databrary volume. Returns the \code{enabled_categories} field from the +volume detail endpoint. +} +\examples{ +\donttest{ +\dontrun{ +get_volume_enabled_categories(vol_id = 1) +} +} +} diff --git a/man/get_volume_record_by_id.Rd b/man/get_volume_record_by_id.Rd new file mode 100644 index 00000000..63ba2740 --- /dev/null +++ b/man/get_volume_record_by_id.Rd @@ -0,0 +1,47 @@ +% 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. Default is 1.} + +\item{record_id}{Numeric record identifier. Must be a positive integer. Default is 1.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list aligned with the API record payload: \code{record_id}, \code{record_volume}, +\code{record_volume_name}, \code{record_category_id}, \code{measures}, \code{birthday}, \code{age}, +\code{default_sessions} (session ids/names where this record is a default), +\code{record_source_kind} (linked-content provenance, e.g. \code{native}, +\code{source_linked_file}). \code{record_volume} may differ from \code{vol_id} for linked +records. Returns \code{NULL} if the record is not found or inaccessible. +} +\description{ +Retrieve detailed information about a specific record +(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/initiate_upload.Rd b/man/initiate_upload.Rd new file mode 100644 index 00000000..03e27b33 --- /dev/null +++ b/man/initiate_upload.Rd @@ -0,0 +1,83 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/initiate_upload.R +\name{initiate_upload} +\alias{initiate_upload} +\title{Initiate a File Upload} +\usage{ +initiate_upload( + filename, + destination_type, + object_id, + file_size = NULL, + content_type = NULL, + source_session_id = NULL, + source_folder_id = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{filename}{Display filename. Required, non-empty.} + +\item{destination_type}{Where the upload will live. One of +\code{"session"}, \code{"folder"}, \code{"linked_volume_session"}, +\code{"linked_volume_folder"} (server validates). Required.} + +\item{object_id}{Positive integer ID of the destination object (session +or folder, depending on \code{destination_type}). Required.} + +\item{file_size}{File size in bytes. Optional but strongly recommended: +the AWS deployment uses this to decide multipart vs single PUT.} + +\item{content_type}{MIME type of the file (e.g. \code{"video/mp4"}). +Optional but recommended; some storage backends require it.} + +\item{source_session_id}{Required when +\code{destination_type == "linked_volume_session"}; positive integer.} + +\item{source_folder_id}{Required when +\code{destination_type == "linked_volume_folder"}; positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A named list describing the upload. Always contains +\code{status_url}. For a single PUT (the on-prem core deployment, or +any AWS upload smaller than the multipart threshold), contains +\code{signed_upload_url} and \code{required_headers} (may be empty). +For a multipart upload, contains \code{upload_type = "multipart"}, +\code{upload_guid}, \code{s3_upload_id}, \code{part_urls} (a list of +\code{list(part_number, url)}), and \code{part_size}. Returns +\code{NULL} if the request fails. +} +\description{ +Ask the Databrary API to register a pending upload and return +the signed URL(s) needed to PUT file bytes directly to object storage. The +server decides whether to issue a single-PUT or a multipart upload based on +\code{file_size} and the deployment's storage backend (S3 multipart on the +AI/AWS deployment, single PUT on the on-prem core deployment). + +This is the first step of the upload pipeline; pass the returned object to +\code{\link{upload_file}} (high level) or use the returned URLs directly +with \code{httr2::req_perform()} for fine-grained control. +} +\examples{ +\donttest{ +\dontrun{ +# Initiate a small upload to a session +init <- initiate_upload( + filename = "clip_001.mp4", + destination_type = "session", + object_id = 42, + file_size = 1024L * 1024L, + content_type = "video/mp4" +) +} +} +} +\seealso{ +\code{\link{upload_file}}, \code{\link{get_upload_status}}, +\code{\link{complete_upload}} +} diff --git a/man/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_asset_formats.Rd b/man/list_asset_formats.Rd index c41f2c24..4101da61 100644 --- a/man/list_asset_formats.Rd +++ b/man/list_asset_formats.Rd @@ -7,17 +7,17 @@ list_asset_formats(vb = options::opt("vb")) } \arguments{ -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} } \value{ A data frame with information about the data formats Databrary supports. } \description{ -List Stored Assets (Files) By Type. +List the data (file) formats supported by Databrary. } \examples{ -\donttest{ +\dontrun{ list_asset_formats() } } diff --git a/man/list_authorized_investigators.Rd b/man/list_authorized_investigators.Rd index 6a70cbb3..226dbc8a 100644 --- a/man/list_authorized_investigators.Rd +++ b/man/list_authorized_investigators.Rd @@ -2,33 +2,24 @@ % 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. Must be a positive integer. Default is 12.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} -\item{rq}{An \code{httr2}-style request object. If NULL, then a new request will -be generated using \code{make_default_request()}.} +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} } \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) -} -} +Lists the authorized investigators at an institution. } diff --git a/man/list_categories.Rd b/man/list_categories.Rd new file mode 100644 index 00000000..2a1aed90 --- /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 feedback. Defaults to \code{options::opt("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..c18d9e88 --- /dev/null +++ b/man/list_folder_assets.Rd @@ -0,0 +1,38 @@ +% 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 = 9807, + vol_id = 1, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{folder_id}{Folder identifier scoped to the given volume. Must be a +positive integer. Default is 9807.} + +\item{vol_id}{Volume containing the folder. Required for Django API calls. +Must be a positive integer. Default is 1.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("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..9d99750d --- /dev/null +++ b/man/list_institution_affiliates.Rd @@ -0,0 +1,25 @@ +% 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. Must be a positive integer. Default is 12.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +Tibble of affiliates with roles and expiration dates. +} +\description{ +List affiliates for an institution +} diff --git a/man/list_institutions.Rd b/man/list_institutions.Rd new file mode 100644 index 00000000..9a8facf7 --- /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 feedback. Defaults to \code{options::opt("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 deleted file mode 100644 index a6c4a7aa..00000000 --- a/man/list_session_activity.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/list_session_activity.R -\name{list_session_activity} -\alias{list_session_activity} -\title{List Activity History in Databrary Session.} -\usage{ -list_session_activity(session_id = 6256, vb = options::opt("vb"), rq = NULL) -} -\arguments{ -\item{session_id}{Selected session/slot 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 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)}} -} -\value{ -A list with the activity history on a session/slot. -} -\description{ -If a user has access to a volume and session, this function returns the -history of modifications to that session. -} -\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) -} -} -} diff --git a/man/list_session_assets.Rd b/man/list_session_assets.Rd index 8c66f670..f3c6f69d 100644 --- a/man/list_session_assets.Rd +++ b/man/list_session_assets.Rd @@ -4,13 +4,22 @@ \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{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\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 feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. If NULL, a default request is generated from databraryr::make_default_request().} diff --git a/man/list_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..1b490647 --- /dev/null +++ b/man/list_user_affiliates.Rd @@ -0,0 +1,21 @@ +% 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. Must be an integer. Default is 6.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +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..80e08dd1 --- /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. Must be a positive integer. Default is 22582.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("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..d7f5300e --- /dev/null +++ b/man/list_user_sponsors.Rd @@ -0,0 +1,21 @@ +% 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')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\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..b0097b9b --- /dev/null +++ b/man/list_user_volumes.Rd @@ -0,0 +1,21 @@ +% 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. Must be a positive integer. Default is 6.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Default is NULL.} +} +\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..ebb5d858 --- /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 feedback. Defaults to \code{options::opt("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..0b6e2905 100644 --- a/man/list_volume_activity.Rd +++ b/man/list_volume_activity.Rd @@ -4,12 +4,12 @@ \alias{list_volume_activity} \title{List Activity In A Databrary Volume} \usage{ -list_volume_activity(vol_id = 1, vb = options::opt("vb"), rq = NULL) +list_volume_activity(vol_id = NULL, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vol_id}{Selected volume number.} +\item{vol_id}{Selected volume number. Must be a positive integer. Default is NULL.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Defaults to NULL.} } @@ -18,15 +18,15 @@ A list with the activity history on a volume. } \description{ If a user has access to a volume, this command lists the modification -history of the volume as a +history of the volume. } \examples{ \donttest{ \dontrun{ -# The following will only return output if the user has write privileges +# The following will only return output if the user has *write* privileges # on the volume. -list_volume_activity(vol_id = 1) # Activity on volume 1. +list_volume_activity(vol_id) } } } diff --git a/man/list_volume_assets.Rd b/man/list_volume_assets.Rd index 90cc2518..a12c2b5b 100644 --- a/man/list_volume_assets.Rd +++ b/man/list_volume_assets.Rd @@ -7,14 +7,16 @@ list_volume_assets(vol_id = 1, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vol_id}{Target volume number. Default is 1.} +\item{vol_id}{Target volume number. Must be a positive integer. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Default is NULL.} } \value{ -A data frame with information about all assets in a volume. +A tibble with one row per asset. Columns \code{asset_duration} and +\code{asset_thumbnail_url} are always present (as \code{NA} when the API omits them). +Other fields come from the volume sessions/files payload. } \description{ List Assets in Databrary Volume. diff --git a/man/list_volume_collaborators.Rd b/man/list_volume_collaborators.Rd new file mode 100644 index 00000000..f6472ca4 --- /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. Must be a positive integer. Default is 1.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("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..907b14f1 --- /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. Must be a positive integer. Default is 1.} + +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("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_funding.Rd b/man/list_volume_funding.Rd index de159b38..be9ff987 100644 --- a/man/list_volume_funding.Rd +++ b/man/list_volume_funding.Rd @@ -17,7 +17,7 @@ list_volume_funding( \item{add_id}{A logical value. Include the volume ID in the output. Default is TRUE.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object.} } diff --git a/man/list_volume_info.Rd b/man/list_volume_info.Rd index eac7eb90..22b7ade3 100644 --- a/man/list_volume_info.Rd +++ b/man/list_volume_info.Rd @@ -7,11 +7,11 @@ list_volume_info(vol_id = 1, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vol_id}{Target volume number.} +\item{vol_id}{Target volume number. Must be a positive integer. Defaults to 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} -\item{rq}{An \code{httr2} request object. If NULL (the default) +\item{rq}{An \code{httr2} request object. If NULL (the default). a request will be generated, but this will only permit public information to be returned.} } diff --git a/man/list_volume_links.Rd b/man/list_volume_links.Rd index a3e0dff3..5186c09b 100644 --- a/man/list_volume_links.Rd +++ b/man/list_volume_links.Rd @@ -7,9 +7,9 @@ list_volume_links(vol_id = 1, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vol_id}{Target volume number.} +\item{vol_id}{Target volume number. Must be a positive integer. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object.} } diff --git a/man/list_volume_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..02d8b6d6 --- /dev/null +++ b/man/list_volume_records.Rd @@ -0,0 +1,52 @@ +% 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 feedback. Defaults to \code{options::opt("vb")}.} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A tibble containing metadata for each record (aligned with core +\verb{RecordSerializer}): ids, owning volume (\code{record_volume}), owning volume +name (\code{record_volume_name}), category, measures, birthday, age columns, +default sessions (\code{record_default_sessions}, list column of \verb{id}/\verb{name}), +and linked-content provenance (\code{record_source_kind}). The \code{record_volume} +column may differ from \code{vol_id} when the volume lists linked records from +other volumes. Returns an empty tibble when the volume has no records, or +\code{NULL} when the API call fails (e.g. non-existent volume). +} +\description{ +Retrieve all records (participant data with measures) from a +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..95233cac 100644 --- a/man/list_volume_session_assets.Rd +++ b/man/list_volume_session_assets.Rd @@ -5,18 +5,18 @@ \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 ) } \arguments{ -\item{vol_id}{Target volume number.} +\item{vol_id}{Target volume number. Must be a positive integer.} \item{session_id}{The session number in the selected volume.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object.} } @@ -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_volume_sessions.Rd b/man/list_volume_sessions.Rd index 49bfe7eb..cca3796a 100644 --- a/man/list_volume_sessions.Rd +++ b/man/list_volume_sessions.Rd @@ -12,12 +12,12 @@ list_volume_sessions( ) } \arguments{ -\item{vol_id}{Target volume number.} +\item{vol_id}{Target volume number. Must be a positive integer. Default is 1.} \item{include_vol_data}{A Boolean value. Include volume-level metadata or not. Default is FALSE.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. If NULL (the default) a request will be generated, but this will only permit public information diff --git a/man/list_volume_tags.Rd b/man/list_volume_tags.Rd index 94611aef..dd8e68f7 100644 --- a/man/list_volume_tags.Rd +++ b/man/list_volume_tags.Rd @@ -7,9 +7,9 @@ list_volume_tags(vol_id = 1, vb = options::opt("vb"), rq = NULL) } \arguments{ -\item{vol_id}{Target volume number.} +\item{vol_id}{Target volume number. Must be a positive integer. Default is 1.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Default is NULL.} } @@ -20,7 +20,7 @@ A data frame with the requested data. Lists Keywords And Tags For A Volume. } \examples{ -\donttest{ +\dontrun{ list_volume_tags() } } diff --git a/man/list_volumes.Rd b/man/list_volumes.Rd new file mode 100644 index 00000000..17ca97fa --- /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 feedback. Defaults to \code{options::opt("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..9825446b 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 + service = KEYRING_SERVICE, + 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"} +\item{service}{A character label for stored credentials in the keyring. +Default is \code{org.databrary.databraryr}.} -\item{rq}{An \code{http} request object. Defaults to NULL.} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} } \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..5b02271e 100644 --- a/man/logout_db.Rd +++ b/man/logout_db.Rd @@ -4,12 +4,10 @@ \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')} - -\item{rq}{An \code{httr2} request object. Defaults to NULL.} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} } \value{ TRUE if logging out succeeds, FALSE otherwise. diff --git a/man/make_default_request.Rd b/man/make_default_request.Rd index ddb0d76b..2352cafb 100644 --- a/man/make_default_request.Rd +++ b/man/make_default_request.Rd @@ -2,16 +2,30 @@ % 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 feedback. Defaults to \code{options::opt("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() +make_default_request(with_token = FALSE) } diff --git a/man/make_login_client.Rd b/man/make_login_client.Rd index 5c2a26ea..88248f27 100644 --- a/man/make_login_client.Rd +++ b/man/make_login_client.Rd @@ -10,7 +10,7 @@ make_login_client( store = FALSE, overwrite = FALSE, vb = options::opt("vb"), - SERVICE = KEYRING_SERVICE, + service = KEYRING_SERVICE, rq = NULL ) } @@ -21,11 +21,12 @@ make_login_client( \item{store}{A boolean value. If TRUE store/retrieve credentials from the system keyring/keychain.} -\item{overwrite}{A boolean value. If TRUE and store is TRUE, overwrite/ update stored credentials in keyring/keychain.} +\item{overwrite}{A boolean value. If TRUE and store is TRUE, overwrite or +update stored credentials in keyring/keychain.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} -\item{SERVICE}{A character label for stored credentials in the keyring. Default is "databrary"} +\item{service}{A character label for stored credentials in the keyring. Default is "databrary"} \item{rq}{An \code{httr2} request object. Defaults to NULL.} } @@ -36,7 +37,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/patch_folder.Rd b/man/patch_folder.Rd new file mode 100644 index 00000000..9c0092de --- /dev/null +++ b/man/patch_folder.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/patch_folder.R +\name{patch_folder} +\alias{patch_folder} +\title{Partially Update a Folder in Databrary Volume} +\usage{ +patch_folder( + vol_id = 1, + folder_id, + name = NULL, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{folder_id}{Numeric folder identifier. Must be a positive integer.} + +\item{name}{Optional new folder name. If provided, must be a non-empty +length-1 string.} + +\item{release_level}{Optional release level (e.g. \code{"PRIVATE"}, +\code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). Server validates +the choice.} + +\item{source_date}{Optional folder date. A length-1 \code{Date} object or +ISO \code{"YYYY-MM-DD"} string.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the updated folder's metadata (same shape as +\code{\link{get_folder_by_id}}), or \code{NULL} if the update fails or +no fields were provided. +} +\description{ +Sends a PATCH request to update selected fields of an existing +folder. Only provided arguments are sent; omitted fields are left +unchanged on the server. The server rejects blanking out a previously +non-empty \code{name}. +} +\examples{ +\donttest{ +\dontrun{ +patch_folder(vol_id = 1, folder_id = 42, name = "Renamed folder") +} +} +} +\seealso{ +\code{\link{update_folder}}, \code{\link{create_folder}} +} diff --git a/man/patch_session.Rd b/man/patch_session.Rd new file mode 100644 index 00000000..fd925297 --- /dev/null +++ b/man/patch_session.Rd @@ -0,0 +1,83 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/patch_session.R +\name{patch_session} +\alias{patch_session} +\title{Partially Update a Session in Databrary Volume} +\usage{ +patch_session( + vol_id = 1, + session_id, + name = NULL, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + default_records = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{name}{Optional new session name. If provided, must be a non-empty +length-1 string.} + +\item{release_level}{Optional release level (e.g. \code{"PRIVATE"}, +\code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). Server validates +the choice.} + +\item{source_date}{Optional session date. A length-1 \code{Date} object or +ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}.} + +\item{date}{Optional structured date list with named fields \code{year}, +\code{month}, \code{day}, and optional \code{is_estimated} (logical). +Mutually exclusive with \code{source_date}.} + +\item{date_precision}{Optional precision for \code{date}: e.g. +\code{"FULL"}, \code{"YEAR"}.} + +\item{default_records}{Optional integer vector of record IDs. The server +replaces the session's current default records with this set.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the updated session's metadata (same shape as +\code{\link{get_session_by_id}}), or \code{NULL} if the update fails or +no fields were provided. +} +\description{ +Sends a PATCH request to update selected fields of an existing +session. Only provided arguments are sent; omitted fields are left +unchanged on the server. Note that \code{default_records} is a full +replacement on the server -- supplying it overwrites the entire current set +of defaults; omit it to keep them. To change just one default record use +\code{\link{add_default_record_to_session}} or +\code{\link{remove_default_record_from_session}}. +} +\examples{ +\donttest{ +\dontrun{ +# Rename a session +patch_session(vol_id = 1, session_id = 42, name = "Renamed session") + +# Update the date and precision +patch_session( + vol_id = 1, + session_id = 42, + date = list(year = 2024, month = 3, day = 15), + date_precision = "FULL" +) +} +} +} +\seealso{ +\code{\link{update_session}}, \code{\link{create_session}}, +\code{\link{add_default_record_to_session}}, +\code{\link{remove_default_record_from_session}} +} diff --git a/man/patch_session_file.Rd b/man/patch_session_file.Rd new file mode 100644 index 00000000..5866b20f --- /dev/null +++ b/man/patch_session_file.Rd @@ -0,0 +1,84 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/patch_session_file.R +\name{patch_session_file} +\alias{patch_session_file} +\title{Partially Update a Session File's Metadata} +\usage{ +patch_session_file( + vol_id = 1, + session_id, + file_id, + name = NULL, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + is_estimated = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{file_id}{Numeric file identifier. Must be a positive integer.} + +\item{name}{Optional new file name. If provided, must be a non-empty +length-1 string.} + +\item{release_level}{Optional release level (e.g. \code{"PRIVATE"}, +\code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}). Server validates +the choice.} + +\item{source_date}{Optional file date. A length-1 \code{Date} object or +ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}.} + +\item{date}{Optional structured date list with named fields \code{year}, +\code{month}, \code{day}, and optional \code{is_estimated} (logical). +Mutually exclusive with \code{source_date}.} + +\item{date_precision}{Optional precision for \code{date}: e.g. +\code{"FULL"}, \code{"YEAR"}.} + +\item{is_estimated}{Optional logical flag indicating whether the date is +estimated.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the updated file's metadata (same shape as +\code{\link{get_session_file}}), or \code{NULL} if the update fails or +no fields were provided. +} +\description{ +Sends a PATCH request to update selected metadata fields of an +existing session file. Only provided arguments are sent; omitted fields are +left unchanged on the server. +} +\examples{ +\donttest{ +\dontrun{ +# Rename a file +patch_session_file( + vol_id = 1, session_id = 42, file_id = 99, name = "Renamed.mp4" +) + +# Update the date and precision +patch_session_file( + vol_id = 1, + session_id = 42, + file_id = 99, + date = list(year = 2024, month = 3, day = 15), + date_precision = "FULL" +) +} +} +} +\seealso{ +\code{\link{update_session_file}}, \code{\link{delete_session_file}}, +\code{\link{get_session_file}} +} diff --git a/man/remove_default_record_from_session.Rd b/man/remove_default_record_from_session.Rd new file mode 100644 index 00000000..02340bd8 --- /dev/null +++ b/man/remove_default_record_from_session.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/remove_default_record_from_session.R +\name{remove_default_record_from_session} +\alias{remove_default_record_from_session} +\title{Remove a Default Record from a Session} +\usage{ +remove_default_record_from_session( + vol_id = 1, + session_id, + record_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} if the record was successfully removed, \code{FALSE} +otherwise. +} +\description{ +Detach a record from a session's default records. The record +must currently be a default record on the session, otherwise the server +returns \code{404}. +} +\examples{ +\donttest{ +\dontrun{ +remove_default_record_from_session(vol_id = 1, session_id = 42, record_id = 101) +} +} +} +\seealso{ +\code{\link{add_default_record_to_session}} +} diff --git a/man/resume_bulk.Rd b/man/resume_bulk.Rd new file mode 100644 index 00000000..217a7029 --- /dev/null +++ b/man/resume_bulk.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bulk_resume.R +\name{resume_bulk} +\alias{resume_bulk} +\title{Resume a Bulk Operation After a Failure} +\usage{ +resume_bulk(partial, fn, ..., input_arg = NULL) +} +\arguments{ +\item{partial}{A tibble produced by a previous \code{bulk_*} call (typically +extracted from a \code{databraryr_bulk_error} condition via +\code{conditionMessage} / direct access to \code{cond$partial}).} + +\item{fn}{The bulk function to re-invoke (e.g. \code{bulk_upload_files}).} + +\item{...}{Additional arguments forwarded to \code{fn} (for example +\code{vol_id}, \code{session_id}, \code{vb}, \code{rq}). The remaining +inputs are passed as the function's input vector argument under the name +\code{input_arg} (default: auto-detected from the function's formals).} + +\item{input_arg}{Optional name of the input argument of \code{fn}. If +\code{NULL} (default), it is inferred as the first formal of \code{fn} +matching one of \code{file_paths}, \code{session_ids}, \code{folder_ids}, +\code{file_ids}, \code{session_names}, \code{folder_names}, +\code{record_ids}, \code{record_names}.} +} +\value{ +A tibble of the same shape as \code{partial}, with rows from the +resumed run substituted in for previously incomplete rows. +} +\description{ +When a \code{bulk_*} run ends with incomplete rows (either +because \code{on_error = "stop"} threw \code{databraryr_bulk_error} or +because \code{on_error = "collect"} left \code{"failed"} / \code{"pending"} +rows), \code{resume_bulk()} re-runs the supplied bulk function on those rows +and merges the result, preserving original input order. +} +\details{ +If \code{fn} itself fast-fails (\code{on_error = "stop"}), the +re-thrown \code{databraryr_bulk_error}'s \code{$partial} is the \strong{full +accumulated tibble} (outcomes from all prior runs merged with the latest +attempt), so you can safely pass it back to \code{resume_bulk()} in a loop +without losing rows that already succeeded. +} +\examples{ +\donttest{ +\dontrun{ +result <- tryCatch( + bulk_upload_files( + vol_id = 1, session_id = 42, + file_paths = c("/tmp/a.mp4", "/tmp/b.mp4") + ), + databraryr_bulk_error = function(e) e$partial +) +# ... fix the failing file, then: +result <- resume_bulk(result, bulk_upload_files, + vol_id = 1, session_id = 42) +} +} +} +\seealso{ +\code{\link{bulk_upload_files}}, \code{\link{bulk_delete_sessions}}, +\code{\link{bulk_delete_folders}}, \code{\link{bulk_delete_files}}, +\code{\link{bulk_create_sessions}}, \code{\link{bulk_create_folders}}, +\code{\link{bulk_rename_sessions}}, \code{\link{bulk_rename_folders}}, +\code{\link{bulk_rename_files}}, \code{\link{bulk_create_records}}, +\code{\link{bulk_delete_records}}, \code{\link{bulk_assign_records}}, +\code{\link{bulk_unassign_records}} +} diff --git a/man/search_for_funder.Rd b/man/search_for_funder.Rd index c24edb55..e40c89b0 100644 --- a/man/search_for_funder.Rd +++ b/man/search_for_funder.Rd @@ -5,15 +5,19 @@ \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 ) } \arguments{ -\item{search_string}{String to search.} +\item{search_string}{String to search. Default is "national science foundation".} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\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 feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Default is NULL.} } @@ -24,7 +28,7 @@ A data frame with information about the funder. Report Information About A Funder. } \examples{ -\donttest{ +\dontrun{ search_for_funder("national+science+foundation") } 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_for_tags.Rd b/man/search_for_tags.Rd index 3880cba3..27a0db37 100644 --- a/man/search_for_tags.Rd +++ b/man/search_for_tags.Rd @@ -9,7 +9,7 @@ search_for_tags(search_string = "ICIS", vb = options::opt("vb"), rq = NULL) \arguments{ \item{search_string}{String to search.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +\item{vb}{Show verbose feedback. Defaults to \code{options::opt("vb")}.} \item{rq}{An \code{httr2} request object. Default is NULL.} } diff --git a/man/search_institutions.Rd b/man/search_institutions.Rd new file mode 100644 index 00000000..0c820309 --- /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 feedback. Defaults to \code{options::opt("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..0ff2079c --- /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 feedback. Defaults to \code{options::opt("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..f95df677 --- /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 feedback. Defaults to \code{options::opt("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/set_record_measure.Rd b/man/set_record_measure.Rd new file mode 100644 index 00000000..f4b67793 --- /dev/null +++ b/man/set_record_measure.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/set_record_measure.R +\name{set_record_measure} +\alias{set_record_measure} +\title{Set Measure for a Record} +\usage{ +set_record_measure( + vol_id = 1, + record_id, + metric_id, + value, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer.} + +\item{metric_id}{Numeric metric identifier. Must be a positive integer.} + +\item{value}{The measure value. Can be a string (for text metrics), a number +(for numeric metrics), or a list with \code{year}, \code{month}, \code{day}, +optional \code{month} and \code{day} fields (for date metrics).} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +The measure data on success, or \code{NULL} if the operation fails. +} +\description{ +Create or update a single measure for a record. This performs +an upsert operation - if the measure exists for this metric, it is updated; +otherwise, a new measure is created. +} +\examples{ +\donttest{ +\dontrun{ +# Set a text measure +set_record_measure( + vol_id = 1, + record_id = 123, + metric_id = 2, + value = "Female" +) + +# Set a numeric measure +set_record_measure( + vol_id = 1, + record_id = 123, + metric_id = 5, + value = 24.5 +) + +# Set a date measure +set_record_measure( + vol_id = 1, + record_id = 123, + metric_id = 4, + value = list(year = 2020, month = 3, day = 15) +) +} +} +} diff --git a/man/set_volume_enabled_categories.Rd b/man/set_volume_enabled_categories.Rd new file mode 100644 index 00000000..87498fd9 --- /dev/null +++ b/man/set_volume_enabled_categories.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/set_volume_enabled_categories.R +\name{set_volume_enabled_categories} +\alias{set_volume_enabled_categories} +\title{Set Enabled Categories for a Volume} +\usage{ +set_volume_enabled_categories( + vol_id = 1, + category_ids, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{category_ids}{Integer vector of category IDs to enable.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} on success, \code{NULL} on failure. +} +\description{ +Replace the full set of enabled categories for a Databrary +volume. This is a destructive replacement -- categories not in the provided +list will be disabled. Pass an empty vector to disable all categories. +} +\examples{ +\donttest{ +\dontrun{ +# Enable participant (1) and task (6) categories +set_volume_enabled_categories(vol_id = 1, category_ids = c(1, 6)) + +# Disable all categories +set_volume_enabled_categories(vol_id = 1, category_ids = integer(0)) +} +} +} diff --git a/man/unassign_record_from_file.Rd b/man/unassign_record_from_file.Rd new file mode 100644 index 00000000..20922c98 --- /dev/null +++ b/man/unassign_record_from_file.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/unassign_record_from_file.R +\name{unassign_record_from_file} +\alias{unassign_record_from_file} +\title{Unassign Record from Session File} +\usage{ +unassign_record_from_file( + vol_id = 1, + session_id, + file_id, + record_id, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{file_id}{Numeric file identifier. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +\code{TRUE} if the record was successfully unassigned, \code{FALSE} +otherwise. +} +\description{ +Remove the association between a record and a session file. +If the record is not assigned to the file, this operation will fail. +} +\examples{ +\donttest{ +\dontrun{ +# Unassign a record from a file +unassign_record_from_file( + vol_id = 1, + session_id = 10, + file_id = 20, + record_id = 123 +) +} +} +} diff --git a/man/update_folder.Rd b/man/update_folder.Rd new file mode 100644 index 00000000..8d759cae --- /dev/null +++ b/man/update_folder.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/update_folder.R +\name{update_folder} +\alias{update_folder} +\title{Replace a Folder in Databrary Volume (PUT)} +\usage{ +update_folder( + vol_id = 1, + folder_id, + name, + release_level = NULL, + source_date = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{folder_id}{Numeric folder identifier. Must be a positive integer.} + +\item{name}{New folder name. Required, non-empty after trim.} + +\item{release_level}{Optional release level (e.g. \code{"PRIVATE"}, +\code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}).} + +\item{source_date}{Optional folder date. A length-1 \code{Date} object or +ISO \code{"YYYY-MM-DD"} string.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the updated folder's metadata (same shape as +\code{\link{get_folder_by_id}}), or \code{NULL} if the update fails. +} +\description{ +Sends a PUT request to fully replace a folder's writable +fields. \code{name} is required (non-empty); other fields are optional and +default to server-side values when omitted (the underlying serializer +marks them \code{required=FALSE}). Use \code{\link{patch_folder}} for +partial updates when you don't want full-replacement semantics. +} +\examples{ +\donttest{ +\dontrun{ +update_folder(vol_id = 1, folder_id = 42, name = "Replacement name") +} +} +} +\seealso{ +\code{\link{patch_folder}}, \code{\link{create_folder}} +} diff --git a/man/update_session.Rd b/man/update_session.Rd new file mode 100644 index 00000000..c11a032c --- /dev/null +++ b/man/update_session.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/update_session.R +\name{update_session} +\alias{update_session} +\title{Replace a Session in Databrary Volume (PUT)} +\usage{ +update_session( + vol_id = 1, + session_id, + name, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + default_records = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{name}{New session name. Required, non-empty after trim.} + +\item{release_level}{Optional release level (e.g. \code{"PRIVATE"}, +\code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}).} + +\item{source_date}{Optional session date. A length-1 \code{Date} object or +ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}.} + +\item{date}{Optional structured date list with named fields \code{year}, +\code{month}, \code{day}, and optional \code{is_estimated} (logical). +Mutually exclusive with \code{source_date}.} + +\item{date_precision}{Optional precision for \code{date}: e.g. +\code{"FULL"}, \code{"YEAR"}.} + +\item{default_records}{Optional integer vector of record IDs. The server +replaces the session's current default records with this set; omit to +leave them unchanged.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the updated session's metadata (same shape as +\code{\link{get_session_by_id}}), or \code{NULL} if the update fails. +} +\description{ +Sends a PUT request to fully replace a session's writable +fields. \code{name} is required (non-empty); other fields are optional and +default to server-side values when omitted (the underlying serializer +marks them \code{required=FALSE}). Use \code{\link{patch_session}} for +partial updates when you don't want full-replacement semantics. +} +\examples{ +\donttest{ +\dontrun{ +# Rename a session via PUT +update_session(vol_id = 1, session_id = 42, name = "Replacement name") +} +} +} +\seealso{ +\code{\link{patch_session}}, \code{\link{create_session}} +} diff --git a/man/update_session_file.Rd b/man/update_session_file.Rd new file mode 100644 index 00000000..3e574c48 --- /dev/null +++ b/man/update_session_file.Rd @@ -0,0 +1,77 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/update_session_file.R +\name{update_session_file} +\alias{update_session_file} +\title{Replace a Session File's Metadata (PUT)} +\usage{ +update_session_file( + vol_id = 1, + session_id, + file_id, + name, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + is_estimated = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{session_id}{Numeric session identifier. Must be a positive integer.} + +\item{file_id}{Numeric file identifier. Must be a positive integer.} + +\item{name}{New file name. Required, non-empty after trim.} + +\item{release_level}{Optional release level (e.g. \code{"PRIVATE"}, +\code{"SHARED"}, \code{"EXCERPTS"}, \code{"PUBLIC"}).} + +\item{source_date}{Optional file date. A length-1 \code{Date} object or +ISO \code{"YYYY-MM-DD"} string. Mutually exclusive with \code{date}.} + +\item{date}{Optional structured date list with named fields \code{year}, +\code{month}, \code{day}, and optional \code{is_estimated} (logical). +Mutually exclusive with \code{source_date}.} + +\item{date_precision}{Optional precision for \code{date}: e.g. +\code{"FULL"}, \code{"YEAR"}.} + +\item{is_estimated}{Optional logical flag indicating whether the date is +estimated.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the updated file's metadata (same shape as +\code{\link{get_session_file}}), or \code{NULL} if the update fails. +} +\description{ +Sends a PUT request to fully replace a session file's writable +metadata fields. \code{name} is required (non-empty); other fields are +optional and default to server-side values when omitted. Use +\code{\link{patch_session_file}} for partial updates when you don't want +full-replacement semantics. +} +\examples{ +\donttest{ +\dontrun{ +# Rename a file via PUT +update_session_file( + vol_id = 1, + session_id = 42, + file_id = 99, + name = "Replacement name.mp4" +) +} +} +} +\seealso{ +\code{\link{patch_session_file}}, \code{\link{delete_session_file}}, +\code{\link{get_session_file}} +} diff --git a/man/update_volume_record.Rd b/man/update_volume_record.Rd new file mode 100644 index 00000000..a3d3d239 --- /dev/null +++ b/man/update_volume_record.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/update_volume_record.R +\name{update_volume_record} +\alias{update_volume_record} +\title{Update Record in Databrary Volume} +\usage{ +update_volume_record( + vol_id = 1, + record_id, + measures = NULL, + participant = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{vol_id}{Target volume number. Must be a positive integer.} + +\item{record_id}{Numeric record identifier. Must be a positive integer.} + +\item{measures}{Optional named list mapping metric IDs (as strings) to values. +Values can be strings (for text metrics), numbers (for numeric metrics), +or lists with \code{year} and optional \code{month}, \code{day} +fields (for date metrics). When supplied, must include all required metrics +for the record's category (use \code{\link{get_volume_enabled_categories}} +or \code{\link{get_volume_record_by_id}} to discover ids and current values).} + +\item{participant}{Optional list for participant records containing +\code{birthday} (with \code{year}, \code{month}, \code{day} fields) or +\code{age} (with \code{years}, \code{months}, \code{days} fields). Sending +only \code{participant} without a complete \code{measures} map may still +fail validation for categories with required metrics; include required +measures or use \code{\link{set_record_measure}} for targeted edits.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A list with the updated record's metadata (same shape as +\code{\link{get_volume_record_by_id}}), or \code{NULL} if update fails. +} +\description{ +Sends a PATCH request to update a record. The HTTP method is +partial in principle, but the API validates \code{measures} as a complete +snapshot of \strong{required} metrics for the record's category: every +required metric must appear in \code{measures}, or the server returns +\code{400} (\verb{Missing required measures...}). The server then replaces +stored values for each metric key you send (it does not merge your list with +existing measures before that check). To change a single metric without +assembling the full required set, use \code{\link{set_record_measure}}. +} +\examples{ +\donttest{ +\dontrun{ +# Prefer for a single metric (no need to list all required measures) +set_record_measure(vol_id = 1, record_id = 123, metric_id = 2, value = "Male") + +# PATCH with measures: merge current values with changes so required metrics stay present +rec <- get_volume_record_by_id(vol_id = 1, record_id = 123) +new_measures <- utils::modifyList(rec$measures, list("2" = "Updated label")) +update_volume_record(vol_id = 1, record_id = 123, measures = new_measures) +} +} +} +\seealso{ +\code{\link{set_record_measure}}, \code{\link{get_volume_record_by_id}} +} diff --git a/man/upload_file.Rd b/man/upload_file.Rd new file mode 100644 index 00000000..be2f373c --- /dev/null +++ b/man/upload_file.Rd @@ -0,0 +1,69 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/upload_file.R +\name{upload_file} +\alias{upload_file} +\title{Upload a Local File to Databrary} +\usage{ +upload_file( + path, + destination_type, + object_id, + filename = NULL, + content_type = NULL, + source_session_id = NULL, + source_folder_id = NULL, + vb = options::opt("vb"), + rq = NULL +) +} +\arguments{ +\item{path}{Path to the local file. Must exist and be readable.} + +\item{destination_type}{See \code{\link{initiate_upload}}.} + +\item{object_id}{See \code{\link{initiate_upload}}.} + +\item{filename}{Optional display filename; defaults to \code{basename(path)}.} + +\item{content_type}{Optional MIME type; auto-detected from the file +extension when not supplied.} + +\item{source_session_id}{See \code{\link{initiate_upload}}.} + +\item{source_folder_id}{See \code{\link{initiate_upload}}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} + +\item{rq}{An \code{httr2} request object. Defaults to \code{NULL}.} +} +\value{ +A named list with \code{upload_guid} (when known), +\code{status_url}, and \code{upload_type}. Returns \code{NULL} if any +step fails. +} +\description{ +High-level wrapper around the upload pipeline: +\code{\link{initiate_upload}} -> PUT bytes to the signed URL(s) -> +\code{\link{complete_upload}} (multipart only). Returns the metadata +needed to poll progress with \code{\link{get_upload_status}}. + +Picks the upload mode the server returned: single PUT on the on-prem +core deployment or for small files on AWS, S3 multipart for large files +on AWS. +} +\examples{ +\donttest{ +\dontrun{ +info <- upload_file( + path = "/tmp/clip.mp4", + destination_type = "session", + object_id = 42 +) +get_upload_status(status_url = info$status_url) +} +} +} +\seealso{ +\code{\link{initiate_upload}}, \code{\link{get_upload_status}}, +\code{\link{complete_upload}} +} diff --git a/man/whoami.Rd b/man/whoami.Rd new file mode 100644 index 00000000..8b21677e --- /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 feedback. Defaults to \code{options::opt("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..a153397c --- /dev/null +++ b/tests/testthat/helper-auth.R @@ -0,0 +1,65 @@ +login_test_account <- function() { + required_vars <- c( + "DATABRARY_LOGIN", + "DATABRARY_PASSWORD", + "DATABRARY_CLIENT_ID", + "DATABRARY_CLIENT_SECRET" + ) + + missing <- vapply(required_vars, function(v) { + val <- Sys.getenv(v, "") + !nzchar(val) + }, logical(1)) + + if (any(missing)) { + testthat::skip(paste0( + "Missing env vars for live API test: ", + paste(required_vars[missing], collapse = ", "), + ". See README for required environment variables." + )) + } + + if (!nzchar(Sys.getenv("DATABRARY_BASE_URL", ""))) { + Sys.setenv(DATABRARY_BASE_URL = "https://api.stg-databrary.its.nyu.edu") + } + + # Reuse token for the rest of the R process (testthat default: one process per run). + bundle_existing <- databraryr:::get_token_bundle() + if ( + !is.null(bundle_existing) && + !databraryr:::is_missing_string(bundle_existing$access_token) + ) { + return(invisible(TRUE)) + } + + vals <- list( + email = Sys.getenv("DATABRARY_LOGIN"), + password = Sys.getenv("DATABRARY_PASSWORD"), + client_id = Sys.getenv("DATABRARY_CLIENT_ID"), + client_secret = Sys.getenv("DATABRARY_CLIENT_SECRET") + ) + + 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/helper-fixtures.R b/tests/testthat/helper-fixtures.R new file mode 100644 index 00000000..433f0b1e --- /dev/null +++ b/tests/testthat/helper-fixtures.R @@ -0,0 +1,191 @@ +# Shared sandbox IDs for live API integration tests +TEST_VOL_ID <- 1777L +TEST_CATEGORY_ID <- 6L +TEST_MISSING_ID <- 999999999L +TEST_METRIC_ID <- 29L +TEST_METRIC_ID_EXTRA <- 30L + +# create_session, then schedule delete_session on `envir` via withr::defer. +# Default `envir = parent.frame()`: call from test_that() so cleanup runs when +# the test ends. Wrappers must pass `envir = parent.frame()` through. +make_test_session <- function( + name, + vol_id = TEST_VOL_ID, + release_level = NULL, + source_date = NULL, + date = NULL, + date_precision = NULL, + default_records = NULL, + vb = FALSE, + rq = NULL, + envir = parent.frame()) { + created <- create_session( + vol_id = vol_id, + name = name, + release_level = release_level, + source_date = source_date, + date = date, + date_precision = date_precision, + default_records = default_records, + vb = vb, + rq = rq + ) + + if (is.null(created) || is.null(created$id)) { + return(NULL) + } + + sid <- created$id + withr::defer( + delete_session(vol_id = vol_id, session_id = sid, vb = FALSE), + envir = envir + ) + sid +} + +# See make_test_session() for `envir` usage. +make_test_record <- function( + name, + category_id = TEST_CATEGORY_ID, + vol_id = TEST_VOL_ID, + measures = list(), + participant = NULL, + vb = FALSE, + rq = NULL, + envir = parent.frame()) { + created <- create_volume_record( + vol_id = vol_id, + category_id = category_id, + name = name, + measures = measures, + participant = participant, + vb = vb, + rq = rq + ) + + if (is.null(created) || is.null(created$record_id)) { + return(NULL) + } + + rid <- created$record_id + withr::defer( + delete_volume_record(vol_id = vol_id, record_id = rid, vb = FALSE), + envir = envir + ) + rid +} + +# create_folder, then schedule delete_folder on `envir` via withr::defer. +# See make_test_session() for `envir` usage. +make_test_folder <- function( + name, + vol_id = TEST_VOL_ID, + release_level = NULL, + source_date = NULL, + vb = FALSE, + rq = NULL, + envir = parent.frame()) { + created <- create_folder( + vol_id = vol_id, + name = name, + release_level = release_level, + source_date = source_date, + vb = vb, + rq = rq + ) + + if (is.null(created) || is.null(created$id)) { + return(NULL) + } + + fid <- as.integer(created$id) + withr::defer( + delete_folder(vol_id = vol_id, folder_id = fid, vb = FALSE), + envir = envir + ) + fid +} + +# Upload a small text file into a session and wait until it appears in listing. +# Use file_basename with a text extension (e.g. .txt); staging may reject +# application/octet-stream. Session defer deletes the session and assets. +upload_test_session_asset <- function( + session_id, + vol_id = TEST_VOL_ID, + file_basename = "test_asset.txt", + vb = FALSE, + max_wait_s = 120L, + envir = parent.frame()) { + tmp <- tempfile(fileext = paste0(".", tools::file_ext(file_basename))) + writeLines(strrep("x", 2048L), tmp, useBytes = FALSE) + withr::defer(unlink(tmp, force = TRUE), envir = envir) + + ct <- databraryr:::guess_content_type(file_basename) + + up <- upload_file( + path = tmp, + destination_type = "session", + object_id = session_id, + content_type = ct, + filename = file_basename, + vb = vb + ) + if (is.null(up)) { + return(NULL) + } + + deadline <- Sys.time() + as.numeric(max_wait_s) + while (Sys.time() < deadline) { + assets <- list_session_assets(vol_id = vol_id, session_id = session_id, vb = FALSE) + if (!is.null(assets) && nrow(assets) > 0L) { + m <- which(assets$asset_name == file_basename) + if (length(m)) { + return(as.integer(assets$asset_id[m[[1L]]])) + } + return(as.integer(assets$asset_id[nrow(assets)])) + } + Sys.sleep(1) + } + NULL +} + +# Folder variant of upload_test_session_asset(); folder teardown via make_test_folder defer. +upload_test_folder_asset <- function( + folder_id, + vol_id = TEST_VOL_ID, + file_basename = "folder_test_asset.txt", + vb = FALSE, + max_wait_s = 120L, + envir = parent.frame()) { + tmp <- tempfile(fileext = paste0(".", tools::file_ext(file_basename))) + writeLines(strrep("x", 2048L), tmp, useBytes = FALSE) + withr::defer(unlink(tmp, force = TRUE), envir = envir) + + ct <- databraryr:::guess_content_type(file_basename) + + up <- upload_file( + path = tmp, + destination_type = "folder", + object_id = folder_id, + content_type = ct, + filename = file_basename, + vb = vb + ) + if (is.null(up)) { + return(NULL) + } + + deadline <- Sys.time() + as.numeric(max_wait_s) + while (Sys.time() < deadline) { + assets <- list_folder_assets(vol_id = vol_id, folder_id = folder_id, vb = FALSE) + if (!is.null(assets) && nrow(assets) > 0L) { + m <- which(assets$asset_name == file_basename) + if (length(m)) { + return(as.integer(assets$asset_id[m[[1L]]])) + } + return(as.integer(assets$asset_id[nrow(assets)])) + } + Sys.sleep(1) + } + NULL +} diff --git a/tests/testthat/test-add_default_record_to_session.R b/tests/testthat/test-add_default_record_to_session.R new file mode 100644 index 00000000..1b3d826e --- /dev/null +++ b/tests/testthat/test-add_default_record_to_session.R @@ -0,0 +1,135 @@ +# add_default_record_to_session() ---------------------------------------------- +login_test_account() + +test_that("add_default_record_to_session attaches a record", { + sid <- make_test_session("add_default_record happy path") + skip_if_null_response(sid, "create_session for add_default_record happy path") + + rid <- make_test_record("add_default_record happy path record") + skip_if_null_response(rid, "create_volume_record for add_default_record happy path") + + result <- add_default_record_to_session( + vol_id = TEST_VOL_ID, + session_id = sid, + record_id = rid, + vb = FALSE + ) + expect_true(result) + + # Verify it shows up among the session's default_records + session <- get_session_by_id( + vol_id = TEST_VOL_ID, + session_id = sid, + vb = FALSE + ) + default_ids <- vapply( + session$default_records, + function(r) as.integer(r$id), + integer(1) + ) + expect_true(as.integer(rid) %in% default_ids) +}) + +test_that("add_default_record_to_session returns FALSE for non-existent record", { + sid <- make_test_session("add_default_record non-existent record") + skip_if_null_response(sid, "create_session for non-existent record test") + + expect_false( + add_default_record_to_session( + vol_id = TEST_VOL_ID, + session_id = sid, + record_id = TEST_MISSING_ID, + vb = FALSE + ) + ) +}) + +test_that("add_default_record_to_session returns FALSE for non-existent session", { + rid <- make_test_record("add_default_record non-existent session record") + skip_if_null_response(rid, "create_volume_record for non-existent session test") + + expect_false( + add_default_record_to_session( + vol_id = TEST_VOL_ID, + session_id = TEST_MISSING_ID, + record_id = rid, + vb = FALSE + ) + ) +}) + +test_that("add_default_record_to_session works with verbose mode", { + sid <- make_test_session("add_default_record vb") + skip_if_null_response(sid, "create_session for add_default_record vb") + + rid <- make_test_record("add_default_record vb record") + skip_if_null_response(rid, "create_volume_record for add_default_record vb") + + expect_true( + add_default_record_to_session( + vol_id = TEST_VOL_ID, + session_id = sid, + record_id = rid, + vb = TRUE + ) + ) +}) + +test_that("add_default_record_to_session works with custom request object", { + sid <- make_test_session("add_default_record custom rq") + skip_if_null_response(sid, "create_session for add_default_record custom rq") + + rid <- make_test_record("add_default_record custom rq record") + skip_if_null_response(rid, "create_volume_record for add_default_record custom rq") + + custom_rq <- databraryr::make_default_request() + expect_true( + add_default_record_to_session( + vol_id = TEST_VOL_ID, + session_id = sid, + record_id = rid, + rq = custom_rq, + vb = FALSE + ) + ) +}) + +test_that("add_default_record_to_session rejects invalid vol_id", { + expect_error(add_default_record_to_session(vol_id = -1, session_id = 1, record_id = 1)) + expect_error(add_default_record_to_session(vol_id = 0, session_id = 1, record_id = 1)) + expect_error(add_default_record_to_session(vol_id = "1", session_id = 1, record_id = 1)) + expect_error(add_default_record_to_session(vol_id = TRUE, session_id = 1, record_id = 1)) + expect_error(add_default_record_to_session(vol_id = c(1, 2), session_id = 1, record_id = 1)) + expect_error(add_default_record_to_session(vol_id = 1.5, session_id = 1, record_id = 1)) +}) + +test_that("add_default_record_to_session rejects invalid session_id", { + expect_error(add_default_record_to_session(vol_id = 1, session_id = -1, record_id = 1)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 0, record_id = 1)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = "1", record_id = 1)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = TRUE, record_id = 1)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = c(1, 2), record_id = 1)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1.5, record_id = 1)) +}) + +test_that("add_default_record_to_session rejects invalid record_id", { + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = -1)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 0)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = "1")) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = TRUE)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = c(1, 2))) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 1.5)) +}) + +test_that("add_default_record_to_session rejects invalid vb parameter", { + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 1, vb = -1)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 1, vb = "a")) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 1, vb = NULL)) +}) + +test_that("add_default_record_to_session rejects invalid rq parameter", { + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 1, rq = "a")) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 1, rq = -1)) + expect_error(add_default_record_to_session(vol_id = 1, session_id = 1, record_id = 1, rq = TRUE)) +}) diff --git a/tests/testthat/test-assign_constants.R b/tests/testthat/test-assign_constants.R index d89f437b..1f44d200 100644 --- a/tests/testthat/test-assign_constants.R +++ b/tests/testthat/test-assign_constants.R @@ -1,5 +1,12 @@ -test_that("assign_constants returns list", { - expect_true("list" %in% class(assign_constants())) +login_test_account() + +test_that("assign_constants returns constants", { + 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 +18,12 @@ 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", { + 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-assign_record_to_file.R b/tests/testthat/test-assign_record_to_file.R new file mode 100644 index 00000000..716c99ac --- /dev/null +++ b/tests/testthat/test-assign_record_to_file.R @@ -0,0 +1,159 @@ +# assign_record_to_file() ------------------------------------------------------ +login_test_account() + +test_that("assign_record_to_file assigns a record to a file", { + sid <- make_test_session("assign_record_to_file session") + skip_if_null_response(sid, "create_session for assign test") + + asset_name <- sprintf("assign_probe_%d.txt", sample(100000L:999999L, 1L)) + file_id <- upload_test_session_asset(sid, file_basename = asset_name) + skip_if_null_response(file_id, "upload for assign test") + + create_result <- create_volume_record( + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, + name = sprintf("Assign test %d", sample(100000L:999999L, 1L)), + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for assign test") + + record_id <- create_result$record_id + withr::defer( + { + try( + unassign_record_from_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ), + silent = TRUE + ) + try( + delete_volume_record(vol_id = TEST_VOL_ID, record_id = record_id, vb = FALSE), + silent = TRUE + ) + }, + envir = parent.frame() + ) + + assign_result <- assign_record_to_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) + + skip_if_null_response(assign_result, "assign_record_to_file") + + expect_true(!is.null(assign_result)) +}) + +test_that("assign_record_to_file is idempotent", { + sid <- make_test_session("assign_record_to_file idempotent session") + skip_if_null_response(sid, "create_session for idempotent assign test") + + asset_name <- sprintf("assign_idem_%d.txt", sample(100000L:999999L, 1L)) + file_id <- upload_test_session_asset(sid, file_basename = asset_name) + skip_if_null_response(file_id, "upload for idempotent assign test") + + create_result <- create_volume_record( + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, + name = sprintf("Assign idempotent %d", sample(100000L:999999L, 1L)), + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for idempotent test") + + record_id <- create_result$record_id + withr::defer( + { + try( + unassign_record_from_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ), + silent = TRUE + ) + try( + delete_volume_record(vol_id = TEST_VOL_ID, record_id = record_id, vb = FALSE), + silent = TRUE + ) + }, + envir = parent.frame() + ) + + assign_result1 <- assign_record_to_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) + + assign_result2 <- assign_record_to_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) + + expect_true(!is.null(assign_result1)) + expect_true(!is.null(assign_result2)) +}) + +test_that("assign_record_to_file rejects invalid vol_id", { + expect_error(assign_record_to_file(vol_id = -1, session_id = 1, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 0, session_id = 1, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = "1", session_id = 1, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = TRUE, session_id = 1, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = c(1, 2), session_id = 1, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1.5, session_id = 1, file_id = 1, record_id = 1)) +}) + +test_that("assign_record_to_file rejects invalid session_id", { + expect_error(assign_record_to_file(vol_id = 1, session_id = -1, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 0, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = "1", file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = TRUE, file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = c(1, 2), file_id = 1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1.5, file_id = 1, record_id = 1)) +}) + +test_that("assign_record_to_file rejects invalid file_id", { + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = -1, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 0, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = "1", record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = TRUE, record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = c(1, 2), record_id = 1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1.5, record_id = 1)) +}) + +test_that("assign_record_to_file rejects invalid record_id", { + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = -1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 0)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = "1")) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = TRUE)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = c(1, 2))) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1.5)) +}) + +test_that("assign_record_to_file rejects invalid vb parameter", { + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = -1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = 3)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = "a")) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = NULL)) +}) + +test_that("assign_record_to_file rejects invalid rq parameter", { + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, rq = "a")) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, rq = -1)) + expect_error(assign_record_to_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, rq = TRUE)) +}) diff --git a/tests/testthat/test-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-bulk_assign_records.R b/tests/testthat/test-bulk_assign_records.R new file mode 100644 index 00000000..0df5289b --- /dev/null +++ b/tests/testthat/test-bulk_assign_records.R @@ -0,0 +1,90 @@ +# bulk_assign_records() ------------------------------------------------------- +login_test_account() + +test_that("bulk_assign_records rejects invalid args", { + expect_error(bulk_assign_records(vol_id = -1, session_id = 1L, record_ids = 1L)) + expect_error(bulk_assign_records(vol_id = 1L, session_id = -1L, record_ids = 1L)) + expect_error(bulk_assign_records(vol_id = 1L, session_id = 1L, record_ids = numeric(0))) +}) + +test_that("bulk_assign_records assigns defaults for multiple records", { + uniq <- sprintf( + "bulk_ar_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + sid <- make_test_session(sprintf("%s_sess", uniq), vb = FALSE) + skip_if_null_response(sid, "make_test_session") + + r1 <- make_test_record(sprintf("%s_r1", uniq), vb = FALSE) + r2 <- make_test_record(sprintf("%s_r2", uniq), vb = FALSE) + skip_if_null_response(r1, "make_test_record 1") + skip_if_null_response(r2, "make_test_record 2") + + result <- bulk_assign_records( + vol_id = TEST_VOL_ID, + session_id = sid, + record_ids = c(r1, r2), + vb = FALSE + ) + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 2) + expect_true(all(result$status == "success")) +}) + +test_that("bulk_assign_records fast-fails on bad record id", { + sid <- make_test_session("bulk_assign_records ff", vb = FALSE) + skip_if_null_response(sid, "make_test_session") + + r1 <- make_test_record("bulk_assign_records ff r", vb = FALSE) + skip_if_null_response(r1, "make_test_record") + + mixed <- c(r1, TEST_MISSING_ID) + + partial <- tryCatch( + bulk_assign_records( + vol_id = TEST_VOL_ID, + session_id = sid, + record_ids = mixed, + vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[[1]], "success") + expect_equal(partial$status[[2]], "failed") +}) + +test_that("bulk_assign_records on_error collect runs all rows", { + sid <- make_test_session("bulk_assign_records collect", vb = FALSE) + skip_if_null_response(sid, "make_test_session") + + created <- bulk_create_records( + vol_id = TEST_VOL_ID, + record_names = c("bulk_ar_c1", "bulk_ar_c2"), + category_id = TEST_CATEGORY_ID, + vb = FALSE + ) + skip_if_null_response(created, "bulk_create_records") + + ids <- vapply(created$result, function(r) as.integer(r$record_id), integer(1)) + on.exit({ + for (id in ids) { + try(delete_volume_record(TEST_VOL_ID, id, vb = FALSE), silent = TRUE) + } + }, add = TRUE) + + mixed <- c(ids[[1]], TEST_MISSING_ID, ids[[2]]) + result <- bulk_assign_records( + vol_id = TEST_VOL_ID, + session_id = sid, + record_ids = mixed, + vb = FALSE, + on_error = "collect" + ) + + expect_s3_class(result, "tbl_df") + expect_equal(result$status, c("success", "failed", "success")) +}) diff --git a/tests/testthat/test-bulk_create_folders.R b/tests/testthat/test-bulk_create_folders.R new file mode 100644 index 00000000..a7977fcf --- /dev/null +++ b/tests/testthat/test-bulk_create_folders.R @@ -0,0 +1,50 @@ +# bulk_create_folders() ------------------------------------------------------- +login_test_account() + +test_that("bulk_create_folders rejects invalid args", { + expect_error(bulk_create_folders(vol_id = -1, folder_names = "a")) + expect_error(bulk_create_folders(vol_id = 1, folder_names = character(0))) + expect_error(bulk_create_folders(vol_id = 1, folder_names = c("a", "a"))) + expect_error(bulk_create_folders( + vol_id = 1, folder_names = c("a", "b"), release_level = c("X", "Y", "Z") + )) +}) + +test_that("bulk_create_folders creates and deletes multiple folders", { + uniq <- sprintf( + "bulk_cf_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + names_vec <- c( + sprintf("%s_1", uniq), sprintf("%s_2", uniq), sprintf("%s_3", uniq) + ) + + result <- bulk_create_folders( + vol_id = TEST_VOL_ID, + folder_names = names_vec, + vb = FALSE + ) + skip_if_null_response(result, "bulk_create_folders live API") + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 3) + expect_equal(result$input, names_vec) + expect_true(all(result$status == "success")) + + ids <- vapply(result$result, function(r) { + if (is.null(r) || is.null(r$id)) NA_real_ else as.numeric(r$id) + }, numeric(1)) + on.exit({ + for (id in ids) { + if (!is.na(id)) { + try( + delete_folder(vol_id = TEST_VOL_ID, folder_id = as.integer(id), vb = FALSE), + silent = TRUE + ) + } + } + }, add = TRUE) + + expect_false(any(is.na(ids))) +}) diff --git a/tests/testthat/test-bulk_create_records.R b/tests/testthat/test-bulk_create_records.R new file mode 100644 index 00000000..ced70f77 --- /dev/null +++ b/tests/testthat/test-bulk_create_records.R @@ -0,0 +1,51 @@ +# bulk_create_records() ------------------------------------------------------- +login_test_account() + +test_that("bulk_create_records rejects invalid args", { + expect_error(bulk_create_records(vol_id = -1, record_names = "a", category_id = 1L)) + expect_error(bulk_create_records(vol_id = 1, record_names = character(0), category_id = 1L)) + expect_error(bulk_create_records(vol_id = 1, record_names = c("a", "a"), category_id = 6L)) + expect_error(bulk_create_records( + vol_id = 1, record_names = c("a", "b"), category_id = rep(TEST_CATEGORY_ID, 3L) + )) +}) + +test_that("bulk_create_records creates then deletes multiple records", { + uniq <- sprintf( + "bulk_cr_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + names_vec <- c( + sprintf("%s_1", uniq), sprintf("%s_2", uniq), sprintf("%s_3", uniq) + ) + + result <- bulk_create_records( + vol_id = TEST_VOL_ID, + record_names = names_vec, + category_id = TEST_CATEGORY_ID, + vb = FALSE + ) + skip_if_null_response(result, "bulk_create_records live API") + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 3) + expect_equal(result$input, names_vec) + expect_true(all(result$status == "success")) + + ids <- vapply(result$result, function(r) { + if (is.null(r) || is.null(r$record_id)) NA_real_ else as.numeric(r$record_id) + }, numeric(1)) + on.exit({ + for (id in ids) { + if (!is.na(id)) { + try( + delete_volume_record(vol_id = TEST_VOL_ID, record_id = as.integer(id), vb = FALSE), + silent = TRUE + ) + } + } + }, add = TRUE) + + expect_false(any(is.na(ids))) +}) diff --git a/tests/testthat/test-bulk_create_sessions.R b/tests/testthat/test-bulk_create_sessions.R new file mode 100644 index 00000000..b40766ca --- /dev/null +++ b/tests/testthat/test-bulk_create_sessions.R @@ -0,0 +1,50 @@ +# bulk_create_sessions() ------------------------------------------------------ +login_test_account() + +test_that("bulk_create_sessions rejects invalid args", { + expect_error(bulk_create_sessions(vol_id = -1, session_names = "a")) + expect_error(bulk_create_sessions(vol_id = 1, session_names = character(0))) + expect_error(bulk_create_sessions(vol_id = 1, session_names = c("a", "a"))) + expect_error(bulk_create_sessions( + vol_id = 1, session_names = c("a", "b"), source_date = rep("2024-01-01", 3) + )) +}) + +test_that("bulk_create_sessions creates and deletes multiple sessions", { + uniq <- sprintf( + "bulk_cs_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + names_vec <- c( + sprintf("%s_1", uniq), sprintf("%s_2", uniq), sprintf("%s_3", uniq) + ) + + result <- bulk_create_sessions( + vol_id = TEST_VOL_ID, + session_names = names_vec, + vb = FALSE + ) + skip_if_null_response(result, "bulk_create_sessions live API") + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 3) + expect_equal(result$input, names_vec) + expect_true(all(result$status == "success")) + + ids <- vapply(result$result, function(r) { + if (is.null(r) || is.null(r$id)) NA_real_ else as.numeric(r$id) + }, numeric(1)) + on.exit({ + for (id in ids) { + if (!is.na(id)) { + try( + delete_session(vol_id = TEST_VOL_ID, session_id = as.integer(id), vb = FALSE), + silent = TRUE + ) + } + } + }, add = TRUE) + + expect_false(any(is.na(ids))) +}) diff --git a/tests/testthat/test-bulk_delete_files.R b/tests/testthat/test-bulk_delete_files.R new file mode 100644 index 00000000..137a9bd1 --- /dev/null +++ b/tests/testthat/test-bulk_delete_files.R @@ -0,0 +1,52 @@ +# bulk_delete_files() --------------------------------------------------------- +login_test_account() + +# Argument validation --------------------------------------------------------- + +test_that("bulk_delete_files rejects invalid args", { + expect_error(bulk_delete_files( + vol_id = -1, session_id = 1, file_ids = 1 + )) + expect_error(bulk_delete_files( + vol_id = 1, session_id = 0, file_ids = 1 + )) + expect_error(bulk_delete_files( + vol_id = 1, session_id = 1, file_ids = numeric(0) + )) + expect_error(bulk_delete_files( + vol_id = 1, session_id = 1, file_ids = c(1, -2) + )) + expect_error(bulk_delete_files( + vol_id = 1, session_id = 1, file_ids = c(1, NA) + )) + expect_error(bulk_delete_files( + vol_id = 1, session_id = 1, file_ids = "1" + )) +}) + +# End-to-end ------------------------------------------------------------------ + +test_that("bulk_delete_files fast-fails on non-existent file ids", { + session <- create_session( + vol_id = TEST_VOL_ID, name = "bulk_delete_files fail test", vb = FALSE + ) + skip_if_null_response(session, "create_session for bulk_delete_files") + on.exit( + delete_session(vol_id = TEST_VOL_ID, session_id = session$id, vb = FALSE), + add = TRUE + ) + + partial <- tryCatch( + bulk_delete_files( + vol_id = TEST_VOL_ID, + session_id = session$id, + file_ids = c(999999999, 999999998), + vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[1], "failed") + expect_equal(partial$status[2], "pending") +}) diff --git a/tests/testthat/test-bulk_delete_folders.R b/tests/testthat/test-bulk_delete_folders.R new file mode 100644 index 00000000..81f030f2 --- /dev/null +++ b/tests/testthat/test-bulk_delete_folders.R @@ -0,0 +1,53 @@ +# bulk_delete_folders() ------------------------------------------------------- +login_test_account() + +# Argument validation --------------------------------------------------------- + +test_that("bulk_delete_folders rejects invalid args", { + expect_error(bulk_delete_folders(vol_id = -1, folder_ids = 1)) + expect_error(bulk_delete_folders(vol_id = 1, folder_ids = numeric(0))) + expect_error(bulk_delete_folders(vol_id = 1, folder_ids = c(1, -2))) + expect_error(bulk_delete_folders(vol_id = 1, folder_ids = c(1, NA))) + expect_error(bulk_delete_folders(vol_id = 1, folder_ids = c(1.5, 2))) + expect_error(bulk_delete_folders(vol_id = 1, folder_ids = "1")) +}) + +# End-to-end ------------------------------------------------------------------ + +test_that("bulk_delete_folders deletes multiple folders", { + ids <- vapply(seq_len(3), function(i) { + f <- create_folder( + vol_id = TEST_VOL_ID, + name = sprintf("bulk_delete_folders test %d", i), + vb = FALSE + ) + if (is.null(f)) NA_real_ else as.numeric(f$id) + }, numeric(1)) + + if (any(is.na(ids))) { + testthat::skip("Could not create test folders on staging.") + } + + result <- bulk_delete_folders( + vol_id = TEST_VOL_ID, folder_ids = ids, vb = FALSE + ) + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 3) + expect_true(all(result$status == "success")) +}) + +test_that("bulk_delete_folders fast-fails on non-existent folder", { + partial <- tryCatch( + bulk_delete_folders( + vol_id = TEST_VOL_ID, + folder_ids = c(999999999, 999999998), + vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[1], "failed") + expect_equal(partial$status[2], "pending") +}) diff --git a/tests/testthat/test-bulk_delete_records.R b/tests/testthat/test-bulk_delete_records.R new file mode 100644 index 00000000..1d47f767 --- /dev/null +++ b/tests/testthat/test-bulk_delete_records.R @@ -0,0 +1,89 @@ +# bulk_delete_records() ------------------------------------------------------- +login_test_account() + +test_that("bulk_delete_records rejects invalid args", { + expect_error(bulk_delete_records(vol_id = -1, record_ids = 1L)) + expect_error(bulk_delete_records(vol_id = 1, record_ids = numeric(0))) + expect_error(bulk_delete_records(vol_id = 1, record_ids = c(1L, -2L))) + expect_error(bulk_delete_records(vol_id = 1, record_ids = c(1L, NA))) +}) + +test_that("bulk_delete_records deletes multiple records", { + uniq <- sprintf( + "bulk_delrec_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + created <- bulk_create_records( + vol_id = TEST_VOL_ID, + record_names = c(sprintf("%s_1", uniq), sprintf("%s_2", uniq)), + category_id = TEST_CATEGORY_ID, + vb = FALSE + ) + skip_if_null_response(created, "bulk_create_records for bulk_delete_records") + + ids <- vapply(created$result, function(r) as.numeric(r$record_id), numeric(1)) + + result <- bulk_delete_records(vol_id = TEST_VOL_ID, record_ids = ids, vb = FALSE) + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 2) + expect_true(all(result$status == "success")) +}) + +test_that("bulk_delete_records fast-fails on missing record id", { + uniq <- sprintf( + "bulk_delrec_ff_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + one <- create_volume_record( + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, + name = sprintf("%s_single", uniq), + vb = FALSE + ) + skip_if_null_response(one, "create_volume_record") + + rid <- as.integer(one$record_id) + on.exit(try(delete_volume_record(TEST_VOL_ID, rid, vb = FALSE), silent = TRUE), add = TRUE) + + mixed <- c(rid, TEST_MISSING_ID) + + partial <- tryCatch( + bulk_delete_records(vol_id = TEST_VOL_ID, record_ids = mixed, vb = FALSE), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[[1]], "success") + expect_equal(partial$status[[2]], "failed") +}) + +test_that("bulk_delete_records on_error collect runs all rows", { + uniq <- sprintf( + "bulk_delrec_coll_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + created <- bulk_create_records( + vol_id = TEST_VOL_ID, + record_names = c(sprintf("%s_1", uniq), sprintf("%s_2", uniq)), + category_id = TEST_CATEGORY_ID, + vb = FALSE + ) + skip_if_null_response(created, "bulk_create_records") + + ids <- vapply(created$result, function(r) as.numeric(r$record_id), numeric(1)) + + mixed <- c(ids[[1]], TEST_MISSING_ID, ids[[2]]) + result <- bulk_delete_records( + vol_id = TEST_VOL_ID, + record_ids = mixed, + vb = FALSE, + on_error = "collect" + ) + + expect_s3_class(result, "tbl_df") + expect_equal(result$status, c("success", "failed", "success")) +}) diff --git a/tests/testthat/test-bulk_delete_sessions.R b/tests/testthat/test-bulk_delete_sessions.R new file mode 100644 index 00000000..6ad1e446 --- /dev/null +++ b/tests/testthat/test-bulk_delete_sessions.R @@ -0,0 +1,105 @@ +# bulk_delete_sessions() ------------------------------------------------------ +login_test_account() + +# Argument validation --------------------------------------------------------- + +test_that("bulk_delete_sessions rejects invalid args", { + expect_error(bulk_delete_sessions(vol_id = -1, session_ids = 1)) + expect_error(bulk_delete_sessions(vol_id = 1, session_ids = numeric(0))) + expect_error(bulk_delete_sessions(vol_id = 1, session_ids = c(1, -2))) + expect_error(bulk_delete_sessions(vol_id = 1, session_ids = c(1, NA))) + expect_error(bulk_delete_sessions(vol_id = 1, session_ids = c(1.5, 2))) + expect_error(bulk_delete_sessions(vol_id = 1, session_ids = "1")) +}) + +# End-to-end ------------------------------------------------------------------ + +test_that("bulk_delete_sessions deletes multiple sessions", { + ids <- vapply(seq_len(3), function(i) { + s <- create_session( + vol_id = TEST_VOL_ID, + name = sprintf("bulk_delete_sessions test %d", i), + vb = FALSE + ) + if (is.null(s)) NA_real_ else as.numeric(s$id) + }, numeric(1)) + + if (any(is.na(ids))) { + testthat::skip("Could not create test sessions on staging.") + } + + result <- bulk_delete_sessions( + vol_id = TEST_VOL_ID, session_ids = ids, vb = FALSE + ) + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 3) + expect_true(all(result$status == "success")) +}) + +test_that("bulk_delete_sessions fast-fails and resume completes the rest", { + ids <- vapply(seq_len(2), function(i) { + s <- create_session( + vol_id = TEST_VOL_ID, + name = sprintf("bulk_delete_sessions resume %d", i), + vb = FALSE + ) + if (is.null(s)) NA_real_ else as.numeric(s$id) + }, numeric(1)) + + if (any(is.na(ids))) { + testthat::skip("Could not create test sessions on staging.") + } + on.exit({ + for (id in ids) { + try(delete_session(TEST_VOL_ID, id, vb = FALSE), silent = TRUE) + } + }, add = TRUE) + + # Put a non-existent id between the two real ones; delete_session returns + # FALSE on it, which fast-fails the bulk run. + mixed <- c(ids[1], 999999999, ids[2]) + + partial <- tryCatch( + bulk_delete_sessions( + vol_id = TEST_VOL_ID, session_ids = mixed, vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[1], "success") + expect_equal(partial$status[2], "failed") + expect_equal(partial$status[3], "pending") +}) + +test_that("bulk_delete_sessions on_error collect runs all rows", { + ids <- vapply(seq_len(2), function(i) { + s <- create_session( + vol_id = TEST_VOL_ID, + name = sprintf("bulk_delete_sessions collect %d", i), + vb = FALSE + ) + if (is.null(s)) NA_real_ else as.numeric(s$id) + }, numeric(1)) + + if (any(is.na(ids))) { + testthat::skip("Could not create test sessions on staging.") + } + on.exit({ + for (id in ids) { + try(delete_session(TEST_VOL_ID, id, vb = FALSE), silent = TRUE) + } + }, add = TRUE) + + mixed <- c(ids[1], 999999999, ids[2]) + result <- bulk_delete_sessions( + vol_id = TEST_VOL_ID, + session_ids = mixed, + vb = FALSE, + on_error = "collect" + ) + + expect_s3_class(result, "tbl_df") + expect_equal(result$status, c("success", "failed", "success")) +}) diff --git a/tests/testthat/test-bulk_rename_files.R b/tests/testthat/test-bulk_rename_files.R new file mode 100644 index 00000000..30902b95 --- /dev/null +++ b/tests/testthat/test-bulk_rename_files.R @@ -0,0 +1,123 @@ +# bulk_rename_files() --------------------------------------------------------- +login_test_account() + +test_that("bulk_rename_files rejects invalid args", { + expect_error(bulk_rename_files(vol_id = -1, session_id = 1L, file_ids = 1L, new_names = "a")) + expect_error(bulk_rename_files(vol_id = 1L, session_id = 1L, file_ids = integer(0), new_names = character(0))) + expect_error(bulk_rename_files(vol_id = 1L, session_id = 1L, file_ids = c(1L, 2L), new_names = "a")) + expect_error(bulk_rename_files(vol_id = 1L, session_id = 1L, file_ids = c(1L, 1L), new_names = c("a", "b"))) +}) + +test_that("bulk_rename_files renames multiple session assets", { + uniq <- sprintf( + "bulk_rfile_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + sid <- make_test_session(sprintf("%s_sess", uniq), vb = FALSE) + skip_if_null_response(sid, "make_test_session for bulk_rename_files") + + fn1 <- sprintf("%s_one.txt", uniq) + fn2 <- sprintf("%s_two.txt", uniq) + aid1 <- upload_test_session_asset(sid, file_basename = fn1, vb = FALSE) + aid2 <- upload_test_session_asset(sid, file_basename = fn2, vb = FALSE) + skip_if_null_response(aid1, "upload asset 1") + skip_if_null_response(aid2, "upload asset 2") + + new_names <- c( + sprintf("%s_one_renamed.txt", uniq), + sprintf("%s_two_renamed.txt", uniq) + ) + + result <- bulk_rename_files( + vol_id = TEST_VOL_ID, + session_id = sid, + file_ids = c(aid1, aid2), + new_names = new_names, + vb = FALSE + ) + + skip_if_null_response(result, "bulk_rename_files live API") + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 2) + expect_equal(result$input, c(aid1, aid2)) + expect_true(all(result$status == "success")) + + file_ids <- c(aid1, aid2) + for (k in seq_along(file_ids)) { + file_detail <- get_session_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_ids[[k]], + vb = FALSE + ) + skip_if_null_response( + file_detail, + sprintf("get_session_file after rename (file %d)", k) + ) + nm <- new_names[[k]] + expect_true( + identical(file_detail$name, nm) || + identical(file_detail$name, tools::file_path_sans_ext(nm)), + info = sprintf( + 'Expected name "%s" or stem "%s"; got "%s"', + nm, tools::file_path_sans_ext(nm), file_detail$name + ) + ) + } +}) + +test_that("bulk_rename_files fast-fails on bad file id", { + sid <- make_test_session("bulk_rename_files resume sess", vb = FALSE) + skip_if_null_response(sid, "make_test_session") + + fn1 <- "bulk_rf_resume_a.txt" + aid <- upload_test_session_asset(sid, file_basename = fn1, vb = FALSE) + skip_if_null_response(aid, "upload asset") + + mixed <- c(aid, TEST_MISSING_ID) + nn <- c("bulk_rf_resume_a_renamed.txt", "bulk_rf_resume_b.txt") + + partial <- tryCatch( + bulk_rename_files( + vol_id = TEST_VOL_ID, + session_id = sid, + file_ids = mixed, + new_names = nn, + vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[[1]], "success") + expect_equal(partial$status[[2]], "failed") +}) + +test_that("bulk_rename_files on_error collect runs all rows", { + sid <- make_test_session("bulk_rename_files collect sess", vb = FALSE) + skip_if_null_response(sid, "make_test_session") + + fn1 <- "bulk_rf_collect_a.txt" + fn2 <- "bulk_rf_collect_b.txt" + aid1 <- upload_test_session_asset(sid, file_basename = fn1, vb = FALSE) + aid2 <- upload_test_session_asset(sid, file_basename = fn2, vb = FALSE) + skip_if_null_response(aid1, "upload 1") + skip_if_null_response(aid2, "upload 2") + + mixed <- c(aid1, TEST_MISSING_ID, aid2) + nn <- c("bulk_rf_c1.txt", "bulk_rf_c2.txt", "bulk_rf_c3.txt") + + result <- bulk_rename_files( + vol_id = TEST_VOL_ID, + session_id = sid, + file_ids = mixed, + new_names = nn, + vb = FALSE, + on_error = "collect" + ) + + expect_s3_class(result, "tbl_df") + expect_equal(result$status, c("success", "failed", "success")) +}) diff --git a/tests/testthat/test-bulk_rename_folders.R b/tests/testthat/test-bulk_rename_folders.R new file mode 100644 index 00000000..75cc2776 --- /dev/null +++ b/tests/testthat/test-bulk_rename_folders.R @@ -0,0 +1,122 @@ +# bulk_rename_folders() ------------------------------------------------------- +login_test_account() + +test_that("bulk_rename_folders rejects invalid args", { + expect_error(bulk_rename_folders(vol_id = -1, folder_ids = 1L, new_names = "a")) + expect_error(bulk_rename_folders(vol_id = 1, folder_ids = integer(0), new_names = character(0))) + expect_error(bulk_rename_folders(vol_id = 1L, folder_ids = c(1L, 2L), new_names = "a")) + expect_error(bulk_rename_folders(vol_id = 1L, folder_ids = c(1L, 1L), new_names = c("a", "b"))) +}) + +test_that("bulk_rename_folders renames multiple folders", { + uniq <- sprintf( + "bulk_rf_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + fids <- integer(3) + for (i in seq_along(fids)) { + nm <- sprintf("%s_%d", uniq, i) + fid <- make_test_folder(nm, vb = FALSE) + skip_if_null_response(fid, "make_test_folder for bulk_rename_folders") + fids[[i]] <- fid + } + + new_names <- c( + sprintf("%s_new_a", uniq), + sprintf("%s_new_b", uniq), + sprintf("%s_new_c", uniq) + ) + + result <- bulk_rename_folders( + vol_id = TEST_VOL_ID, + folder_ids = fids, + new_names = new_names, + vb = FALSE + ) + + skip_if_null_response(result, "bulk_rename_folders live API") + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 3) + expect_equal(result$input, fids) + expect_true(all(result$status == "success")) + + for (k in seq_along(fids)) { + fol <- get_folder_by_id(vol_id = TEST_VOL_ID, folder_id = fids[[k]], vb = FALSE) + skip_if_null_response(fol, "get_folder_by_id after rename") + expect_equal(fol$name, new_names[[k]]) + } +}) + +test_that("bulk_rename_folders fast-fails on bad folder id", { + ids <- vapply(seq_len(2), function(i) { + f <- create_folder( + vol_id = TEST_VOL_ID, + name = sprintf("bulk_rename_folders resume %d", i), + vb = FALSE + ) + if (is.null(f)) NA_real_ else as.numeric(f$id) + }, numeric(1)) + + if (any(is.na(ids))) { + testthat::skip("Could not create test folders on staging.") + } + on.exit({ + for (id in ids) { + try(delete_folder(TEST_VOL_ID, id, vb = FALSE), silent = TRUE) + } + }, add = TRUE) + + mixed <- c(ids[[1]], TEST_MISSING_ID, ids[[2]]) + nn <- c("x", "y", "z") + + partial <- tryCatch( + bulk_rename_folders( + vol_id = TEST_VOL_ID, + folder_ids = mixed, + new_names = nn, + vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[[1]], "success") + expect_equal(partial$status[[2]], "failed") + expect_equal(partial$status[[3]], "pending") +}) + +test_that("bulk_rename_folders on_error collect runs all rows", { + ids <- vapply(seq_len(2), function(i) { + f <- create_folder( + vol_id = TEST_VOL_ID, + name = sprintf("bulk_rename_folders collect %d", i), + vb = FALSE + ) + if (is.null(f)) NA_real_ else as.numeric(f$id) + }, numeric(1)) + + if (any(is.na(ids))) { + testthat::skip("Could not create test folders on staging.") + } + on.exit({ + for (id in ids) { + try(delete_folder(TEST_VOL_ID, id, vb = FALSE), silent = TRUE) + } + }, add = TRUE) + + mixed <- c(ids[[1]], TEST_MISSING_ID, ids[[2]]) + nn <- c("c1", "c2", "c3") + + result <- bulk_rename_folders( + vol_id = TEST_VOL_ID, + folder_ids = mixed, + new_names = nn, + vb = FALSE, + on_error = "collect" + ) + + expect_s3_class(result, "tbl_df") + expect_equal(result$status, c("success", "failed", "success")) +}) diff --git a/tests/testthat/test-bulk_rename_sessions.R b/tests/testthat/test-bulk_rename_sessions.R new file mode 100644 index 00000000..73372029 --- /dev/null +++ b/tests/testthat/test-bulk_rename_sessions.R @@ -0,0 +1,122 @@ +# bulk_rename_sessions() ------------------------------------------------------ +login_test_account() + +test_that("bulk_rename_sessions rejects invalid args", { + expect_error(bulk_rename_sessions(vol_id = -1, session_ids = 1L, new_names = "a")) + expect_error(bulk_rename_sessions(vol_id = 1, session_ids = integer(0), new_names = character(0))) + expect_error(bulk_rename_sessions(vol_id = 1L, session_ids = c(1L, 2L), new_names = "a")) + expect_error(bulk_rename_sessions(vol_id = 1L, session_ids = c(1L, 1L), new_names = c("a", "b"))) +}) + +test_that("bulk_rename_sessions renames multiple sessions", { + uniq <- sprintf( + "bulk_rs_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + sids <- integer(3) + for (i in seq_along(sids)) { + nm <- sprintf("%s_%d", uniq, i) + sid <- make_test_session(nm, vb = FALSE) + skip_if_null_response(sid, "make_test_session for bulk_rename_sessions") + sids[[i]] <- sid + } + + new_names <- c( + sprintf("%s_new_a", uniq), + sprintf("%s_new_b", uniq), + sprintf("%s_new_c", uniq) + ) + + result <- bulk_rename_sessions( + vol_id = TEST_VOL_ID, + session_ids = sids, + new_names = new_names, + vb = FALSE + ) + + skip_if_null_response(result, "bulk_rename_sessions live API") + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 3) + expect_equal(result$input, sids) + expect_true(all(result$status == "success")) + + for (k in seq_along(sids)) { + sess <- get_session_by_id(vol_id = TEST_VOL_ID, session_id = sids[[k]], vb = FALSE) + skip_if_null_response(sess, "get_session_by_id after rename") + expect_equal(sess$name, new_names[[k]]) + } +}) + +test_that("bulk_rename_sessions fast-fails on bad session id", { + ids <- vapply(seq_len(2), function(i) { + s <- create_session( + vol_id = TEST_VOL_ID, + name = sprintf("bulk_rename_sessions resume %d", i), + vb = FALSE + ) + if (is.null(s)) NA_real_ else as.numeric(s$id) + }, numeric(1)) + + if (any(is.na(ids))) { + testthat::skip("Could not create test sessions on staging.") + } + on.exit({ + for (id in ids) { + try(delete_session(TEST_VOL_ID, id, vb = FALSE), silent = TRUE) + } + }, add = TRUE) + + mixed <- c(ids[[1]], TEST_MISSING_ID, ids[[2]]) + nn <- c("x", "y", "z") + + partial <- tryCatch( + bulk_rename_sessions( + vol_id = TEST_VOL_ID, + session_ids = mixed, + new_names = nn, + vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[[1]], "success") + expect_equal(partial$status[[2]], "failed") + expect_equal(partial$status[[3]], "pending") +}) + +test_that("bulk_rename_sessions on_error collect runs all rows", { + ids <- vapply(seq_len(2), function(i) { + s <- create_session( + vol_id = TEST_VOL_ID, + name = sprintf("bulk_rename_sessions collect %d", i), + vb = FALSE + ) + if (is.null(s)) NA_real_ else as.numeric(s$id) + }, numeric(1)) + + if (any(is.na(ids))) { + testthat::skip("Could not create test sessions on staging.") + } + on.exit({ + for (id in ids) { + try(delete_session(TEST_VOL_ID, id, vb = FALSE), silent = TRUE) + } + }, add = TRUE) + + mixed <- c(ids[[1]], TEST_MISSING_ID, ids[[2]]) + nn <- c("c1", "c2", "c3") + + result <- bulk_rename_sessions( + vol_id = TEST_VOL_ID, + session_ids = mixed, + new_names = nn, + vb = FALSE, + on_error = "collect" + ) + + expect_s3_class(result, "tbl_df") + expect_equal(result$status, c("success", "failed", "success")) +}) diff --git a/tests/testthat/test-bulk_unassign_records.R b/tests/testthat/test-bulk_unassign_records.R new file mode 100644 index 00000000..d3e4bf81 --- /dev/null +++ b/tests/testthat/test-bulk_unassign_records.R @@ -0,0 +1,102 @@ +# bulk_unassign_records() ----------------------------------------------------- +login_test_account() + +test_that("bulk_unassign_records rejects invalid args", { + expect_error(bulk_unassign_records(vol_id = -1, session_id = 1L, record_ids = 1L)) + expect_error(bulk_unassign_records(vol_id = 1L, session_id = -1L, record_ids = 1L)) + expect_error(bulk_unassign_records(vol_id = 1L, session_id = 1L, record_ids = numeric(0))) +}) + +test_that("bulk_unassign_records removes defaults for multiple records", { + uniq <- sprintf( + "bulk_ur_%s_%s", + as.integer(Sys.time()), + paste(sample(letters, 6, replace = TRUE), collapse = "") + ) + sid <- make_test_session(sprintf("%s_sess", uniq), vb = FALSE) + skip_if_null_response(sid, "make_test_session") + + r1 <- make_test_record(sprintf("%s_r1", uniq), vb = FALSE) + r2 <- make_test_record(sprintf("%s_r2", uniq), vb = FALSE) + skip_if_null_response(r1, "make_test_record 1") + skip_if_null_response(r2, "make_test_record 2") + + asg <- bulk_assign_records( + vol_id = TEST_VOL_ID, + session_id = sid, + record_ids = c(r1, r2), + vb = FALSE + ) + expect_true(all(asg$status == "success")) + + result <- bulk_unassign_records( + vol_id = TEST_VOL_ID, + session_id = sid, + record_ids = c(r1, r2), + vb = FALSE + ) + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 2) + expect_true(all(result$status == "success")) +}) + +test_that("bulk_unassign_records fast-fails when record is not a default", { + sid <- make_test_session("bulk_unassign_records ff", vb = FALSE) + skip_if_null_response(sid, "make_test_session") + + r1 <- make_test_record("bulk_unassign_records ff r", vb = FALSE) + skip_if_null_response(r1, "make_test_record") + + add_default_record_to_session(TEST_VOL_ID, sid, r1, vb = FALSE) + + mixed <- c(r1, TEST_MISSING_ID) + + partial <- tryCatch( + bulk_unassign_records( + vol_id = TEST_VOL_ID, + session_id = sid, + record_ids = mixed, + vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[[1]], "success") + expect_equal(partial$status[[2]], "failed") +}) + +test_that("bulk_unassign_records on_error collect runs all rows", { + sid <- make_test_session("bulk_unassign_records collect", vb = FALSE) + skip_if_null_response(sid, "make_test_session") + + created <- bulk_create_records( + vol_id = TEST_VOL_ID, + record_names = c("bulk_ur_c1", "bulk_ur_c2"), + category_id = TEST_CATEGORY_ID, + vb = FALSE + ) + skip_if_null_response(created, "bulk_create_records") + + ids <- vapply(created$result, function(r) as.integer(r$record_id), integer(1)) + on.exit({ + for (id in ids) { + try(delete_volume_record(TEST_VOL_ID, id, vb = FALSE), silent = TRUE) + } + }, add = TRUE) + + bulk_assign_records(TEST_VOL_ID, sid, ids, vb = FALSE) + + mixed <- c(ids[[1]], TEST_MISSING_ID, ids[[2]]) + result <- bulk_unassign_records( + vol_id = TEST_VOL_ID, + session_id = sid, + record_ids = mixed, + vb = FALSE, + on_error = "collect" + ) + + expect_s3_class(result, "tbl_df") + expect_equal(result$status, c("success", "failed", "success")) +}) diff --git a/tests/testthat/test-bulk_upload_files.R b/tests/testthat/test-bulk_upload_files.R new file mode 100644 index 00000000..06a0a38f --- /dev/null +++ b/tests/testthat/test-bulk_upload_files.R @@ -0,0 +1,339 @@ +# bulk_upload_files() --------------------------------------------------------- +login_test_account() + +# Argument validation (no API) ------------------------------------------------ + +test_that("bulk_upload_files rejects invalid args", { + tf <- tempfile(fileext = ".txt") + writeLines("ok", tf) + on.exit(unlink(tf), add = TRUE) + expect_error(bulk_upload_files( + vol_id = 1, file_paths = tf + ), regexp = "Exactly one of session_id and folder_id") + expect_error(bulk_upload_files( + vol_id = 1, session_id = 1, folder_id = 2, file_paths = tf + ), regexp = "Exactly one of session_id and folder_id") + + expect_error(bulk_upload_files( + vol_id = -1, session_id = 1, file_paths = "x" + )) + expect_error(bulk_upload_files( + vol_id = 1, session_id = 0, file_paths = "x" + )) + expect_error(bulk_upload_files( + vol_id = 1, session_id = 1, file_paths = character(0) + )) + expect_error(bulk_upload_files( + vol_id = 1, session_id = 1, file_paths = c("/nope/does/not/exist") + )) + expect_error(bulk_upload_files( + vol_id = 1, session_id = 1, file_paths = c("a", NA) + )) +}) + +# Internal helpers ------------------------------------------------------------ + +test_that("init_bulk_tibble initializes one pending row per input", { + t <- databraryr:::init_bulk_tibble(c("a", "b", "c")) + expect_s3_class(t, "tbl_df") + expect_equal(nrow(t), 3) + expect_equal(t$status, rep("pending", 3)) + expect_true(all(is.na(t$error))) + expect_true(all(is.na(t$reason))) + expect_equal(length(t$result), 3) +}) + +test_that("bulk_apply succeeds when fn returns non-NULL", { + state <- databraryr:::bulk_apply( + inputs = c(1, 2, 3), + fn = function(x) x * 10 + ) + expect_equal(state$status, rep("success", 3)) + expect_equal(unlist(state$result), c(10, 20, 30)) +}) + +test_that("bulk_apply fast-fails and carries partial state", { + err <- tryCatch( + databraryr:::bulk_apply( + inputs = c(1, 2, 3), + fn = function(x) if (x == 2) NULL else x + ), + databraryr_bulk_error = function(e) e + ) + expect_s3_class(err, "databraryr_bulk_error") + expect_equal(err$failed_input, 2) + expect_equal(err$partial$status, c("success", "failed", "pending")) + expect_equal(err$partial$result[[1]], 1) + expect_false(is.na(err$partial$error[2])) +}) + +test_that("bulk_apply respects custom is_failure predicate", { + err <- tryCatch( + databraryr:::bulk_apply( + inputs = c(1, 2), + fn = function(x) FALSE, + is_failure = function(res) isFALSE(res) + ), + databraryr_bulk_error = function(e) e + ) + expect_s3_class(err, "databraryr_bulk_error") + expect_equal(err$failed_input, 1) +}) + +test_that("bulk_apply catches errors thrown by fn", { + err <- tryCatch( + databraryr:::bulk_apply( + inputs = c(1, 2), + fn = function(x) stop("boom") + ), + databraryr_bulk_error = function(e) e + ) + expect_s3_class(err, "databraryr_bulk_error") + expect_match(err$partial$error[1], "boom") +}) + +test_that("bulk_apply collect mode records failures and continues", { + state <- databraryr:::bulk_apply( + inputs = c(1, 2, 3), + fn = function(x) if (x == 2) NULL else x * 10, + on_error = "collect" + ) + expect_equal(state$status, c("success", "failed", "success")) + expect_equal(state$result[[1]], 10) + expect_true(is.null(state$result[[2]])) + expect_equal(state$result[[3]], 30) + expect_false(is.na(state$error[2])) + expect_true(is.na(state$error[1])) + expect_true(is.na(state$error[3])) +}) + +test_that("bulk_apply retries failed invocations up to max_retries", { + n_try <- 0L + state <- databraryr:::bulk_apply( + inputs = 1, + fn = function(x) { + n_try <<- n_try + 1L + if (n_try < 3L) NULL else 99L + }, + max_retries = 2L + ) + expect_equal(n_try, 3L) + expect_equal(state$status, "success") + expect_equal(state$result[[1]], 99L) + + n_try2 <- 0L + err <- tryCatch( + databraryr:::bulk_apply( + inputs = 1, + fn = function(x) { + n_try2 <<- n_try2 + 1L + NULL + }, + max_retries = 1L + ), + databraryr_bulk_error = function(e) e + ) + expect_equal(n_try2, 2L) + expect_s3_class(err, "databraryr_bulk_error") +}) + +# End-to-end live API tests --------------------------------------------------- + +test_that("bulk_upload_files uploads multiple files end-to-end", { + session <- create_session( + vol_id = TEST_VOL_ID, name = "bulk_upload test", vb = FALSE + ) + skip_if_null_response(session, "create_session for bulk_upload_files") + on.exit( + delete_session(vol_id = TEST_VOL_ID, session_id = session$id, vb = FALSE), + add = TRUE + ) + + paths <- vapply(seq_len(3), function(i) { + p <- tempfile(pattern = sprintf("bulk_%d_", i), fileext = ".txt") + writeLines(strrep("x", 512L), p, useBytes = FALSE) + p + }, character(1)) + on.exit(unlink(paths), add = TRUE) + + result <- bulk_upload_files( + vol_id = TEST_VOL_ID, + session_id = session$id, + file_paths = paths, + preflight = FALSE, + vb = FALSE + ) + skip_if_null_response(result, "bulk_upload_files e2e") + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 3) + expect_equal(result$input, paths) + expect_true(all(result$status == "success")) +}) + +test_that("bulk_upload_files uploads multiple files to a folder end-to-end", { + fid <- make_test_folder("bulk_upload folder e2e", vb = FALSE) + skip_if_null_response(fid, "make_test_folder for bulk_upload folder e2e") + + paths <- vapply(seq_len(2), function(i) { + p <- tempfile(pattern = sprintf("bulk_folder_%d_", i), fileext = ".txt") + writeLines(strrep("x", 512L), p, useBytes = FALSE) + p + }, character(1)) + on.exit(unlink(paths), add = TRUE) + + result <- bulk_upload_files( + vol_id = TEST_VOL_ID, + session_id = NULL, + file_paths = paths, + folder_id = fid, + preflight = FALSE, + vb = FALSE + ) + skip_if_null_response(result, "bulk_upload_files folder e2e") + + expect_s3_class(result, "tbl_df") + expect_equal(nrow(result), 2) + expect_equal(result$input, paths) + expect_true(all(result$status == "success")) +}) + +test_that("bulk_upload_files preflight skips duplicate filenames", { + session <- create_session( + vol_id = TEST_VOL_ID, name = "bulk_upload preflight test", vb = FALSE + ) + skip_if_null_response(session, "create_session for preflight test") + on.exit( + delete_session(vol_id = TEST_VOL_ID, session_id = session$id, vb = FALSE), + add = TRUE + ) + + p <- tempfile(pattern = "preflight_", fileext = ".txt") + writeLines(strrep("x", 512L), p, useBytes = FALSE) + on.exit(unlink(p), add = TRUE) + + first <- bulk_upload_files( + vol_id = TEST_VOL_ID, session_id = session$id, file_paths = p, + preflight = FALSE, vb = FALSE + ) + skip_if_null_response(first, "first upload for preflight test") + expect_true(first$status == "success") + + # Listing used by preflight can lag behind upload_file success on staging. + bn <- basename(p) + deadline <- Sys.time() + 60 + visible <- FALSE + while (Sys.time() < deadline) { + dup <- check_duplicate_files_in_session( + vol_id = TEST_VOL_ID, + session_id = session$id, + filenames = bn, + vb = FALSE + ) + if (!is.null(dup) && nrow(dup) == 1L && isTRUE(dup$exists[[1L]])) { + visible <- TRUE + break + } + Sys.sleep(0.5) + } + skip_if(!visible, "upload not yet visible for duplicate preflight on staging") + + again <- bulk_upload_files( + vol_id = TEST_VOL_ID, session_id = session$id, file_paths = p, + preflight = TRUE, vb = FALSE + ) + expect_equal(again$status, "skipped") + expect_equal(again$reason, "duplicate") +}) + +test_that("bulk_upload_files folder preflight skips duplicate filenames", { + fid <- make_test_folder("bulk_upload folder preflight", vb = FALSE) + skip_if_null_response(fid, "make_test_folder for folder preflight") + + p <- tempfile(pattern = "preflight_folder_", fileext = ".txt") + writeLines(strrep("x", 512L), p, useBytes = FALSE) + on.exit(unlink(p), add = TRUE) + + first <- bulk_upload_files( + vol_id = TEST_VOL_ID, + session_id = NULL, + file_paths = p, + folder_id = fid, + preflight = FALSE, + vb = FALSE + ) + skip_if_null_response(first, "first folder upload for preflight test") + expect_true(first$status == "success") + + bn <- basename(p) + deadline <- Sys.time() + 60 + visible <- FALSE + while (Sys.time() < deadline) { + dup <- check_duplicate_files_in_folder( + vol_id = TEST_VOL_ID, + folder_id = fid, + filenames = bn, + vb = FALSE + ) + if (!is.null(dup) && nrow(dup) == 1L && isTRUE(dup$exists[[1L]])) { + visible <- TRUE + break + } + Sys.sleep(0.5) + } + skip_if(!visible, "folder upload not yet visible for duplicate preflight") + + again <- bulk_upload_files( + vol_id = TEST_VOL_ID, + session_id = NULL, + file_paths = p, + folder_id = fid, + preflight = TRUE, + vb = FALSE + ) + expect_equal(again$status, "skipped") + expect_equal(again$reason, "duplicate") +}) + +test_that("bulk_upload_files fast-fails and supports resume", { + session <- create_session( + vol_id = TEST_VOL_ID, name = "bulk_upload resume test", vb = FALSE + ) + skip_if_null_response(session, "create_session for resume test") + on.exit( + delete_session(vol_id = TEST_VOL_ID, session_id = session$id, vb = FALSE), + add = TRUE + ) + + good <- tempfile(pattern = "good_", fileext = ".txt") + writeLines(strrep("x", 512L), good, useBytes = FALSE) + on.exit(unlink(good), add = TRUE) + + bad_inputs <- c(good, good) + partial <- tryCatch( + bulk_upload_files( + vol_id = TEST_VOL_ID, + session_id = 999999999, + file_paths = bad_inputs, + preflight = FALSE, + vb = FALSE + ), + databraryr_bulk_error = function(e) e$partial + ) + + skip_if(is.null(partial), "expected fast-fail did not occur") + expect_s3_class(partial, "tbl_df") + expect_equal(partial$status[1], "failed") + expect_equal(partial$status[2], "pending") + + resumed <- resume_bulk( + partial, + bulk_upload_files, + vol_id = TEST_VOL_ID, + session_id = session$id, + preflight = FALSE, + vb = FALSE + ) + skip_if_null_response(resumed, "bulk_upload_files resume") + expect_true(all(resumed$status == "success")) +}) diff --git a/tests/testthat/test-check_duplicate_files_in_folder.R b/tests/testthat/test-check_duplicate_files_in_folder.R new file mode 100644 index 00000000..b946afa2 --- /dev/null +++ b/tests/testthat/test-check_duplicate_files_in_folder.R @@ -0,0 +1,141 @@ +# check_duplicate_files_in_folder() -------------------------------------------- +login_test_account() + +test_that("check_duplicate_files_in_folder returns a tibble for an empty folder", { + fid <- make_test_folder("check_duplicate_files_in_folder happy path") + skip_if_null_response(fid, "create_folder for check_duplicate_files happy path") + + filenames <- c("nonexistent_a.mp4", "nonexistent_b.mp4") + result <- check_duplicate_files_in_folder( + vol_id = TEST_VOL_ID, + folder_id = fid, + filenames = filenames, + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_folder(empty folder)") + + expect_s3_class(result, "tbl_df") + expect_named(result, c("filename", "exists")) + expect_equal(nrow(result), length(filenames)) + expect_equal(result$filename, filenames) + expect_type(result$exists, "logical") + expect_true(all(!result$exists)) +}) + +test_that("check_duplicate_files_in_folder preserves input order", { + fid <- make_test_folder("check_duplicate_files_in_folder order") + skip_if_null_response(fid, "create_folder for order test") + + filenames <- c("z.mp4", "a.mp4", "m.mp4") + result <- check_duplicate_files_in_folder( + vol_id = TEST_VOL_ID, + folder_id = fid, + filenames = filenames, + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_folder(order)") + + expect_equal(result$filename, filenames) +}) + +test_that("check_duplicate_files_in_folder works with a single filename", { + fid <- make_test_folder("check_duplicate_files_in_folder single") + skip_if_null_response(fid, "create_folder for single filename test") + + result <- check_duplicate_files_in_folder( + vol_id = TEST_VOL_ID, + folder_id = fid, + filenames = "only.mp4", + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_folder(single)") + + expect_equal(nrow(result), 1L) + expect_equal(result$filename, "only.mp4") + expect_false(result$exists) +}) + +test_that("check_duplicate_files_in_folder treats missing folder like empty (all not found)", { + result <- check_duplicate_files_in_folder( + vol_id = TEST_VOL_ID, + folder_id = TEST_MISSING_ID, + filenames = c("a.mp4"), + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_folder(non-existent folder)") + expect_s3_class(result, "tbl_df") + expect_equal(result$filename, "a.mp4") + expect_false(result$exists) +}) + +test_that("check_duplicate_files_in_folder works with verbose mode", { + fid <- make_test_folder("check_duplicate_files_in_folder vb") + skip_if_null_response(fid, "create_folder for check_duplicate_files vb") + + result <- check_duplicate_files_in_folder( + vol_id = TEST_VOL_ID, + folder_id = fid, + filenames = c("vb.mp4"), + vb = TRUE + ) + skip_if_null_response(result, "check_duplicate_files_in_folder vb") + expect_s3_class(result, "tbl_df") +}) + +test_that("check_duplicate_files_in_folder works with custom request object", { + fid <- make_test_folder("check_duplicate_files_in_folder custom rq") + skip_if_null_response(fid, "create_folder for check_duplicate_files custom rq") + + custom_rq <- databraryr::make_default_request() + result <- check_duplicate_files_in_folder( + vol_id = TEST_VOL_ID, + folder_id = fid, + filenames = c("custom.mp4"), + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_folder custom rq") + expect_s3_class(result, "tbl_df") +}) + +test_that("check_duplicate_files_in_folder rejects invalid filenames", { + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = character(0))) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = NULL)) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = 123)) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = list("a"))) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = TRUE)) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = c("a", NA))) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = c("a", ""))) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = c("a", " "))) +}) + +test_that("check_duplicate_files_in_folder rejects invalid vol_id", { + expect_error(check_duplicate_files_in_folder(vol_id = -1, folder_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 0, folder_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = "1", folder_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = TRUE, folder_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = c(1, 2), folder_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 1.5, folder_id = 1, filenames = "a")) +}) + +test_that("check_duplicate_files_in_folder rejects invalid folder_id", { + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = -1, filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 0, filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = "1", filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = TRUE, filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = c(1, 2), filenames = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1.5, filenames = "a")) +}) + +test_that("check_duplicate_files_in_folder rejects invalid vb parameter", { + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = "a", vb = -1)) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = "a", vb = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = "a", vb = c(TRUE, FALSE))) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = "a", vb = NULL)) +}) + +test_that("check_duplicate_files_in_folder rejects invalid rq parameter", { + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = "a", rq = "a")) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = "a", rq = -1)) + expect_error(check_duplicate_files_in_folder(vol_id = 1, folder_id = 1, filenames = "a", rq = TRUE)) +}) diff --git a/tests/testthat/test-check_duplicate_files_in_session.R b/tests/testthat/test-check_duplicate_files_in_session.R new file mode 100644 index 00000000..db2e9ec8 --- /dev/null +++ b/tests/testthat/test-check_duplicate_files_in_session.R @@ -0,0 +1,142 @@ +# check_duplicate_files_in_session() ------------------------------------------- +login_test_account() + +test_that("check_duplicate_files_in_session returns a tibble for an empty session", { + sid <- make_test_session("check_duplicate_files happy path") + skip_if_null_response(sid, "create_session for check_duplicate_files happy path") + + filenames <- c("nonexistent_a.mp4", "nonexistent_b.mp4") + result <- check_duplicate_files_in_session( + vol_id = TEST_VOL_ID, + session_id = sid, + filenames = filenames, + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_session(empty session)") + + expect_s3_class(result, "tbl_df") + expect_named(result, c("filename", "exists")) + expect_equal(nrow(result), length(filenames)) + expect_equal(result$filename, filenames) + expect_type(result$exists, "logical") + expect_true(all(!result$exists)) +}) + +test_that("check_duplicate_files_in_session preserves input order", { + sid <- make_test_session("check_duplicate_files order") + skip_if_null_response(sid, "create_session for order test") + + filenames <- c("z.mp4", "a.mp4", "m.mp4") + result <- check_duplicate_files_in_session( + vol_id = TEST_VOL_ID, + session_id = sid, + filenames = filenames, + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_session(order)") + + expect_equal(result$filename, filenames) +}) + +test_that("check_duplicate_files_in_session works with a single filename", { + sid <- make_test_session("check_duplicate_files single") + skip_if_null_response(sid, "create_session for single filename test") + + result <- check_duplicate_files_in_session( + vol_id = TEST_VOL_ID, + session_id = sid, + filenames = "only.mp4", + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_session(single)") + + expect_equal(nrow(result), 1L) + expect_equal(result$filename, "only.mp4") + expect_false(result$exists) +}) + +test_that("check_duplicate_files_in_session treats missing session like empty (all not found)", { + # Backend does not require the session to exist; it queries files by session_id only. + result <- check_duplicate_files_in_session( + vol_id = TEST_VOL_ID, + session_id = TEST_MISSING_ID, + filenames = c("a.mp4"), + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_session(non-existent session)") + expect_s3_class(result, "tbl_df") + expect_equal(result$filename, "a.mp4") + expect_false(result$exists) +}) + +test_that("check_duplicate_files_in_session works with verbose mode", { + sid <- make_test_session("check_duplicate_files vb") + skip_if_null_response(sid, "create_session for check_duplicate_files vb") + + result <- check_duplicate_files_in_session( + vol_id = TEST_VOL_ID, + session_id = sid, + filenames = c("vb.mp4"), + vb = TRUE + ) + skip_if_null_response(result, "check_duplicate_files_in_session vb") + expect_s3_class(result, "tbl_df") +}) + +test_that("check_duplicate_files_in_session works with custom request object", { + sid <- make_test_session("check_duplicate_files custom rq") + skip_if_null_response(sid, "create_session for check_duplicate_files custom rq") + + custom_rq <- databraryr::make_default_request() + result <- check_duplicate_files_in_session( + vol_id = TEST_VOL_ID, + session_id = sid, + filenames = c("custom.mp4"), + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "check_duplicate_files_in_session custom rq") + expect_s3_class(result, "tbl_df") +}) + +test_that("check_duplicate_files_in_session rejects invalid filenames", { + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = character(0))) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = NULL)) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = 123)) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = list("a"))) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = TRUE)) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = c("a", NA))) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = c("a", ""))) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = c("a", " "))) +}) + +test_that("check_duplicate_files_in_session rejects invalid vol_id", { + expect_error(check_duplicate_files_in_session(vol_id = -1, session_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 0, session_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = "1", session_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = TRUE, session_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = c(1, 2), session_id = 1, filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 1.5, session_id = 1, filenames = "a")) +}) + +test_that("check_duplicate_files_in_session rejects invalid session_id", { + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = -1, filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 0, filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = "1", filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = TRUE, filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = c(1, 2), filenames = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1.5, filenames = "a")) +}) + +test_that("check_duplicate_files_in_session rejects invalid vb parameter", { + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = "a", vb = -1)) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = "a", vb = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = "a", vb = c(TRUE, FALSE))) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = "a", vb = NULL)) +}) + +test_that("check_duplicate_files_in_session rejects invalid rq parameter", { + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = "a", rq = "a")) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = "a", rq = -1)) + expect_error(check_duplicate_files_in_session(vol_id = 1, session_id = 1, filenames = "a", rq = TRUE)) +}) diff --git a/tests/testthat/test-complete_upload.R b/tests/testthat/test-complete_upload.R new file mode 100644 index 00000000..4b162f9f --- /dev/null +++ b/tests/testthat/test-complete_upload.R @@ -0,0 +1,55 @@ +# complete_upload() ------------------------------------------------------------ +login_test_account() + +test_that("complete_upload validates required args", { + expect_error(complete_upload( + upload_guid = "", s3_upload_id = "x", + parts = list(list(part_number = 1L, etag = "e")) + )) + expect_error(complete_upload( + upload_guid = "g", s3_upload_id = "", + parts = list(list(part_number = 1L, etag = "e")) + )) + expect_error(complete_upload( + upload_guid = "g", s3_upload_id = "x", parts = list() + )) + expect_error(complete_upload( + upload_guid = "g", s3_upload_id = "x", + parts = list(list(part_number = 0L, etag = "e")) + )) + expect_error(complete_upload( + upload_guid = "g", s3_upload_id = "x", + parts = list(list(part_number = 1L, etag = "")) + )) + expect_error(complete_upload( + upload_guid = "g", s3_upload_id = "x", + parts = list(list(part_number = 1L)) + )) + expect_error(complete_upload( + upload_guid = "g", s3_upload_id = "x", + parts = list(list(etag = "e")) + )) +}) + +test_that("complete_upload returns NULL for unknown upload_guid", { + res <- complete_upload( + upload_guid = "00000000-0000-0000-0000-000000000000", + s3_upload_id = "not-a-real-upload-id", + parts = list(list(part_number = 1L, etag = "deadbeef")), + vb = FALSE + ) + expect_null(res) +}) + +test_that("complete_upload rejects invalid vb / rq", { + expect_error(complete_upload( + upload_guid = "g", s3_upload_id = "x", + parts = list(list(part_number = 1L, etag = "e")), + vb = "yes" + )) + expect_error(complete_upload( + upload_guid = "g", s3_upload_id = "x", + parts = list(list(part_number = 1L, etag = "e")), + rq = "not-a-request" + )) +}) diff --git a/tests/testthat/test-create_folder.R b/tests/testthat/test-create_folder.R new file mode 100644 index 00000000..34d970e4 --- /dev/null +++ b/tests/testthat/test-create_folder.R @@ -0,0 +1,166 @@ +# create_folder() -------------------------------------------------------------- +login_test_account() + +test_that("create_folder creates a folder with name only", { + result <- create_folder(vol_id = TEST_VOL_ID, name = "Test folder", vb = FALSE) + skip_if_null_response(result, "create_folder happy path") + + on.exit( + { + if (!is.null(result$id)) { + delete_folder(vol_id = TEST_VOL_ID, folder_id = result$id, vb = FALSE) + } + }, + add = TRUE + ) + + expect_type(result, "list") + expect_true(!is.null(result$id)) + expect_true(is.numeric(result$id) || is.integer(result$id)) + expect_true(result$id > 0) + expect_equal(as.integer(result$volume), TEST_VOL_ID) + expect_equal(result$name, "Test folder") +}) + +test_that("create_folder accepts a Date source_date", { + result <- create_folder( + vol_id = TEST_VOL_ID, + name = "Test folder with Date", + source_date = as.Date("2024-03-15"), + vb = FALSE + ) + skip_if_null_response(result, "create_folder with Date source_date") + + on.exit( + { + if (!is.null(result$id)) { + delete_folder(vol_id = TEST_VOL_ID, folder_id = result$id, vb = FALSE) + } + }, + add = TRUE + ) + + expect_type(result, "list") + expect_true(!is.null(result$id)) +}) + +test_that("create_folder accepts an ISO string source_date", { + result <- create_folder( + vol_id = TEST_VOL_ID, + name = "Test folder with ISO date", + source_date = "2024-03-15", + vb = FALSE + ) + skip_if_null_response(result, "create_folder with ISO source_date") + + on.exit( + { + if (!is.null(result$id)) { + delete_folder(vol_id = TEST_VOL_ID, folder_id = result$id, vb = FALSE) + } + }, + add = TRUE + ) + + expect_type(result, "list") +}) + +test_that("create_folder works with verbose mode", { + result <- create_folder( + vol_id = TEST_VOL_ID, + name = "Test folder vb", + vb = TRUE + ) + skip_if_null_response(result, "create_folder with vb = TRUE") + + on.exit( + { + if (!is.null(result$id)) { + delete_folder(vol_id = TEST_VOL_ID, folder_id = result$id, vb = FALSE) + } + }, + add = TRUE + ) + + expect_type(result, "list") +}) + +test_that("create_folder works with custom request object", { + custom_rq <- databraryr::make_default_request() + result <- create_folder( + vol_id = TEST_VOL_ID, + name = "Test folder custom rq", + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "create_folder with custom_rq") + + on.exit( + { + if (!is.null(result$id)) { + delete_folder(vol_id = TEST_VOL_ID, folder_id = result$id, vb = FALSE) + } + }, + add = TRUE + ) + + expect_type(result, "list") +}) + +test_that("create_folder returns NULL for non-existent volume", { + expect_null(create_folder(vol_id = TEST_MISSING_ID, name = "Test", vb = FALSE)) +}) + +test_that("create_folder rejects invalid name", { + expect_error(create_folder(vol_id = 1, name = "")) + expect_error(create_folder(vol_id = 1, name = " ")) + expect_error(create_folder(vol_id = 1, name = 123)) + expect_error(create_folder(vol_id = 1, name = c("A", "B"))) + expect_error(create_folder(vol_id = 1, name = NULL)) + expect_error(create_folder(vol_id = 1, name = NA)) +}) + +test_that("create_folder rejects malformed source_date", { + expect_error(create_folder(vol_id = 1, name = "Test", source_date = "not-a-date")) + expect_error(create_folder(vol_id = 1, name = "Test", source_date = "")) + expect_error(create_folder(vol_id = 1, name = "Test", source_date = 123)) + expect_error( + create_folder( + vol_id = 1, + name = "Test", + source_date = as.Date(c("2024-01-01", "2024-02-01")) + ) + ) +}) + +test_that("create_folder rejects invalid release_level", { + expect_error(create_folder(vol_id = 1, name = "Test", release_level = "")) + expect_error(create_folder(vol_id = 1, name = "Test", release_level = 1)) + expect_error(create_folder(vol_id = 1, name = "Test", release_level = c("A", "B"))) +}) + +test_that("create_folder rejects invalid vol_id", { + expect_error(create_folder(vol_id = -1, name = "Test")) + expect_error(create_folder(vol_id = 0, name = "Test")) + expect_error(create_folder(vol_id = "1", name = "Test")) + expect_error(create_folder(vol_id = TRUE, name = "Test")) + expect_error(create_folder(vol_id = list(a = 1), name = "Test")) + expect_error(create_folder(vol_id = c(1, 2), name = "Test")) + expect_error(create_folder(vol_id = 1.5, name = "Test")) +}) + +test_that("create_folder rejects invalid vb parameter", { + expect_error(create_folder(vol_id = 1, name = "Test", vb = -1)) + expect_error(create_folder(vol_id = 1, name = "Test", vb = "a")) + expect_error(create_folder(vol_id = 1, name = "Test", vb = list(a = 1))) + expect_error(create_folder(vol_id = 1, name = "Test", vb = c(TRUE, FALSE))) + expect_error(create_folder(vol_id = 1, name = "Test", vb = NULL)) +}) + +test_that("create_folder rejects invalid rq parameter", { + expect_error(create_folder(vol_id = 1, name = "Test", rq = "a")) + expect_error(create_folder(vol_id = 1, name = "Test", rq = -1)) + expect_error(create_folder(vol_id = 1, name = "Test", rq = c(2, 3))) + expect_error(create_folder(vol_id = 1, name = "Test", rq = list(a = 1))) + expect_error(create_folder(vol_id = 1, name = "Test", rq = TRUE)) +}) diff --git a/tests/testthat/test-create_session.R b/tests/testthat/test-create_session.R new file mode 100644 index 00000000..4a1ab8d0 --- /dev/null +++ b/tests/testthat/test-create_session.R @@ -0,0 +1,170 @@ +# create_session() ------------------------------------------------------------- +login_test_account() + +test_that("create_session creates a session with name only", { + result <- create_session(vol_id = TEST_VOL_ID, name = "Test session", vb = FALSE) + skip_if_null_response(result, "create_session(vol_id = TEST_VOL_ID, name = 'Test session')") + + on.exit(delete_session(vol_id = TEST_VOL_ID, session_id = result$id, vb = FALSE), add = TRUE) + + expect_type(result, "list") + expect_true(!is.null(result$id)) + expect_true(is.numeric(result$id) || is.integer(result$id)) + expect_true(result$id > 0) + expect_equal(result$name, "Test session") + # POST create returns SessionWriteSerializer data (no nested `volume`); confirm volume via GET. + fetched <- get_session_by_id(session_id = result$id, vol_id = TEST_VOL_ID, vb = FALSE) + skip_if_null_response(fetched, "get_session_by_id after create_session") + v <- fetched$volume + vol_id_actual <- if (is.list(v) && !is.null(v$id)) { + as.integer(v$id) + } else { + as.integer(v) + } + expect_equal(vol_id_actual, as.integer(TEST_VOL_ID)) +}) + +test_that("create_session accepts a Date source_date", { + result <- create_session( + vol_id = TEST_VOL_ID, + name = "Test session with Date", + source_date = as.Date("2024-03-15"), + vb = FALSE + ) + skip_if_null_response(result, "create_session with Date source_date") + + on.exit(delete_session(vol_id = TEST_VOL_ID, session_id = result$id, vb = FALSE), add = TRUE) + + expect_type(result, "list") + expect_true(!is.null(result$id)) +}) + +test_that("create_session accepts an ISO string source_date", { + result <- create_session( + vol_id = TEST_VOL_ID, + name = "Test session with ISO date", + source_date = "2024-03-15", + vb = FALSE + ) + skip_if_null_response(result, "create_session with ISO source_date") + + on.exit(delete_session(vol_id = TEST_VOL_ID, session_id = result$id, vb = FALSE), add = TRUE) + + expect_type(result, "list") +}) + +test_that("create_session works with verbose mode", { + result <- create_session( + vol_id = TEST_VOL_ID, + name = "Test session vb", + vb = TRUE + ) + skip_if_null_response(result, "create_session with vb = TRUE") + + on.exit(delete_session(vol_id = TEST_VOL_ID, session_id = result$id, vb = FALSE), add = TRUE) + + expect_type(result, "list") +}) + +test_that("create_session works with custom request object", { + custom_rq <- databraryr::make_default_request() + result <- create_session( + vol_id = TEST_VOL_ID, + name = "Test session custom rq", + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "create_session with custom_rq") + + on.exit(delete_session(vol_id = TEST_VOL_ID, session_id = result$id, vb = FALSE), add = TRUE) + + expect_type(result, "list") +}) + +test_that("create_session returns NULL for non-existent volume", { + expect_null(create_session(vol_id = TEST_MISSING_ID, name = "Test", vb = FALSE)) +}) + +test_that("create_session rejects invalid name", { + expect_error(create_session(vol_id = 1, name = "")) + expect_error(create_session(vol_id = 1, name = " ")) + expect_error(create_session(vol_id = 1, name = 123)) + expect_error(create_session(vol_id = 1, name = c("A", "B"))) + expect_error(create_session(vol_id = 1, name = NULL)) + expect_error(create_session(vol_id = 1, name = NA)) +}) + +test_that("create_session rejects providing both source_date and date", { + expect_error( + create_session( + vol_id = 1, + name = "Test", + source_date = "2024-03-15", + date = list(year = 2024, month = 3, day = 15) + ) + ) +}) + +test_that("create_session rejects malformed source_date", { + expect_error(create_session(vol_id = 1, name = "Test", source_date = "not-a-date")) + expect_error(create_session(vol_id = 1, name = "Test", source_date = "")) + expect_error(create_session(vol_id = 1, name = "Test", source_date = 123)) + expect_error( + create_session( + vol_id = 1, + name = "Test", + source_date = as.Date(c("2024-01-01", "2024-02-01")) + ) + ) +}) + +test_that("create_session rejects malformed date list", { + expect_error(create_session(vol_id = 1, name = "Test", date = "2024-03-15")) + expect_error(create_session(vol_id = 1, name = "Test", date = list(2024, 3, 15))) +}) + +test_that("create_session rejects invalid release_level", { + expect_error(create_session(vol_id = 1, name = "Test", release_level = "")) + expect_error(create_session(vol_id = 1, name = "Test", release_level = 1)) + expect_error(create_session(vol_id = 1, name = "Test", release_level = c("A", "B"))) +}) + +test_that("create_session rejects invalid date_precision", { + expect_error(create_session(vol_id = 1, name = "Test", date_precision = "")) + expect_error(create_session(vol_id = 1, name = "Test", date_precision = 1)) + expect_error(create_session(vol_id = 1, name = "Test", date_precision = c("FULL", "YEAR"))) +}) + +test_that("create_session rejects invalid default_records", { + expect_error(create_session(vol_id = 1, name = "Test", default_records = "1")) + expect_error(create_session(vol_id = 1, name = "Test", default_records = c(1, -2))) + expect_error(create_session(vol_id = 1, name = "Test", default_records = c(1, 0))) + expect_error(create_session(vol_id = 1, name = "Test", default_records = c(1.5, 2))) + expect_error(create_session(vol_id = 1, name = "Test", default_records = integer(0))) +}) + +test_that("create_session rejects invalid vol_id", { + expect_error(create_session(vol_id = -1, name = "Test")) + expect_error(create_session(vol_id = 0, name = "Test")) + expect_error(create_session(vol_id = "1", name = "Test")) + expect_error(create_session(vol_id = TRUE, name = "Test")) + expect_error(create_session(vol_id = list(a = 1), name = "Test")) + expect_error(create_session(vol_id = c(1, 2), name = "Test")) + expect_error(create_session(vol_id = 1.5, name = "Test")) +}) + +test_that("create_session rejects invalid vb parameter", { + expect_error(create_session(vol_id = 1, name = "Test", vb = -1)) + expect_error(create_session(vol_id = 1, name = "Test", vb = "a")) + expect_error(create_session(vol_id = 1, name = "Test", vb = list(a = 1))) + expect_error(create_session(vol_id = 1, name = "Test", vb = c(TRUE, FALSE))) + expect_error(create_session(vol_id = 1, name = "Test", vb = NULL)) +}) + +test_that("create_session rejects invalid rq parameter", { + expect_error(create_session(vol_id = 1, name = "Test", rq = "a")) + expect_error(create_session(vol_id = 1, name = "Test", rq = -1)) + expect_error(create_session(vol_id = 1, name = "Test", rq = c(2, 3))) + expect_error(create_session(vol_id = 1, name = "Test", rq = list(a = 1))) + expect_error(create_session(vol_id = 1, name = "Test", rq = TRUE)) +}) diff --git a/tests/testthat/test-create_volume_record.R b/tests/testthat/test-create_volume_record.R new file mode 100644 index 00000000..5b38057d --- /dev/null +++ b/tests/testthat/test-create_volume_record.R @@ -0,0 +1,175 @@ +# create_volume_record() ------------------------------------------------------- +login_test_account() + +test_that("create_volume_record creates a record with valid parameters", { + # Create a record with name (resolves required name metric from volume config) + result <- create_volume_record( + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, + name = "Test condition", + vb = FALSE + ) + skip_if_null_response(result, "create_volume_record(vol_id = TEST_VOL_ID, category_id = TEST_CATEGORY_ID, name = 'Test condition')") + + on.exit(delete_volume_record(vol_id = TEST_VOL_ID, record_id = result$record_id, vb = FALSE), add = TRUE) + + expect_type(result, "list") + expect_named(result, c( + "record_id", "record_volume", "record_volume_name", "record_category_id", + "measures", "birthday", "age", "default_sessions", "record_source_kind" + )) + expect_equal(as.integer(result$record_volume), as.integer(TEST_VOL_ID)) + expect_equal(result$record_category_id, TEST_CATEGORY_ID) + expect_true(is.numeric(result$record_id) || is.integer(result$record_id)) + expect_true(result$record_id > 0) +}) + +test_that("create_volume_record creates a record with measures", { + # Create a record by name (includes required name metric) + result <- create_volume_record( + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, + name = "Test condition", + vb = FALSE + ) + skip_if_null_response(result, "create_volume_record with name") + + on.exit(delete_volume_record(vol_id = TEST_VOL_ID, record_id = result$record_id, vb = FALSE), add = TRUE) + + expect_type(result, "list") + expect_true(!is.null(result$measures)) + expect_true(is.list(result$measures)) +}) + +test_that("create_volume_record creates a record with name and additional measures", { + # Optional metric TEST_METRIC_ID_EXTRA on TEST_CATEGORY_ID in TEST_VOL_ID (see create_volume_record tests). + result <- create_volume_record( + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, + name = "Task with extra measures", + measures = stats::setNames(list("Extra value"), as.character(TEST_METRIC_ID_EXTRA)), + vb = FALSE + ) + skip_if_null_response(result, "create_volume_record with name and measures") + + on.exit(delete_volume_record(vol_id = TEST_VOL_ID, record_id = result$record_id, vb = FALSE), add = TRUE) + + expect_type(result, "list") + expect_true(!is.null(result$measures)) + expect_true(length(result$measures) >= 2L) +}) + +test_that("create_volume_record rejects invalid name", { + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "")) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = " ")) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = 123)) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = c("A", "B"))) +}) + +test_that("create_volume_record returns NULL for non-existent volume", { + result <- create_volume_record( + vol_id = TEST_MISSING_ID, + category_id = TEST_CATEGORY_ID, + name = "Test", + vb = FALSE + ) + expect_null(result) +}) + +test_that("create_volume_record works with verbose mode", { + result <- create_volume_record( + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, + name = "Test condition vb", + vb = TRUE + ) + skip_if_null_response(result, "create_volume_record with vb = TRUE") + + on.exit(delete_volume_record(vol_id = TEST_VOL_ID, record_id = result$record_id, vb = FALSE), add = TRUE) + + expect_type(result, "list") + expect_true(!is.null(result$record_id)) +}) + +test_that("create_volume_record rejects invalid vol_id", { + # Negative ID + expect_error(create_volume_record(vol_id = -1, category_id = 1, name = "Test")) + + # Zero ID + expect_error(create_volume_record(vol_id = 0, category_id = 1, name = "Test")) + + # Non-numeric ID + expect_error(create_volume_record(vol_id = "1", category_id = 1, name = "Test")) + expect_error(create_volume_record(vol_id = TRUE, category_id = 1, name = "Test")) + expect_error(create_volume_record(vol_id = list(a = 1), category_id = 1, name = "Test")) + + # Multiple values + expect_error(create_volume_record(vol_id = c(1, 2), category_id = 1, name = "Test")) + + # Decimal/non-integer + expect_error(create_volume_record(vol_id = 1.5, category_id = 1, name = "Test")) +}) + +test_that("create_volume_record rejects invalid category_id", { + # Negative ID + expect_error(create_volume_record(vol_id = 1, category_id = -1, name = "Test")) + + # Zero ID + expect_error(create_volume_record(vol_id = 1, category_id = 0, name = "Test")) + + # Non-numeric ID + expect_error(create_volume_record(vol_id = 1, category_id = "1", name = "Test")) + expect_error(create_volume_record(vol_id = 1, category_id = TRUE, name = "Test")) + + # Multiple values + expect_error(create_volume_record(vol_id = 1, category_id = c(1, 2), name = "Test")) + + # Decimal/non-integer + expect_error(create_volume_record(vol_id = 1, category_id = 1.5, name = "Test")) +}) + +test_that("create_volume_record rejects invalid measures", { + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", measures = "text")) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", measures = 123)) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", measures = TRUE)) +}) + +test_that("create_volume_record rejects invalid participant", { + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", participant = "text")) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", participant = 123)) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", participant = TRUE)) +}) + +test_that("create_volume_record rejects invalid vb parameter", { + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", vb = -1)) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", vb = 3)) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", vb = "a")) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", vb = list(a = 1))) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", vb = c(TRUE, FALSE))) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", vb = NULL)) +}) + +test_that("create_volume_record rejects invalid rq parameter", { + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", rq = "a")) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", rq = -1)) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", rq = c(2, 3))) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", rq = list(a = 1))) + expect_error(create_volume_record(vol_id = 1, category_id = 1, name = "Test", rq = TRUE)) +}) + +test_that("create_volume_record works with custom request object", { + custom_rq <- databraryr::make_default_request() + result <- create_volume_record( + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, + name = "Test condition rq", + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "create_volume_record with custom_rq") + + on.exit(delete_volume_record(vol_id = TEST_VOL_ID, record_id = result$record_id, vb = FALSE), add = TRUE) + + expect_type(result, "list") + expect_true(!is.null(result$record_id)) +}) diff --git a/tests/testthat/test-delete_folder.R b/tests/testthat/test-delete_folder.R new file mode 100644 index 00000000..9853904f --- /dev/null +++ b/tests/testthat/test-delete_folder.R @@ -0,0 +1,101 @@ +# delete_folder() -------------------------------------------------------------- +login_test_account() + +test_that("delete_folder deletes an existing folder", { + created <- create_folder(vol_id = TEST_VOL_ID, name = "delete_folder happy path", vb = FALSE) + skip_if_null_response(created, "create_folder for delete_folder happy path") + + folder_id <- created$id + on.exit( + try(delete_folder(vol_id = TEST_VOL_ID, folder_id = folder_id, vb = FALSE), silent = TRUE), + add = TRUE + ) + + result <- delete_folder(vol_id = TEST_VOL_ID, folder_id = folder_id, vb = FALSE) + + expect_true(result) + + # Verify it's gone + expect_null(get_folder_by_id(folder_id = folder_id, vol_id = TEST_VOL_ID, vb = FALSE)) +}) + +test_that("delete_folder returns FALSE for non-existent folder", { + expect_false(delete_folder(vol_id = TEST_VOL_ID, folder_id = TEST_MISSING_ID, vb = FALSE)) +}) + +test_that("delete_folder works with verbose mode", { + created <- create_folder(vol_id = TEST_VOL_ID, name = "delete_folder vb", vb = FALSE) + skip_if_null_response(created, "create_folder for delete_folder vb") + + on.exit( + try(delete_folder(vol_id = TEST_VOL_ID, folder_id = created$id, vb = FALSE), silent = TRUE), + add = TRUE + ) + + expect_true(delete_folder(vol_id = TEST_VOL_ID, folder_id = created$id, vb = TRUE)) +}) + +test_that("delete_folder works with custom request object", { + created <- create_folder( + vol_id = TEST_VOL_ID, + name = "delete_folder custom rq", + vb = FALSE + ) + skip_if_null_response(created, "create_folder for delete_folder custom rq") + + on.exit( + try(delete_folder(vol_id = TEST_VOL_ID, folder_id = created$id, vb = FALSE), silent = TRUE), + add = TRUE + ) + + custom_rq <- databraryr::make_default_request() + expect_true( + delete_folder( + vol_id = TEST_VOL_ID, + folder_id = created$id, + rq = custom_rq, + vb = FALSE + ) + ) +}) + +test_that("delete_folder rejects invalid vol_id", { + expect_error(delete_folder(vol_id = -1, folder_id = 1)) + expect_error(delete_folder(vol_id = 0, folder_id = 1)) + expect_error(delete_folder(vol_id = "1", folder_id = 1)) + expect_error(delete_folder(vol_id = TRUE, folder_id = 1)) + expect_error(delete_folder(vol_id = list(a = 1), folder_id = 1)) + expect_error(delete_folder(vol_id = c(1, 2), folder_id = 1)) + expect_error(delete_folder(vol_id = 1.5, folder_id = 1)) + expect_error(delete_folder(vol_id = NULL, folder_id = 1)) + expect_error(delete_folder(vol_id = NA, folder_id = 1)) +}) + +test_that("delete_folder rejects invalid folder_id", { + expect_error(delete_folder(vol_id = 1, folder_id = -1)) + expect_error(delete_folder(vol_id = 1, folder_id = 0)) + expect_error(delete_folder(vol_id = 1, folder_id = "1")) + expect_error(delete_folder(vol_id = 1, folder_id = TRUE)) + expect_error(delete_folder(vol_id = 1, folder_id = list(a = 1))) + expect_error(delete_folder(vol_id = 1, folder_id = c(1, 2))) + expect_error(delete_folder(vol_id = 1, folder_id = 1.5)) + expect_error(delete_folder(vol_id = 1, folder_id = NULL)) + expect_error(delete_folder(vol_id = 1, folder_id = NA)) +}) + +test_that("delete_folder rejects invalid vb parameter", { + expect_error(delete_folder(vol_id = 1, folder_id = 1, vb = -1)) + expect_error(delete_folder(vol_id = 1, folder_id = 1, vb = 3)) + expect_error(delete_folder(vol_id = 1, folder_id = 1, vb = "a")) + expect_error(delete_folder(vol_id = 1, folder_id = 1, vb = list(a = 1))) + expect_error(delete_folder(vol_id = 1, folder_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_folder(vol_id = 1, folder_id = 1, vb = NULL)) +}) + +test_that("delete_folder rejects invalid rq parameter", { + expect_error(delete_folder(vol_id = 1, folder_id = 1, rq = "a")) + expect_error(delete_folder(vol_id = 1, folder_id = 1, rq = -1)) + expect_error(delete_folder(vol_id = 1, folder_id = 1, rq = c(2, 3))) + expect_error(delete_folder(vol_id = 1, folder_id = 1, rq = list(a = 1))) + expect_error(delete_folder(vol_id = 1, folder_id = 1, rq = TRUE)) +}) diff --git a/tests/testthat/test-delete_record_measure.R b/tests/testthat/test-delete_record_measure.R new file mode 100644 index 00000000..95b93cc3 --- /dev/null +++ b/tests/testthat/test-delete_record_measure.R @@ -0,0 +1,105 @@ +# delete_record_measure() ------------------------------------------------------ +login_test_account() + +test_that("delete_record_measure deletes a measure", { + record_id <- make_test_record("Delete measure test") + skip_if_null_response(record_id, "create_volume_record for delete_measure test") + + set_record_measure(vol_id = TEST_VOL_ID, record_id = record_id, metric_id = TEST_METRIC_ID_EXTRA, value = "temp", vb = FALSE) + + delete_result <- delete_record_measure( + vol_id = TEST_VOL_ID, + record_id = record_id, + metric_id = TEST_METRIC_ID_EXTRA, + vb = FALSE + ) + + expect_true(delete_result) +}) + +test_that("delete_record_measure returns FALSE for non-existent measure", { + record_id <- make_test_record("Delete measure fail test") + skip_if_null_response(record_id, "create_volume_record for delete_measure fail test") + + delete_result <- delete_record_measure( + vol_id = TEST_VOL_ID, + record_id = record_id, + metric_id = TEST_METRIC_ID, + vb = FALSE + ) + + expect_false(delete_result) +}) + +test_that("delete_record_measure works with verbose mode", { + record_id <- make_test_record("Delete verbose test") + skip_if_null_response(record_id, "create_volume_record for delete_measure verbose test") + set_record_measure(vol_id = TEST_VOL_ID, record_id = record_id, metric_id = TEST_METRIC_ID_EXTRA, value = "temp", vb = FALSE) + + delete_result <- delete_record_measure( + vol_id = TEST_VOL_ID, + record_id = record_id, + metric_id = TEST_METRIC_ID_EXTRA, + vb = TRUE + ) + + expect_true(delete_result) +}) + +test_that("delete_record_measure rejects invalid vol_id", { + expect_error(delete_record_measure(vol_id = -1, record_id = 1, metric_id = 1)) + expect_error(delete_record_measure(vol_id = 0, record_id = 1, metric_id = 1)) + expect_error(delete_record_measure(vol_id = "1", record_id = 1, metric_id = 1)) + expect_error(delete_record_measure(vol_id = TRUE, record_id = 1, metric_id = 1)) + expect_error(delete_record_measure(vol_id = c(1, 2), record_id = 1, metric_id = 1)) + expect_error(delete_record_measure(vol_id = 1.5, record_id = 1, metric_id = 1)) +}) + +test_that("delete_record_measure rejects invalid record_id", { + expect_error(delete_record_measure(vol_id = 1, record_id = -1, metric_id = 1)) + expect_error(delete_record_measure(vol_id = 1, record_id = 0, metric_id = 1)) + expect_error(delete_record_measure(vol_id = 1, record_id = "1", metric_id = 1)) + expect_error(delete_record_measure(vol_id = 1, record_id = TRUE, metric_id = 1)) + expect_error(delete_record_measure(vol_id = 1, record_id = c(1, 2), metric_id = 1)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1.5, metric_id = 1)) +}) + +test_that("delete_record_measure rejects invalid metric_id", { + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = -1)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 0)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = "1")) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = TRUE)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = c(1, 2))) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1.5)) +}) + +test_that("delete_record_measure rejects invalid vb parameter", { + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1, vb = -1)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1, vb = 3)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1, vb = "a")) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1, vb = NULL)) +}) + +test_that("delete_record_measure rejects invalid rq parameter", { + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1, rq = "a")) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1, rq = -1)) + expect_error(delete_record_measure(vol_id = 1, record_id = 1, metric_id = 1, rq = TRUE)) +}) + +test_that("delete_record_measure works with custom request object", { + record_id <- make_test_record("Delete custom rq test") + skip_if_null_response(record_id, "create_volume_record for delete_measure custom rq test") + set_record_measure(vol_id = TEST_VOL_ID, record_id = record_id, metric_id = TEST_METRIC_ID_EXTRA, value = "temp", vb = FALSE) + + custom_rq <- databraryr::make_default_request() + delete_result <- delete_record_measure( + vol_id = TEST_VOL_ID, + record_id = record_id, + metric_id = TEST_METRIC_ID_EXTRA, + rq = custom_rq, + vb = FALSE + ) + + expect_true(delete_result) +}) diff --git a/tests/testthat/test-delete_session.R b/tests/testthat/test-delete_session.R new file mode 100644 index 00000000..b06c1c49 --- /dev/null +++ b/tests/testthat/test-delete_session.R @@ -0,0 +1,100 @@ +# delete_session() ------------------------------------------------------------- +login_test_account() + +test_that("delete_session deletes an existing session", { + created <- create_session(vol_id = TEST_VOL_ID, name = "delete_session happy path", vb = FALSE) + skip_if_null_response(created, "create_session for delete_session happy path") + + session_id <- created$id + on.exit( + try(delete_session(vol_id = TEST_VOL_ID, session_id = session_id, vb = FALSE), silent = TRUE), + add = TRUE + ) + + result <- delete_session(vol_id = TEST_VOL_ID, session_id = session_id, vb = FALSE) + + expect_true(result) + + expect_null(get_session_by_id(vol_id = TEST_VOL_ID, session_id = session_id, vb = FALSE)) +}) + +test_that("delete_session returns FALSE for non-existent session", { + expect_false(delete_session(vol_id = TEST_VOL_ID, session_id = TEST_MISSING_ID, vb = FALSE)) +}) + +test_that("delete_session works with verbose mode", { + created <- create_session(vol_id = TEST_VOL_ID, name = "delete_session vb", vb = FALSE) + skip_if_null_response(created, "create_session for delete_session vb") + + on.exit( + try(delete_session(vol_id = TEST_VOL_ID, session_id = created$id, vb = FALSE), silent = TRUE), + add = TRUE + ) + + expect_true(delete_session(vol_id = TEST_VOL_ID, session_id = created$id, vb = TRUE)) +}) + +test_that("delete_session works with custom request object", { + created <- create_session( + vol_id = TEST_VOL_ID, + name = "delete_session custom rq", + vb = FALSE + ) + skip_if_null_response(created, "create_session for delete_session custom rq") + + on.exit( + try(delete_session(vol_id = TEST_VOL_ID, session_id = created$id, vb = FALSE), silent = TRUE), + add = TRUE + ) + + custom_rq <- databraryr::make_default_request() + expect_true( + delete_session( + vol_id = TEST_VOL_ID, + session_id = created$id, + rq = custom_rq, + vb = FALSE + ) + ) +}) + +test_that("delete_session rejects invalid vol_id", { + expect_error(delete_session(vol_id = -1, session_id = 1)) + expect_error(delete_session(vol_id = 0, session_id = 1)) + expect_error(delete_session(vol_id = "1", session_id = 1)) + expect_error(delete_session(vol_id = TRUE, session_id = 1)) + expect_error(delete_session(vol_id = list(a = 1), session_id = 1)) + expect_error(delete_session(vol_id = c(1, 2), session_id = 1)) + expect_error(delete_session(vol_id = 1.5, session_id = 1)) + expect_error(delete_session(vol_id = NULL, session_id = 1)) + expect_error(delete_session(vol_id = NA, session_id = 1)) +}) + +test_that("delete_session rejects invalid session_id", { + expect_error(delete_session(vol_id = 1, session_id = -1)) + expect_error(delete_session(vol_id = 1, session_id = 0)) + expect_error(delete_session(vol_id = 1, session_id = "1")) + expect_error(delete_session(vol_id = 1, session_id = TRUE)) + expect_error(delete_session(vol_id = 1, session_id = list(a = 1))) + expect_error(delete_session(vol_id = 1, session_id = c(1, 2))) + expect_error(delete_session(vol_id = 1, session_id = 1.5)) + expect_error(delete_session(vol_id = 1, session_id = NULL)) + expect_error(delete_session(vol_id = 1, session_id = NA)) +}) + +test_that("delete_session rejects invalid vb parameter", { + expect_error(delete_session(vol_id = 1, session_id = 1, vb = -1)) + expect_error(delete_session(vol_id = 1, session_id = 1, vb = 3)) + expect_error(delete_session(vol_id = 1, session_id = 1, vb = "a")) + expect_error(delete_session(vol_id = 1, session_id = 1, vb = list(a = 1))) + expect_error(delete_session(vol_id = 1, session_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_session(vol_id = 1, session_id = 1, vb = NULL)) +}) + +test_that("delete_session rejects invalid rq parameter", { + expect_error(delete_session(vol_id = 1, session_id = 1, rq = "a")) + expect_error(delete_session(vol_id = 1, session_id = 1, rq = -1)) + expect_error(delete_session(vol_id = 1, session_id = 1, rq = c(2, 3))) + expect_error(delete_session(vol_id = 1, session_id = 1, rq = list(a = 1))) + expect_error(delete_session(vol_id = 1, session_id = 1, rq = TRUE)) +}) diff --git a/tests/testthat/test-delete_session_file.R b/tests/testthat/test-delete_session_file.R new file mode 100644 index 00000000..0bbed45a --- /dev/null +++ b/tests/testthat/test-delete_session_file.R @@ -0,0 +1,66 @@ +# delete_session_file() -------------------------------------------------------- +login_test_account() + +test_that("delete_session_file returns FALSE for non-existent file", { + expect_false( + delete_session_file( + vol_id = TEST_VOL_ID, + session_id = TEST_MISSING_ID, + file_id = TEST_MISSING_ID, + vb = FALSE + ) + ) +}) + +test_that("delete_session_file rejects invalid vol_id", { + expect_error(delete_session_file(vol_id = -1, session_id = 1, file_id = 1)) + expect_error(delete_session_file(vol_id = 0, session_id = 1, file_id = 1)) + expect_error(delete_session_file(vol_id = "1", session_id = 1, file_id = 1)) + expect_error(delete_session_file(vol_id = TRUE, session_id = 1, file_id = 1)) + expect_error(delete_session_file(vol_id = list(a = 1), session_id = 1, file_id = 1)) + expect_error(delete_session_file(vol_id = c(1, 2), session_id = 1, file_id = 1)) + expect_error(delete_session_file(vol_id = 1.5, session_id = 1, file_id = 1)) + expect_error(delete_session_file(vol_id = NULL, session_id = 1, file_id = 1)) + expect_error(delete_session_file(vol_id = NA, session_id = 1, file_id = 1)) +}) + +test_that("delete_session_file rejects invalid session_id", { + expect_error(delete_session_file(vol_id = 1, session_id = -1, file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = 0, file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = "1", file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = TRUE, file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = list(a = 1), file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = c(1, 2), file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = 1.5, file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = NULL, file_id = 1)) + expect_error(delete_session_file(vol_id = 1, session_id = NA, file_id = 1)) +}) + +test_that("delete_session_file rejects invalid file_id", { + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = -1)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 0)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = "1")) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = TRUE)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = list(a = 1))) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = c(1, 2))) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1.5)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = NULL)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = NA)) +}) + +test_that("delete_session_file rejects invalid vb parameter", { + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, vb = -1)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, vb = 3)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, vb = "a")) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, vb = list(a = 1))) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, vb = NULL)) +}) + +test_that("delete_session_file rejects invalid rq parameter", { + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, rq = "a")) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, rq = -1)) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, rq = c(2, 3))) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, rq = list(a = 1))) + expect_error(delete_session_file(vol_id = 1, session_id = 1, file_id = 1, rq = TRUE)) +}) diff --git a/tests/testthat/test-delete_volume_record.R b/tests/testthat/test-delete_volume_record.R new file mode 100644 index 00000000..f014e7ca --- /dev/null +++ b/tests/testthat/test-delete_volume_record.R @@ -0,0 +1,100 @@ +# delete_volume_record() ------------------------------------------------------- +login_test_account() + +test_that("delete_volume_record deletes an existing record", { + record_id <- make_test_record("Delete test") + skip_if_null_response(record_id, "create_volume_record for delete test") + + delete_result <- delete_volume_record( + vol_id = TEST_VOL_ID, + record_id = record_id, + vb = FALSE + ) + + expect_true(delete_result) + + get_result <- get_volume_record_by_id( + vol_id = TEST_VOL_ID, + record_id = record_id, + vb = FALSE + ) + expect_null(get_result) +}) + +test_that("delete_volume_record returns FALSE for non-existent record", { + result <- delete_volume_record( + vol_id = TEST_VOL_ID, + record_id = TEST_MISSING_ID, + vb = FALSE + ) + expect_false(result) +}) + +test_that("delete_volume_record works with verbose mode", { + record_id <- make_test_record("Delete vb test") + skip_if_null_response(record_id, "create_volume_record for delete verbose test") + + expect_true( + delete_volume_record( + vol_id = TEST_VOL_ID, + record_id = record_id, + vb = TRUE + ) + ) +}) + +test_that("delete_volume_record rejects invalid vol_id", { + expect_error(delete_volume_record(vol_id = -1, record_id = 1)) + expect_error(delete_volume_record(vol_id = 0, record_id = 1)) + expect_error(delete_volume_record(vol_id = "1", record_id = 1)) + expect_error(delete_volume_record(vol_id = TRUE, record_id = 1)) + expect_error(delete_volume_record(vol_id = list(a = 1), record_id = 1)) + expect_error(delete_volume_record(vol_id = c(1, 2), record_id = 1)) + expect_error(delete_volume_record(vol_id = 1.5, record_id = 1)) + expect_error(delete_volume_record(vol_id = NULL, record_id = 1)) + expect_error(delete_volume_record(vol_id = NA, record_id = 1)) +}) + +test_that("delete_volume_record rejects invalid record_id", { + expect_error(delete_volume_record(vol_id = 1, record_id = -1)) + expect_error(delete_volume_record(vol_id = 1, record_id = 0)) + expect_error(delete_volume_record(vol_id = 1, record_id = "1")) + expect_error(delete_volume_record(vol_id = 1, record_id = TRUE)) + expect_error(delete_volume_record(vol_id = 1, record_id = list(a = 1))) + expect_error(delete_volume_record(vol_id = 1, record_id = c(1, 2))) + expect_error(delete_volume_record(vol_id = 1, record_id = 1.5)) + expect_error(delete_volume_record(vol_id = 1, record_id = NULL)) + expect_error(delete_volume_record(vol_id = 1, record_id = NA)) +}) + +test_that("delete_volume_record rejects invalid vb parameter", { + expect_error(delete_volume_record(vol_id = 1, record_id = 1, vb = -1)) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, vb = 3)) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, vb = "a")) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, vb = list(a = 1, b = 2))) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, vb = NULL)) +}) + +test_that("delete_volume_record rejects invalid rq parameter", { + expect_error(delete_volume_record(vol_id = 1, record_id = 1, rq = "a")) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, rq = -1)) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, rq = c(2, 3))) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, rq = list(a = 1, b = 2))) + expect_error(delete_volume_record(vol_id = 1, record_id = 1, rq = TRUE)) +}) + +test_that("delete_volume_record works with custom request object", { + record_id <- make_test_record("Delete custom rq test") + skip_if_null_response(record_id, "create_volume_record for delete custom rq test") + + custom_rq <- databraryr::make_default_request() + delete_result <- delete_volume_record( + vol_id = TEST_VOL_ID, + record_id = record_id, + rq = custom_rq, + vb = FALSE + ) + + expect_true(delete_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..1e12d192 --- /dev/null +++ b/tests/testthat/test-download_folder_asset.R @@ -0,0 +1,79 @@ +# 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 <- tempfile("download_folder_asset_test_") + dir.create(tmp_dir, recursive = TRUE, showWarnings = FALSE) + on.exit(unlink(tmp_dir, recursive = TRUE), add = TRUE) + fake_link <- list(download_url = "https://example.com/file.bin", file_name = "example.bin") + class(fake_link) <- c("databrary_signed_download", "list") + + captured_path <- NULL + captured_dest <- NULL + + result <- with_mocked_bindings( + download_folder_asset( + vol_id = 1, + folder_id = 2, + asset_id = 3, + file_name = NULL, + target_dir = tmp_dir + ), + request_signed_download_link = function(path, rq = NULL, vb = FALSE) { + captured_path <<- path + fake_link + }, + 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..b22cb839 --- /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_folder_asset_from_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..261d9413 --- /dev/null +++ b/tests/testthat/test-download_single_folder_asset_fr_df.R @@ -0,0 +1,79 @@ +# download_folder_asset_from_df ---------------------------------------- +test_that("download_folder_asset_from_df rejects bad input parameters", { + expect_error(download_folder_asset_from_df(i = 0)) + expect_error(download_folder_asset_from_df(i = -1)) + expect_error(download_folder_asset_from_df(i = "a")) + + expect_error(download_folder_asset_from_df(i = 1, folder_df = 3)) + expect_error(download_folder_asset_from_df(i = 1, folder_df = "a")) + expect_error(download_folder_asset_from_df(i = 1, folder_df = TRUE)) + + missing_cols <- data.frame(vol_id = 1, folder_id = 1, asset_id = 1) + expect_error(download_folder_asset_from_df(i = 1, folder_df = missing_cols)) + + expect_error(download_folder_asset_from_df(i = 1, target_dir = 3)) + expect_error(download_folder_asset_from_df(i = 1, target_dir = list(a = 1, b = 2))) + expect_error(download_folder_asset_from_df(i = 1, target_dir = TRUE)) + + expect_error(download_folder_asset_from_df(i = 1, add_folder_subdir = -1)) + expect_error(download_folder_asset_from_df(i = 1, add_folder_subdir = 3)) + expect_error(download_folder_asset_from_df(i = 1, add_folder_subdir = "a")) + expect_error(download_folder_asset_from_df(i = 1, add_folder_subdir = list(a = 1, b = 2))) + + expect_error(download_folder_asset_from_df(i = 1, overwrite = -1)) + expect_error(download_folder_asset_from_df(i = 1, overwrite = 3)) + expect_error(download_folder_asset_from_df(i = 1, overwrite = "a")) + expect_error(download_folder_asset_from_df(i = 1, overwrite = list(a = 1, b = 2))) + + expect_error(download_folder_asset_from_df(i = 1, make_portable_fn = -1)) + expect_error(download_folder_asset_from_df(i = 1, make_portable_fn = 3)) + expect_error(download_folder_asset_from_df(i = 1, make_portable_fn = "a")) + expect_error(download_folder_asset_from_df(i = 1, make_portable_fn = list(a = 1, b = 2))) + + expect_error(download_folder_asset_from_df(i = 1, timeout_secs = -1)) + expect_error(download_folder_asset_from_df(i = 1, timeout_secs = TRUE)) + expect_error(download_folder_asset_from_df(i = 1, timeout_secs = "a")) + expect_error(download_folder_asset_from_df(i = 1, timeout_secs = list(a = 1, b = 2))) + + expect_error(download_folder_asset_from_df(i = 1, vb = -1)) + expect_error(download_folder_asset_from_df(i = 1, vb = 3)) + expect_error(download_folder_asset_from_df(i = 1, vb = "a")) + expect_error(download_folder_asset_from_df(i = 1, vb = list(a = 1, b = 2))) + + expect_error(download_folder_asset_from_df(i = 1, rq = "a")) + expect_error(download_folder_asset_from_df(i = 1, rq = -1)) + expect_error(download_folder_asset_from_df(i = 1, rq = c(2, 3))) + expect_error(download_folder_asset_from_df(i = 1, rq = list(a = 1, b = 2))) +}) + +test_that("download_folder_asset_from_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_folder_asset_from_df(i = 1, folder_df = folder_df, target_dir = tempdir()), + download_folder_asset = function(vol_id, folder_id, asset_id, file_name, target_dir, ...) { + captured <<- list( + vol_id = vol_id, + 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..ae72dcaa 100644 --- a/tests/testthat/test-download_single_session_asset_fr_df.R +++ b/tests/testthat/test-download_single_session_asset_fr_df.R @@ -1,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))) - }) +# download_session_asset_from_df --------------------------------------------------------- +test_that("download_session_asset_from_df rejects bad input parameters", { + expect_error(download_session_asset_from_df(i = 0)) + expect_error(download_session_asset_from_df(i = -1)) + expect_error(download_session_asset_from_df(i = "a")) + + expect_error(download_session_asset_from_df(session_df = 3)) + expect_error(download_session_asset_from_df(session_df = "a")) + expect_error(download_session_asset_from_df(session_df = TRUE)) + + missing_cols <- data.frame(vol_id = 1, session_id = 1, asset_id = 1) + expect_error(download_session_asset_from_df(i = 1, session_df = missing_cols)) + + expect_error(download_session_asset_from_df(i = 1, target_dir = 3)) + expect_error(download_session_asset_from_df(i = 1, target_dir = list(a = 1, b = 2))) + expect_error(download_session_asset_from_df(i = 1, target_dir = TRUE)) + + expect_error(download_session_asset_from_df(i = 1, add_session_subdir = -1)) + expect_error(download_session_asset_from_df(i = 1, add_session_subdir = 3)) + expect_error(download_session_asset_from_df(i = 1, add_session_subdir = "a")) + expect_error(download_session_asset_from_df(i = 1, add_session_subdir = list(a = 1, b = 2))) + + expect_error(download_session_asset_from_df(i = 1, overwrite = -1)) + expect_error(download_session_asset_from_df(i = 1, overwrite = 3)) + expect_error(download_session_asset_from_df(i = 1, overwrite = "a")) + expect_error(download_session_asset_from_df(i = 1, overwrite = list(a = 1, b = 2))) + + expect_error(download_session_asset_from_df(i = 1, make_portable_fn = -1)) + expect_error(download_session_asset_from_df(i = 1, make_portable_fn = 3)) + expect_error(download_session_asset_from_df(i = 1, make_portable_fn = "a")) + expect_error(download_session_asset_from_df(i = 1, make_portable_fn = list(a = 1, b = 2))) + + expect_error(download_session_asset_from_df(i = 1, timeout_secs = -1)) + expect_error(download_session_asset_from_df(i = 1, timeout_secs = TRUE)) + expect_error(download_session_asset_from_df(i = 1, timeout_secs = "a")) + expect_error(download_session_asset_from_df(i = 1, timeout_secs = list(a = 1, b = 2))) + + expect_error(download_session_asset_from_df(i = 1, vb = -1)) + expect_error(download_session_asset_from_df(i = 1, vb = 3)) + expect_error(download_session_asset_from_df(i = 1, vb = "a")) + expect_error(download_session_asset_from_df(i = 1, vb = list(a = 1, b = 2))) + + expect_error(download_session_asset_from_df(i = 1, rq = "a")) + expect_error(download_session_asset_from_df(i = 1, rq = -1)) + expect_error(download_session_asset_from_df(i = 1, rq = c(2, 3))) + expect_error(download_session_asset_from_df(i = 1, rq = list(a = 1, b = 2))) +}) diff --git a/tests/testthat/test-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..c010cf7a --- /dev/null +++ b/tests/testthat/test-get_category_by_id.R @@ -0,0 +1,144 @@ +# 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 = TEST_MISSING_ID, 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)) + + # 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..02c34721 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())) +login_test_account() + +test_that("get_db_stats returns statistics snapshot", { + 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", { + 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..a16cee3d --- /dev/null +++ b/tests/testthat/test-get_folder_file.R @@ -0,0 +1,62 @@ +# get_folder_file ------------------------------------------------------- +test_that("get_folder_file returns file metadata", { + login_test_account() + + fid <- make_test_folder(sprintf("get_folder_file probe %d", sample(100000L:999999L, 1L))) + skip_if_null_response(fid, "create_folder for get_folder_file") + + asset_name <- sprintf("get_folder_file_%d.txt", sample(100000L:999999L, 1L)) + target_file <- upload_test_folder_asset( + folder_id = fid, + file_basename = asset_name + ) + skip_if_null_response(target_file, "upload folder asset for get_folder_file") + + result <- get_folder_file( + vol_id = TEST_VOL_ID, + folder_id = fid, + file_id = target_file, + vb = FALSE + ) + skip_if_null_response( + result, + sprintf( + "get_folder_file(vol_id = TEST_VOL_ID, folder_id = %s, file_id = %s)", + fid, target_file + ) + ) + + expect_type(result, "list") + expect_equal(result$id, target_file) + 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..09f32339 --- /dev/null +++ b/tests/testthat/test-get_funder_by_id.R @@ -0,0 +1,110 @@ +# 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 = TEST_MISSING_ID, 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)) + + # 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..929b2b0a --- /dev/null +++ b/tests/testthat/test-get_institution_avatar.R @@ -0,0 +1,188 @@ +# 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 = TEST_MISSING_ID, 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)) + + # 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_institution_statistics.R b/tests/testthat/test-get_institution_statistics.R new file mode 100644 index 00000000..b29821dd --- /dev/null +++ b/tests/testthat/test-get_institution_statistics.R @@ -0,0 +1,25 @@ +login_test_account() + +test_that("get_institution_statistics returns statistics for institution with data", { + result <- get_institution_statistics(178) + skip_if_null_response(result, "get_institution_statistics(178)") + expect_true(is.list(result)) + expect_equal(result$institution_id, 178) + expect_true(is.numeric(result$volumes_number)) + expect_true(is.numeric(result$files_number)) + expect_true(is.numeric(result$uploaded_data_footprint)) + expect_true(is.numeric(result$transcoded_data_footprint)) +}) + +test_that("get_institution_statistics returns NULL for institution without statistics", { + result <- get_institution_statistics(999) + # Institution 999 may not exist or may have no statistics + expect_true(is.null(result) || is.list(result)) +}) + +test_that("get_institution_statistics with vb = TRUE", { + result <- get_institution_statistics(178, vb = TRUE) + skip_if_null_response(result, "get_institution_statistics(178, vb = TRUE)") + expect_true(is.list(result)) + expect_equal(result$institution_id, 178) +}) 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..5d4b340b --- /dev/null +++ b/tests/testthat/test-get_tag_by_id.R @@ -0,0 +1,121 @@ +# 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 = TEST_MISSING_ID, 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)) + + # 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_upload_status.R b/tests/testthat/test-get_upload_status.R new file mode 100644 index 00000000..dd8e1868 --- /dev/null +++ b/tests/testthat/test-get_upload_status.R @@ -0,0 +1,47 @@ +# get_upload_status() ---------------------------------------------------------- +login_test_account() + +test_that("get_upload_status requires exactly one identifier", { + expect_error(get_upload_status()) + expect_error(get_upload_status( + status_url = "https://x/y", upload_guid = "abc" + )) +}) + +test_that("get_upload_status validates identifier shape", { + expect_error(get_upload_status(status_url = "")) + expect_error(get_upload_status(status_url = c("a", "b"))) + expect_error(get_upload_status(upload_guid = "")) + expect_error(get_upload_status(upload_guid = 123)) +}) + +test_that("get_upload_status returns NULL for unknown guid", { + # A well-formed but non-existent GUID should fail cleanly. + res <- get_upload_status( + upload_guid = "00000000-0000-0000-0000-000000000000", + vb = FALSE + ) + expect_null(res) +}) + +test_that("get_upload_status returns a status string for a real upload", { + sid <- make_test_session("get_upload_status test") + skip_if_null_response(sid, "create_session for get_upload_status") + + init <- initiate_upload( + filename = "status_probe.mp4", + destination_type = "session", + object_id = sid, + file_size = 1024L, + content_type = "video/mp4", + vb = FALSE + ) + skip_if_null_response(init, "initiate_upload for get_upload_status") + + status <- get_upload_status(status_url = init$status_url, vb = FALSE) + skip_if_null_response(status, "get_upload_status by URL") + + expect_type(status, "character") + expect_length(status, 1) + expect_true(nzchar(status)) +}) diff --git a/tests/testthat/test-get_user_avatar.R b/tests/testthat/test-get_user_avatar.R new file mode 100644 index 00000000..90ee6cf3 --- /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 = TEST_MISSING_ID, 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_user_statistics.R b/tests/testthat/test-get_user_statistics.R new file mode 100644 index 00000000..7b36f554 --- /dev/null +++ b/tests/testthat/test-get_user_statistics.R @@ -0,0 +1,25 @@ +login_test_account() + +test_that("get_user_statistics returns statistics for user with data", { + result <- get_user_statistics(6) + skip_if_null_response(result, "get_user_statistics(6)") + expect_true(is.list(result)) + expect_equal(result$user_id, 6) + expect_true(is.numeric(result$volumes_number)) + expect_true(is.numeric(result$files_number)) + expect_true(is.numeric(result$uploaded_data_footprint)) + expect_true(is.numeric(result$transcoded_data_footprint)) +}) + +test_that("get_user_statistics returns NULL for user without statistics", { + result <- get_user_statistics(999) + # User 999 may not exist or may have no statistics + expect_true(is.null(result) || is.list(result)) +}) + +test_that("get_user_statistics with vb = TRUE", { + result <- get_user_statistics(6, vb = TRUE) + skip_if_null_response(result, "get_user_statistics(6, vb = TRUE)") + expect_true(is.list(result)) + expect_equal(result$user_id, 6) +}) 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..0d591920 --- /dev/null +++ b/tests/testthat/test-get_volume_collaborator_by_id.R @@ -0,0 +1,255 @@ +# get_volume_collaborator_by_id() -------------------------------------------- +login_test_account() + +first_valid_collaborator_id <- function(collaborators) { + ids <- collaborators$collaborator_id + ok <- !is.na(ids) & ids > 0 + if (!any(ok)) { + return(NULL) + } + ids[which(ok)[1]] +} + +test_that("get_volume_collaborator_by_id retrieves valid collaborator", { + # First get a list of collaborators to find a valid collaborator_id + collaborators <- list_volume_collaborators(vol_id = 1, vb = FALSE) + skip_if_null_response(collaborators, "list_volume_collaborators(vol_id = 1)") + + test_collaborator_id <- first_valid_collaborator_id(collaborators) + skip_if(is.null(test_collaborator_id), "no row with collaborator_id > 0 from API") + + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + + 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 = TEST_MISSING_ID, vb = FALSE) + expect_null(result) +}) + +test_that("get_volume_collaborator_by_id returns NULL for non-existent volume", { + result <- get_volume_collaborator_by_id(vol_id = TEST_MISSING_ID, 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)") + + test_collaborator_id <- first_valid_collaborator_id(collaborators) + skip_if(is.null(test_collaborator_id), "no row with collaborator_id > 0 from API") + + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id, 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)) + + # 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)) + + # 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)") + + test_collaborator_id <- first_valid_collaborator_id(collaborators) + skip_if(is.null(test_collaborator_id), "no row with collaborator_id > 0 from API") + + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + + # 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)") + + test_collaborator_id <- first_valid_collaborator_id(collaborators) + skip_if(is.null(test_collaborator_id), "no row with collaborator_id > 0 from API") + + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + + # If user exists, check its structure + if (!is.null(result$user)) { + expect_type(result$user, "list") + expected_fields <- c("user_id", "first_name", "last_name", "email", "is_authorized_investigator", "has_avatar") + expect_true(all(expected_fields %in% names(result$user))) + expect_true(!is.null(result$user$user_id)) + } +}) + +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)") + + test_collaborator_id <- first_valid_collaborator_id(collaborators) + skip_if(is.null(test_collaborator_id), "no row with collaborator_id > 0 from API") + + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + + # If sponsor exists, check its structure + if (!is.null(result$sponsor)) { + expect_type(result$sponsor, "list") + expected_fields <- c("sponsor_id", "first_name", "last_name", "email") + expect_true(all(expected_fields %in% names(result$sponsor))) + expect_true(!is.null(result$sponsor$sponsor_id)) + } +}) + +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)") + + test_collaborator_id <- first_valid_collaborator_id(collaborators) + skip_if(is.null(test_collaborator_id), "no row with collaborator_id > 0 from API") + + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + + # 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)") + + test_collaborator_id <- first_valid_collaborator_id(collaborators) + skip_if(is.null(test_collaborator_id), "no row with collaborator_id > 0 from API") + + 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)") + + valid_ids <- collaborators$collaborator_id[ + !is.na(collaborators$collaborator_id) & collaborators$collaborator_id > 0 + ] + if (length(valid_ids) < 2) { + testthat::skip("Need at least 2 collaborators with collaborator_id > 0") + } + + 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)) + + 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)") + + test_collaborator_id <- first_valid_collaborator_id(collaborators) + skip_if(is.null(test_collaborator_id), "no row with collaborator_id > 0 from API") + + result <- get_volume_collaborator_by_id(vol_id = 1, collaborator_id = test_collaborator_id) + skip_if_null_response(result, sprintf("get_volume_collaborator_by_id(vol_id = 1, collaborator_id = %d)", test_collaborator_id)) + + # 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..fb8d5476 --- /dev/null +++ b/tests/testthat/test-get_volume_record_by_id.R @@ -0,0 +1,269 @@ +# get_volume_record_by_id() -------------------------------------------------- +login_test_account() + +records_test_vol <- list_volume_records(vol_id = TEST_VOL_ID, vb = FALSE) + +test_that("get_volume_record_by_id retrieves valid record", { + records <- records_test_vol + skip_if_null_response(records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) + + if (nrow(records) > 0) { + test_record_id <- records$record_id[1] + + result <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = test_record_id) + skip_if_null_response( + result, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d)", TEST_VOL_ID, test_record_id) + ) + + expect_type(result, "list") + expect_named(result, c( + "record_id", "record_volume", "record_volume_name", "record_category_id", + "measures", "birthday", "age", "default_sessions", "record_source_kind" + )) + expect_equal(result$record_id, test_record_id) + # record_volume is the owning volume id; linked records may differ from requested vol_id + row <- match(test_record_id, records$record_id) + expect_equal(result$record_volume, records$record_volume[row]) + expect_true(is.numeric(result$record_category_id) || is.integer(result$record_category_id)) + } +}) + +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 = TEST_VOL_ID, record_id = TEST_MISSING_ID, vb = FALSE) + expect_null(result) +}) + +test_that("get_volume_record_by_id returns NULL for non-existent volume", { + result <- get_volume_record_by_id(vol_id = TEST_MISSING_ID, record_id = 1, vb = FALSE) + expect_null(result) +}) + +test_that("get_volume_record_by_id works with verbose mode", { + records <- records_test_vol + skip_if_null_response(records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) + + if (nrow(records) > 0) { + test_record_id <- records$record_id[1] + result <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = test_record_id, vb = TRUE) + skip_if_null_response( + result, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d, vb = TRUE)", TEST_VOL_ID, test_record_id) + ) + + expect_type(result, "list") + expect_true(!is.null(result$record_id)) + } +}) + +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)) + + # 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)) + + # 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 <- records_test_vol + skip_if_null_response(records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) + + if (nrow(records) > 0) { + test_record_id <- records$record_id[1] + result <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = test_record_id) + skip_if_null_response( + result, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d)", TEST_VOL_ID, test_record_id) + ) + + # Check that all expected fields exist + expect_true(all(c( + "record_id", "record_volume", "record_volume_name", "record_category_id", + "measures", "birthday", "age", "default_sessions", "record_source_kind" + ) %in% names(result))) + + # Check field types + expect_true(is.numeric(result$record_id) || is.integer(result$record_id)) + expect_true(is.numeric(result$record_volume) || is.integer(result$record_volume)) + expect_true(is.character(result$record_volume_name)) + expect_true(is.numeric(result$record_category_id) || is.integer(result$record_category_id)) + expect_true(is.list(result$measures) || is.null(result$measures)) + expect_true(is.list(result$default_sessions)) + + # Check that record_id matches the requested ID + expect_equal(result$record_id, test_record_id) + + # Owning volume may differ from requested vol_id when the list includes linked records + row <- match(test_record_id, records$record_id) + expect_equal(result$record_volume, records$record_volume[row]) + } +}) + +test_that("get_volume_record_by_id handles age structure correctly", { + records <- records_test_vol + skip_if_null_response(records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) + + if (nrow(records) == 0) { + testthat::skip("No records on volume; cannot validate age structure") + } + + test_record_id <- records$record_id[1] + result <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = test_record_id) + skip_if_null_response( + result, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d)", TEST_VOL_ID, test_record_id) + ) + + if (is.null(result$age)) { + expect_null(result$age) + } else { + expect_type(result$age, "list") + expected_fields <- c("years", "months", "days", "total_days", "formatted_value", "is_estimated", "is_blurred") + expect_true(all(expected_fields %in% names(result$age))) + } +}) + +test_that("get_volume_record_by_id handles measures correctly", { + records <- records_test_vol + skip_if_null_response(records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) + + if (nrow(records) > 0) { + test_record_id <- records$record_id[1] + result <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = test_record_id) + skip_if_null_response( + result, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d)", TEST_VOL_ID, test_record_id) + ) + + # Measures should be a list (can be empty) + expect_true(is.list(result$measures) || is.null(result$measures)) + } +}) + +test_that("get_volume_record_by_id works with custom request object", { + records <- records_test_vol + skip_if_null_response(records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) + + if (nrow(records) > 0) { + test_record_id <- records$record_id[1] + custom_rq <- databraryr::make_default_request() + result <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = test_record_id, rq = custom_rq) + skip_if_null_response( + result, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d, rq = custom_rq)", TEST_VOL_ID, test_record_id) + ) + + expect_type(result, "list") + expect_equal(result$record_id, test_record_id) + } +}) + +test_that("get_volume_record_by_id can retrieve multiple different records", { + records <- records_test_vol + skip_if_null_response(records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) + + unique_ids <- unique(records$record_id) + if (length(unique_ids) < 2) { + testthat::skip("Volume has fewer than 2 records; need 2+ to verify multiple retrieval") + } + + record_id_1 <- unique_ids[1] + record_id_2 <- unique_ids[2] + + result1 <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = record_id_1, vb = FALSE) + result2 <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = record_id_2, vb = FALSE) + + skip_if_null_response( + result1, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d)", TEST_VOL_ID, record_id_1) + ) + skip_if_null_response( + result2, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d)", TEST_VOL_ID, record_id_2) + ) + + expect_false(identical(result1$record_id, result2$record_id)) + expect_equal(as.integer(result1$record_id), as.integer(record_id_1)) + expect_equal(as.integer(result2$record_id), as.integer(record_id_2)) +}) + +test_that("get_volume_record_by_id returns complete structure with all fields", { + records <- records_test_vol + skip_if_null_response(records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) + + if (nrow(records) > 0) { + test_record_id <- records$record_id[1] + result <- get_volume_record_by_id(vol_id = TEST_VOL_ID, record_id = test_record_id) + skip_if_null_response( + result, + sprintf("get_volume_record_by_id(vol_id = %d, record_id = %d)", TEST_VOL_ID, test_record_id) + ) + + # Record should have all expected fields (parity with RecordSerializer read-only output) + expect_length(result, 9) + expect_named(result, c( + "record_id", "record_volume", "record_volume_name", "record_category_id", + "measures", "birthday", "age", "default_sessions", "record_source_kind" + )) + } +}) diff --git a/tests/testthat/test-initiate_upload.R b/tests/testthat/test-initiate_upload.R new file mode 100644 index 00000000..fe06db29 --- /dev/null +++ b/tests/testthat/test-initiate_upload.R @@ -0,0 +1,106 @@ +# initiate_upload() ------------------------------------------------------------ +login_test_account() + +test_that("initiate_upload validates required args", { + expect_error(initiate_upload( + filename = "", destination_type = "session", object_id = 1 + )) + expect_error(initiate_upload( + filename = NULL, destination_type = "session", object_id = 1 + )) + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "", object_id = 1 + )) + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = 0 + )) + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = "1" + )) + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = 1.5 + )) +}) + +test_that("initiate_upload rejects optional args of wrong shape", { + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = 1, + file_size = -1 + )) + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = 1, + file_size = "100" + )) + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = 1, + content_type = "" + )) + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = 1, + content_type = c("video/mp4", "video/quicktime") + )) +}) + +test_that("initiate_upload requires source_session_id for linked_volume_session", { + expect_error(initiate_upload( + filename = "a.mp4", + destination_type = "linked_volume_session", + object_id = 1 + )) +}) + +test_that("initiate_upload requires source_folder_id for linked_volume_folder", { + expect_error(initiate_upload( + filename = "a.mp4", + destination_type = "linked_volume_folder", + object_id = 1 + )) +}) + +test_that("initiate_upload rejects invalid vb / rq", { + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = 1, + vb = "yes" + )) + expect_error(initiate_upload( + filename = "a.mp4", destination_type = "session", object_id = 1, + rq = "not-a-request" + )) +}) + +test_that("initiate_upload returns signed url and status_url for a session", { + sid <- make_test_session("initiate_upload happy path") + skip_if_null_response(sid, "create_session for initiate_upload happy path") + + result <- initiate_upload( + filename = "test_clip.mp4", + destination_type = "session", + object_id = sid, + file_size = 1024L, + content_type = "video/mp4", + vb = FALSE + ) + skip_if_null_response(result, "initiate_upload happy path") + + expect_type(result, "list") + expect_true(!is.null(result$status_url)) + expect_true(!is.null(result$upload_type)) + # Either a single PUT with signed_upload_url, or multipart with part_urls + if (identical(result$upload_type, "multipart")) { + expect_true(!is.null(result$part_urls)) + expect_true(!is.null(result$s3_upload_id)) + expect_true(!is.null(result$upload_guid)) + } else { + expect_true(!is.null(result$signed_upload_url)) + } +}) + +test_that("initiate_upload returns NULL for nonexistent destination", { + expect_null(initiate_upload( + filename = "test.mp4", + destination_type = "session", + object_id = TEST_MISSING_ID, + file_size = 1024L, + vb = FALSE + )) +}) 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..915345b4 --- /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, vol_id = NULL)) + + expect_error(list_folder_assets(folder_id = 1, vol_id = "a")) + expect_error(list_folder_assets(folder_id = 1, vol_id = c(1, 2))) + 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..7c348d03 --- /dev/null +++ b/tests/testthat/test-list_institutions.R @@ -0,0 +1,171 @@ +# list_institutions() --------------------------------------------------------- +login_test_account() + +institutions_all <- list_institutions(vb = FALSE) + +test_that("list_institutions returns all institutions without search filter", { + result <- institutions_all + 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 <- institutions_all + 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 <- institutions_all + 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", { + all_institutions <- institutions_all + 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 <- institutions_all + 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 <- institutions_all + 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 deleted file mode 100644 index d8272969..00000000 --- a/tests/testthat/test-list_session_activity.R +++ /dev/null @@ -1,25 +0,0 @@ -# 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 rejects bad input parameters", { - expect_error(list_session_activity(session_id = "a")) - expect_error(list_session_activity(session_id = c(1, 2))) - expect_error(list_session_activity(session_id = TRUE)) - expect_error(list_session_activity(session_id = list(a = 1, b = 2))) - expect_error(list_session_activity(session_id = -1)) - - expect_error(list_session_activity(vb = -1)) - expect_error(list_session_activity(vb = 3)) - expect_error(list_session_activity(vb = "a")) - expect_error(list_session_activity(vb = list(a = 1, b = 2))) - - expect_error(list_session_activity(rq = "a")) - expect_error(list_session_activity(rq = -1)) - expect_error(list_session_activity(rq = c(2, 3))) - expect_error(list_session_activity(rq = list(a = 1, b = 2))) -}) diff --git a/tests/testthat/test-list_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..63aa8d5d 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", { @@ -15,9 +17,4 @@ test_that("list_volume_activity rejects bad input parameters", { expect_error(list_volume_activity(vb = 3)) expect_error(list_volume_activity(vb = "a")) expect_error(list_volume_activity(vb = list(a=1, b=2))) - - expect_error(list_session_activity(rq = "a")) - expect_error(list_session_activity(rq = -1)) - expect_error(list_session_activity(rq = c(2,3))) - expect_error(list_session_activity(rq = list(a=1, b=2))) }) \ No newline at end of file diff --git a/tests/testthat/test-list_volume_assets.R b/tests/testthat/test-list_volume_assets.R index e12b9722..512b1fb4 100644 --- a/tests/testthat/test-list_volume_assets.R +++ b/tests/testthat/test-list_volume_assets.R @@ -1,9 +1,25 @@ # 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()) - ))) +login_test_account() + +test_that("list_volume_assets returns tibble or is NULL", { + 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", { + 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 always includes duration and thumbnail columns", { + result <- list_volume_assets(vol_id = 1) + skip_if_null_response(result, "list_volume_assets(vol_id = 1)") + expect_true(all(c("asset_duration", "asset_thumbnail_url") %in% names(result))) + expect_type(result$asset_duration, "double") + expect_type(result$asset_thumbnail_url, "character") }) test_that("list_volume_assets rejects bad input parameters", { @@ -17,11 +33,6 @@ test_that("list_volume_assets rejects bad input parameters", { expect_error(list_volume_assets(vb = 3)) expect_error(list_volume_assets(vb = "a")) expect_error(list_volume_assets(vb = list(a = 1, b = 2))) - - expect_error(list_session_activity(rq = "a")) - expect_error(list_session_activity(rq = -1)) - expect_error(list_session_activity(rq = c(2, 3))) - expect_error(list_session_activity(rq = list(a = 1, b = 2))) }) test_that("list_volume_assets returns NULL for invalid/missing volume IDs", 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..75fcceb8 --- /dev/null +++ b/tests/testthat/test-list_volume_folders.R @@ -0,0 +1,31 @@ +# 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") + expect_equal(nrow(result), dplyr::n_distinct(result$folder_id)) + expect_type(result$folder_native_accessible, "integer") + expect_type(result$folder_native_inaccessible, "integer") + expect_type(result$folder_linked_accessible, "integer") + expect_type(result$folder_linked_inaccessible, "integer") +}) + +test_that("list_volume_folders rejects bad input parameters", { + 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..4ac2978a 100644 --- a/tests/testthat/test-list_volume_info.R +++ b/tests/testthat/test-list_volume_info.R @@ -1,10 +1,23 @@ # 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))) +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..1314ae63 100644 --- a/tests/testthat/test-list_volume_links.R +++ b/tests/testthat/test-list_volume_links.R @@ -1,7 +1,11 @@ # list_volume_links --------------------------------------------------------- +login_test_account() + 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()))) + 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", { 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..49ee7d77 --- /dev/null +++ b/tests/testthat/test-list_volume_records.R @@ -0,0 +1,168 @@ +# list_volume_records --------------------------------------------------------- +login_test_account() + +records_test_vol <- list_volume_records(vol_id = TEST_VOL_ID, vb = FALSE) + +test_that("list_volume_records returns tibble given valid vol_id", { + result <- records_test_vol + skip_if_null_response(result, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) + + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(all(c( + "record_id", "record_volume", "record_volume_name", "record_category_id", + "record_measures", "record_default_sessions", "record_source_kind" + ) %in% names(result))) +}) + +test_that("list_volume_records returns valid record structure", { + result <- records_test_vol + skip_if_null_response(result, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) + + # Check column types + expect_true(is.numeric(result$record_id) || is.integer(result$record_id)) + 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)) + + # record_volume_name / linked provenance / default sessions (core RecordSerializer) + expect_true(is.character(result$record_volume_name)) + expect_true(is.list(result$record_default_sessions)) + expect_true(is.character(result$record_source_kind)) +}) + +test_that("list_volume_records returns NULL for non-existent volume", { + result <- list_volume_records(vol_id = TEST_MISSING_ID, vb = FALSE) + expect_null(result) +}) + +test_that("list_volume_records works with category_id filter", { + all_records <- records_test_vol + skip_if_null_response(all_records, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) + + if (nrow(all_records) > 0) { + # Get unique category_id from results + test_category <- all_records$record_category_id[1] + + # Filter by that category + filtered_records <- list_volume_records(vol_id = TEST_VOL_ID, category_id = test_category, vb = FALSE) + skip_if_null_response( + filtered_records, + sprintf("list_volume_records(vol_id = %d, category_id = %d)", TEST_VOL_ID, test_category) + ) + + # All records should have the specified category_id + expect_true(all(filtered_records$record_category_id == test_category)) + } +}) + +test_that("list_volume_records works with verbose mode", { + result <- list_volume_records(vol_id = TEST_VOL_ID, vb = TRUE) + skip_if_null_response(result, sprintf("list_volume_records(vol_id = %d, vb = TRUE)", TEST_VOL_ID)) + + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) +}) + +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 <- records_test_vol + skip_if_null_response(result, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) + + # Check that age fields exist + age_fields <- c("age_years", "age_months", "age_days", "age_total_days", + "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 <- records_test_vol + skip_if_null_response(result, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) + + # Check that measures column is a list + expect_true("record_measures" %in% names(result)) + 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 = TEST_VOL_ID, rq = custom_rq) + skip_if_null_response(result, sprintf("list_volume_records(vol_id = %d, rq = custom_rq)", TEST_VOL_ID)) + + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) +}) + +test_that("list_volume_records returns for different volumes", { + result1 <- records_test_vol + skip_if_null_response(result1, sprintf("list_volume_records(vol_id = %d)", TEST_VOL_ID)) + + result2 <- list_volume_records(vol_id = 2, vb = FALSE) + skip_if_null_response(result2, "list_volume_records(vol_id = 2)") + + # Both should be tibbles + expect_s3_class(result1, "tbl_df") + expect_s3_class(result2, "tbl_df") + + # Owning-volume ids may differ from requested vol_id when volumes expose linked records + expect_true(all(is.finite(result1$record_volume))) + expect_true(all(is.finite(result2$record_volume))) + expect_gt(length(unique(result1$record_id)), 0) + expect_gt(length(unique(result2$record_id)), 0) +}) diff --git a/tests/testthat/test-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..6f007b28 100644 --- a/tests/testthat/test-list_volume_sessions.R +++ b/tests/testthat/test-list_volume_sessions.R @@ -1,10 +1,32 @@ # list_volume_sessions -------------------------------------------------------- -test_that("list_volume_sessions returns data.frame given valid vol_id", { - expect_true("data.frame" %in% class(list_volume_sessions())) +login_test_account() + +test_that("list_volume_sessions returns tibble given valid vol_id", { + result <- list_volume_sessions() + skip_if_null_response(result, "list_volume_sessions()") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_equal(nrow(result), dplyr::n_distinct(result$session_id)) + expect_type(result$session_native_accessible, "integer") + expect_type(result$session_native_inaccessible, "integer") + expect_type(result$session_linked_accessible, "integer") + expect_type(result$session_linked_inaccessible, "integer") +}) + +test_that("list_volume_sessions returns tibble for another volume", { + 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) + expect_equal(nrow(result), dplyr::n_distinct(result$session_id)) + expect_type(result$session_native_accessible, "integer") + expect_type(result$session_native_inaccessible, "integer") + expect_type(result$session_linked_accessible, "integer") + expect_type(result$session_linked_inaccessible, "integer") }) -test_that("list_volume_sessions returns NULL given a non-shared vol_id", { - expect_true(is.null(list_volume_sessions(vol_id = 237))) +test_that("list_volume_sessions returns NULL for unknown volume", { + 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..8feead9c 100644 --- a/tests/testthat/test-list_volume_tags.R +++ b/tests/testthat/test-list_volume_tags.R @@ -1,7 +1,12 @@ # 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())))) +login_test_account() + +test_that("list_volume_tags returns tags for volume 1", { + 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", { 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..be18e185 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-patch_folder.R b/tests/testthat/test-patch_folder.R new file mode 100644 index 00000000..2f8fc42f --- /dev/null +++ b/tests/testthat/test-patch_folder.R @@ -0,0 +1,127 @@ +# patch_folder() --------------------------------------------------------------- +login_test_account() + +test_that("patch_folder updates name", { + fid <- make_test_folder("patch_folder original") + skip_if_null_response(fid, "create_folder for patch_folder name test") + + result <- patch_folder( + vol_id = TEST_VOL_ID, + folder_id = fid, + name = "patch_folder renamed", + vb = FALSE + ) + skip_if_null_response(result, "patch_folder(name=...)") + + expect_type(result, "list") + expect_equal(result$name, "patch_folder renamed") + expect_equal(as.integer(result$id), as.integer(fid)) +}) + +test_that("patch_folder updates source_date with a Date object", { + fid <- make_test_folder("patch_folder source_date Date") + skip_if_null_response(fid, "create_folder for patch_folder source_date Date") + + result <- patch_folder( + vol_id = TEST_VOL_ID, + folder_id = fid, + source_date = as.Date("2024-03-15"), + vb = FALSE + ) + skip_if_null_response(result, "patch_folder(source_date=Date)") + expect_type(result, "list") +}) + +test_that("patch_folder returns NULL when no fields provided", { + expect_null(patch_folder(vol_id = TEST_VOL_ID, folder_id = 1, vb = FALSE)) +}) + +test_that("patch_folder returns NULL for non-existent folder", { + result <- patch_folder( + vol_id = TEST_VOL_ID, + folder_id = TEST_MISSING_ID, + name = "nope", + vb = FALSE + ) + expect_null(result) +}) + +test_that("patch_folder works with verbose mode", { + fid <- make_test_folder("patch_folder vb") + skip_if_null_response(fid, "create_folder for patch_folder vb") + + result <- patch_folder( + vol_id = TEST_VOL_ID, + folder_id = fid, + name = "patch_folder vb renamed", + vb = TRUE + ) + skip_if_null_response(result, "patch_folder vb") + expect_type(result, "list") +}) + +test_that("patch_folder works with custom request object", { + fid <- make_test_folder("patch_folder custom rq") + skip_if_null_response(fid, "create_folder for patch_folder custom rq") + + custom_rq <- databraryr::make_default_request() + result <- patch_folder( + vol_id = TEST_VOL_ID, + folder_id = fid, + name = "patch_folder custom rq renamed", + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "patch_folder custom rq") + expect_type(result, "list") +}) + +test_that("patch_folder rejects invalid name", { + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = "")) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = " ")) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = 123)) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = c("A", "B"))) +}) + +test_that("patch_folder rejects malformed source_date", { + expect_error(patch_folder(vol_id = 1, folder_id = 1, source_date = "not-a-date")) + expect_error(patch_folder(vol_id = 1, folder_id = 1, source_date = "")) + expect_error(patch_folder(vol_id = 1, folder_id = 1, source_date = 123)) +}) + +test_that("patch_folder rejects invalid release_level", { + expect_error(patch_folder(vol_id = 1, folder_id = 1, release_level = "")) + expect_error(patch_folder(vol_id = 1, folder_id = 1, release_level = 1)) + expect_error(patch_folder(vol_id = 1, folder_id = 1, release_level = c("A", "B"))) +}) + +test_that("patch_folder rejects invalid vol_id", { + expect_error(patch_folder(vol_id = -1, folder_id = 1, name = "x")) + expect_error(patch_folder(vol_id = 0, folder_id = 1, name = "x")) + expect_error(patch_folder(vol_id = "1", folder_id = 1, name = "x")) + expect_error(patch_folder(vol_id = TRUE, folder_id = 1, name = "x")) + expect_error(patch_folder(vol_id = c(1, 2), folder_id = 1, name = "x")) + expect_error(patch_folder(vol_id = 1.5, folder_id = 1, name = "x")) +}) + +test_that("patch_folder rejects invalid folder_id", { + expect_error(patch_folder(vol_id = 1, folder_id = -1, name = "x")) + expect_error(patch_folder(vol_id = 1, folder_id = 0, name = "x")) + expect_error(patch_folder(vol_id = 1, folder_id = "1", name = "x")) + expect_error(patch_folder(vol_id = 1, folder_id = TRUE, name = "x")) + expect_error(patch_folder(vol_id = 1, folder_id = c(1, 2), name = "x")) + expect_error(patch_folder(vol_id = 1, folder_id = 1.5, name = "x")) +}) + +test_that("patch_folder rejects invalid vb parameter", { + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = "x", vb = -1)) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = "x", vb = "a")) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = "x", vb = NULL)) +}) + +test_that("patch_folder rejects invalid rq parameter", { + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = "x", rq = "a")) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = "x", rq = -1)) + expect_error(patch_folder(vol_id = 1, folder_id = 1, name = "x", rq = TRUE)) +}) diff --git a/tests/testthat/test-patch_session.R b/tests/testthat/test-patch_session.R new file mode 100644 index 00000000..189d4a72 --- /dev/null +++ b/tests/testthat/test-patch_session.R @@ -0,0 +1,156 @@ +# patch_session() -------------------------------------------------------------- +login_test_account() + +test_that("patch_session updates name", { + sid <- make_test_session("patch_session original") + skip_if_null_response(sid, "create_session for patch_session name test") + + result <- patch_session( + vol_id = TEST_VOL_ID, + session_id = sid, + name = "patch_session renamed", + vb = FALSE + ) + skip_if_null_response(result, "patch_session(name=...)") + + expect_type(result, "list") + expect_equal(result$name, "patch_session renamed") + expect_equal(as.integer(result$id), as.integer(sid)) +}) + +test_that("patch_session updates source_date with a Date object", { + sid <- make_test_session("patch_session source_date Date") + skip_if_null_response(sid, "create_session for patch_session source_date Date") + + result <- patch_session( + vol_id = TEST_VOL_ID, + session_id = sid, + source_date = as.Date("2024-03-15"), + vb = FALSE + ) + skip_if_null_response(result, "patch_session(source_date=Date)") + expect_type(result, "list") +}) + +test_that("patch_session returns NULL when no fields provided", { + expect_null(patch_session(vol_id = TEST_VOL_ID, session_id = 1, vb = FALSE)) +}) + +test_that("patch_session returns NULL for non-existent session", { + result <- patch_session( + vol_id = TEST_VOL_ID, + session_id = TEST_MISSING_ID, + name = "nope", + vb = FALSE + ) + expect_null(result) +}) + +test_that("patch_session works with verbose mode", { + sid <- make_test_session("patch_session vb") + skip_if_null_response(sid, "create_session for patch_session vb") + + result <- patch_session( + vol_id = TEST_VOL_ID, + session_id = sid, + name = "patch_session vb renamed", + vb = TRUE + ) + skip_if_null_response(result, "patch_session vb") + expect_type(result, "list") +}) + +test_that("patch_session works with custom request object", { + sid <- make_test_session("patch_session custom rq") + skip_if_null_response(sid, "create_session for patch_session custom rq") + + custom_rq <- databraryr::make_default_request() + result <- patch_session( + vol_id = TEST_VOL_ID, + session_id = sid, + name = "patch_session custom rq renamed", + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "patch_session custom rq") + expect_type(result, "list") +}) + +test_that("patch_session rejects invalid name", { + expect_error(patch_session(vol_id = 1, session_id = 1, name = "")) + expect_error(patch_session(vol_id = 1, session_id = 1, name = " ")) + expect_error(patch_session(vol_id = 1, session_id = 1, name = 123)) + expect_error(patch_session(vol_id = 1, session_id = 1, name = c("A", "B"))) +}) + +test_that("patch_session rejects providing both source_date and date", { + expect_error( + patch_session( + vol_id = 1, + session_id = 1, + source_date = "2024-03-15", + date = list(year = 2024, month = 3, day = 15) + ) + ) +}) + +test_that("patch_session rejects malformed source_date", { + expect_error(patch_session(vol_id = 1, session_id = 1, source_date = "not-a-date")) + expect_error(patch_session(vol_id = 1, session_id = 1, source_date = "")) + expect_error(patch_session(vol_id = 1, session_id = 1, source_date = 123)) +}) + +test_that("patch_session rejects malformed date", { + expect_error(patch_session(vol_id = 1, session_id = 1, date = "2024-03-15")) + expect_error(patch_session(vol_id = 1, session_id = 1, date = list(2024, 3, 15))) +}) + +test_that("patch_session rejects invalid release_level", { + expect_error(patch_session(vol_id = 1, session_id = 1, release_level = "")) + expect_error(patch_session(vol_id = 1, session_id = 1, release_level = 1)) + expect_error(patch_session(vol_id = 1, session_id = 1, release_level = c("A", "B"))) +}) + +test_that("patch_session rejects invalid date_precision", { + expect_error(patch_session(vol_id = 1, session_id = 1, date_precision = "")) + expect_error(patch_session(vol_id = 1, session_id = 1, date_precision = 1)) +}) + +test_that("patch_session rejects invalid default_records", { + expect_error(patch_session(vol_id = 1, session_id = 1, default_records = "1")) + expect_error(patch_session(vol_id = 1, session_id = 1, default_records = c(1, -2))) + expect_error(patch_session(vol_id = 1, session_id = 1, default_records = c(1, 0))) + expect_error(patch_session(vol_id = 1, session_id = 1, default_records = c(1.5, 2))) + expect_error(patch_session(vol_id = 1, session_id = 1, default_records = integer(0))) +}) + +test_that("patch_session rejects invalid vol_id", { + expect_error(patch_session(vol_id = -1, session_id = 1, name = "x")) + expect_error(patch_session(vol_id = 0, session_id = 1, name = "x")) + expect_error(patch_session(vol_id = "1", session_id = 1, name = "x")) + expect_error(patch_session(vol_id = TRUE, session_id = 1, name = "x")) + expect_error(patch_session(vol_id = c(1, 2), session_id = 1, name = "x")) + expect_error(patch_session(vol_id = 1.5, session_id = 1, name = "x")) +}) + +test_that("patch_session rejects invalid session_id", { + expect_error(patch_session(vol_id = 1, session_id = -1, name = "x")) + expect_error(patch_session(vol_id = 1, session_id = 0, name = "x")) + expect_error(patch_session(vol_id = 1, session_id = "1", name = "x")) + expect_error(patch_session(vol_id = 1, session_id = TRUE, name = "x")) + expect_error(patch_session(vol_id = 1, session_id = c(1, 2), name = "x")) + expect_error(patch_session(vol_id = 1, session_id = 1.5, name = "x")) +}) + +test_that("patch_session rejects invalid vb parameter", { + expect_error(patch_session(vol_id = 1, session_id = 1, name = "x", vb = -1)) + expect_error(patch_session(vol_id = 1, session_id = 1, name = "x", vb = "a")) + expect_error(patch_session(vol_id = 1, session_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(patch_session(vol_id = 1, session_id = 1, name = "x", vb = NULL)) +}) + +test_that("patch_session rejects invalid rq parameter", { + expect_error(patch_session(vol_id = 1, session_id = 1, name = "x", rq = "a")) + expect_error(patch_session(vol_id = 1, session_id = 1, name = "x", rq = -1)) + expect_error(patch_session(vol_id = 1, session_id = 1, name = "x", rq = TRUE)) +}) diff --git a/tests/testthat/test-patch_session_file.R b/tests/testthat/test-patch_session_file.R new file mode 100644 index 00000000..f08d85c6 --- /dev/null +++ b/tests/testthat/test-patch_session_file.R @@ -0,0 +1,111 @@ +# patch_session_file() --------------------------------------------------------- +login_test_account() + +test_that("patch_session_file returns NULL when no fields provided", { + expect_null( + patch_session_file( + vol_id = TEST_VOL_ID, + session_id = 1, + file_id = 1, + vb = FALSE + ) + ) +}) + +test_that("patch_session_file returns NULL for non-existent file", { + result <- patch_session_file( + vol_id = TEST_VOL_ID, + session_id = TEST_MISSING_ID, + file_id = TEST_MISSING_ID, + name = "nope", + vb = FALSE + ) + expect_null(result) +}) + +test_that("patch_session_file rejects invalid name", { + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = " ")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = 123)) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = c("A", "B"))) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = NA)) +}) + +test_that("patch_session_file rejects providing both source_date and date", { + expect_error( + patch_session_file( + vol_id = 1, + session_id = 1, + file_id = 1, + source_date = "2024-03-15", + date = list(year = 2024, month = 3, day = 15) + ) + ) +}) + +test_that("patch_session_file rejects malformed source_date", { + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, source_date = "not-a-date")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, source_date = "")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, source_date = 123)) +}) + +test_that("patch_session_file rejects malformed date", { + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, date = "2024-03-15")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, date = list(2024, 3, 15))) +}) + +test_that("patch_session_file rejects invalid release_level", { + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, release_level = "")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, release_level = 1)) +}) + +test_that("patch_session_file rejects invalid date_precision", { + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, date_precision = "")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, date_precision = 1)) +}) + +test_that("patch_session_file rejects invalid is_estimated", { + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, is_estimated = "yes")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, is_estimated = c(TRUE, FALSE))) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, is_estimated = 1)) +}) + +test_that("patch_session_file rejects invalid vol_id", { + expect_error(patch_session_file(vol_id = -1, session_id = 1, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 0, session_id = 1, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = "1", session_id = 1, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = TRUE, session_id = 1, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = c(1, 2), session_id = 1, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1.5, session_id = 1, file_id = 1, name = "x")) +}) + +test_that("patch_session_file rejects invalid session_id", { + expect_error(patch_session_file(vol_id = 1, session_id = -1, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = 0, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = "1", file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = TRUE, file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = c(1, 2), file_id = 1, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = 1.5, file_id = 1, name = "x")) +}) + +test_that("patch_session_file rejects invalid file_id", { + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = -1, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 0, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = "1", name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = TRUE, name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = c(1, 2), name = "x")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1.5, name = "x")) +}) + +test_that("patch_session_file rejects invalid vb parameter", { + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", vb = -1)) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", vb = "a")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", vb = NULL)) +}) + +test_that("patch_session_file rejects invalid rq parameter", { + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", rq = "a")) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", rq = -1)) + expect_error(patch_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", rq = TRUE)) +}) diff --git a/tests/testthat/test-remove_default_record_from_session.R b/tests/testthat/test-remove_default_record_from_session.R new file mode 100644 index 00000000..9d000e17 --- /dev/null +++ b/tests/testthat/test-remove_default_record_from_session.R @@ -0,0 +1,175 @@ +# remove_default_record_from_session() ----------------------------------------- +login_test_account() + +# create_volume_record name metric must be unique per volume; use a random +# suffix so repeated runs / leaked rows do not return HTTP 400 and NULL. +setup_attached <- function(name) { + envir <- parent.frame() + sfx <- sample(100000L:999999L, 1L) + sid <- make_test_session(sprintf("%s session %d", name, sfx), envir = envir) + if (is.null(sid)) { + return(NULL) + } + + rid <- make_test_record(sprintf("%s record %d", name, sfx), envir = envir) + if (is.null(rid)) { + return(NULL) + } + + attached <- add_default_record_to_session( + vol_id = TEST_VOL_ID, + session_id = sid, + record_id = rid, + vb = FALSE + ) + + if (!isTRUE(attached)) { + return(NULL) + } + + list(session_id = sid, record_id = rid) +} + +test_that("remove_default_record_from_session detaches a record", { + setup <- setup_attached("remove_default_record happy path") + skip_if_null_response(setup, "setup for remove_default_record happy path") + + result <- remove_default_record_from_session( + vol_id = TEST_VOL_ID, + session_id = setup$session_id, + record_id = setup$record_id, + vb = FALSE + ) + expect_true(result) + + # Verify the record is no longer among default_records + session <- get_session_by_id( + vol_id = TEST_VOL_ID, + session_id = setup$session_id, + vb = FALSE + ) + default_ids <- vapply( + session$default_records, + function(r) as.integer(r$id), + integer(1) + ) + expect_false(as.integer(setup$record_id) %in% default_ids) +}) + +test_that("remove_default_record_from_session returns FALSE for unattached record", { + sfx <- sample(100000L:999999L, 1L) + sid <- make_test_session(sprintf("remove_default_record unattached %d", sfx)) + skip_if_null_response(sid, "create_session for unattached test") + + rid <- make_test_record(sprintf("remove_default_record unattached record %d", sfx)) + skip_if_null_response(rid, "create_volume_record for unattached test") + + expect_false( + remove_default_record_from_session( + vol_id = TEST_VOL_ID, + session_id = sid, + record_id = rid, + vb = FALSE + ) + ) +}) + +test_that("remove_default_record_from_session returns FALSE for non-existent record", { + sfx <- sample(100000L:999999L, 1L) + sid <- make_test_session(sprintf("remove_default_record non-existent record %d", sfx)) + skip_if_null_response(sid, "create_session for non-existent record test") + + expect_false( + remove_default_record_from_session( + vol_id = TEST_VOL_ID, + session_id = sid, + record_id = TEST_MISSING_ID, + vb = FALSE + ) + ) +}) + +test_that("remove_default_record_from_session returns FALSE for non-existent session", { + sfx <- sample(100000L:999999L, 1L) + rid <- make_test_record(sprintf("remove_default_record non-existent session record %d", sfx)) + skip_if_null_response(rid, "create_volume_record for non-existent session test") + + expect_false( + remove_default_record_from_session( + vol_id = TEST_VOL_ID, + session_id = TEST_MISSING_ID, + record_id = rid, + vb = FALSE + ) + ) +}) + +test_that("remove_default_record_from_session works with verbose mode", { + setup <- setup_attached("remove_default_record vb") + skip_if_null_response(setup, "setup for remove_default_record vb") + + expect_true( + remove_default_record_from_session( + vol_id = TEST_VOL_ID, + session_id = setup$session_id, + record_id = setup$record_id, + vb = TRUE + ) + ) +}) + +test_that("remove_default_record_from_session works with custom request object", { + setup <- setup_attached("remove_default_record custom rq") + skip_if_null_response(setup, "setup for remove_default_record custom rq") + + custom_rq <- databraryr::make_default_request() + expect_true( + remove_default_record_from_session( + vol_id = TEST_VOL_ID, + session_id = setup$session_id, + record_id = setup$record_id, + rq = custom_rq, + vb = FALSE + ) + ) +}) + +test_that("remove_default_record_from_session rejects invalid vol_id", { + expect_error(remove_default_record_from_session(vol_id = -1, session_id = 1, record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = 0, session_id = 1, record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = "1", session_id = 1, record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = TRUE, session_id = 1, record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = c(1, 2), session_id = 1, record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = 1.5, session_id = 1, record_id = 1)) +}) + +test_that("remove_default_record_from_session rejects invalid session_id", { + expect_error(remove_default_record_from_session(vol_id = 1, session_id = -1, record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 0, record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = "1", record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = TRUE, record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = c(1, 2), record_id = 1)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1.5, record_id = 1)) +}) + +test_that("remove_default_record_from_session rejects invalid record_id", { + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = -1)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 0)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = "1")) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = TRUE)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = c(1, 2))) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 1.5)) +}) + +test_that("remove_default_record_from_session rejects invalid vb parameter", { + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 1, vb = -1)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 1, vb = "a")) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 1, vb = NULL)) +}) + +test_that("remove_default_record_from_session rejects invalid rq parameter", { + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 1, rq = "a")) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 1, rq = -1)) + expect_error(remove_default_record_from_session(vol_id = 1, session_id = 1, record_id = 1, rq = TRUE)) +}) 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..dc3e007a 100644 --- a/tests/testthat/test-search_for_tags.R +++ b/tests/testthat/test-search_for_tags.R @@ -1,6 +1,11 @@ # 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", { + login_test_account() + # Empty tag: backend treats as no tag filter; same broad public-index listing as empty q. + result <- search_for_tags("") + skip_if_null_response(result, "search_for_tags(\"\")") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) }) 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..e5fbaf38 --- /dev/null +++ b/tests/testthat/test-search_institutions.R @@ -0,0 +1,18 @@ +# search_institutions --------------------------------------------------------- + +test_that("search_institutions returns tibble", { + login_test_account() + # Empty query: no full-text clause; API lists institutions in the search index + result <- search_institutions("") + skip_if_null_response(result, "search_institutions(\"\")") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(all(c("institution_id", "score") %in% names(result))) +}) + +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..3d7427c1 --- /dev/null +++ b/tests/testthat/test-search_users.R @@ -0,0 +1,18 @@ +# search_users ---------------------------------------------------------------- + +test_that("search_users returns tibble", { + login_test_account() + # Empty query: no full-text clause; API lists users in the search index + result <- search_users("") + skip_if_null_response(result, "search_users(\"\")") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(all(c("user_id", "score") %in% names(result))) +}) + +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..86757654 --- /dev/null +++ b/tests/testthat/test-search_volumes.R @@ -0,0 +1,18 @@ +# search_volumes -------------------------------------------------------------- + +test_that("search_volumes returns tibble", { + login_test_account() + # Empty query: no full-text clause; API returns public volumes in the search index + result <- search_volumes("") + skip_if_null_response(result, "search_volumes(\"\")") + expect_s3_class(result, "tbl_df") + expect_gt(nrow(result), 0) + expect_true(all(c("volume_id", "score") %in% names(result))) +}) + +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-session_record_lifecycle.R b/tests/testthat/test-session_record_lifecycle.R new file mode 100644 index 00000000..44125203 --- /dev/null +++ b/tests/testthat/test-session_record_lifecycle.R @@ -0,0 +1,56 @@ +# Session + record integration roundtrip (idempotent via helper-fixtures.R). +login_test_account() + +test_that("full session and record lifecycle roundtrip", { + sid <- make_test_session("session_record lifecycle session") + skip_if_null_response(sid, "create_session for lifecycle") + + patched <- patch_session( + vol_id = TEST_VOL_ID, + session_id = sid, + name = "session_record lifecycle session renamed", + vb = FALSE + ) + skip_if_null_response(patched, "patch_session in lifecycle") + expect_equal(patched$name, "session_record lifecycle session renamed") + + rid <- make_test_record("session_record lifecycle record") + skip_if_null_response(rid, "create_volume_record for lifecycle") + + # Optional metric TEST_METRIC_ID_EXTRA on TEST_CATEGORY_ID / TEST_VOL_ID (see create_volume_record tests). + measure_result <- set_record_measure( + vol_id = TEST_VOL_ID, + record_id = rid, + metric_id = TEST_METRIC_ID_EXTRA, + value = "Lifecycle measure value", + vb = FALSE + ) + skip_if_null_response(measure_result, "set_record_measure in lifecycle") + + expect_true( + add_default_record_to_session( + vol_id = TEST_VOL_ID, + session_id = sid, + record_id = rid, + vb = FALSE + ) + ) + + expect_true( + remove_default_record_from_session( + vol_id = TEST_VOL_ID, + session_id = sid, + record_id = rid, + vb = FALSE + ) + ) + + updated <- update_volume_record( + vol_id = TEST_VOL_ID, + record_id = rid, + measures = list("29" = "Lifecycle updated"), + vb = FALSE + ) + skip_if_null_response(updated, "update_volume_record in lifecycle") + expect_equal(updated$record_id, rid) +}) diff --git a/tests/testthat/test-set_record_measure.R b/tests/testthat/test-set_record_measure.R new file mode 100644 index 00000000..d4aad3fe --- /dev/null +++ b/tests/testthat/test-set_record_measure.R @@ -0,0 +1,122 @@ +# set_record_measure() --------------------------------------------------------- +login_test_account() + +test_that("set_record_measure sets a text measure", { + record_id <- make_test_record("Set measure test") + skip_if_null_response(record_id, "create_volume_record for set_measure test") + + measure_result <- set_record_measure( + vol_id = TEST_VOL_ID, + record_id = record_id, + metric_id = TEST_METRIC_ID, + value = "Test value", + vb = FALSE + ) + + skip_if_null_response(measure_result, "set_record_measure") + + expect_true(!is.null(measure_result)) +}) + +test_that("set_record_measure updates an existing measure", { + record_id <- make_test_record("Initial") + skip_if_null_response(record_id, "create_volume_record for set_measure update test") + + measure_result <- set_record_measure( + vol_id = TEST_VOL_ID, + record_id = record_id, + metric_id = TEST_METRIC_ID, + value = "Updated", + vb = FALSE + ) + + skip_if_null_response(measure_result, "set_record_measure update") + + expect_true(!is.null(measure_result)) +}) + +test_that("set_record_measure returns NULL for non-existent record", { + result <- set_record_measure( + vol_id = TEST_VOL_ID, + record_id = TEST_MISSING_ID, + metric_id = TEST_METRIC_ID, + value = "Test", + vb = FALSE + ) + expect_null(result) +}) + +test_that("set_record_measure works with verbose mode", { + record_id <- make_test_record("Set measure vb") + skip_if_null_response(record_id, "create_volume_record for set_measure verbose test") + + measure_result <- set_record_measure( + vol_id = TEST_VOL_ID, + record_id = record_id, + metric_id = TEST_METRIC_ID, + value = "Test", + vb = TRUE + ) + + skip_if_null_response(measure_result, "set_record_measure with vb = TRUE") + + expect_true(!is.null(measure_result)) +}) + +test_that("set_record_measure rejects invalid vol_id", { + expect_error(set_record_measure(vol_id = -1, record_id = 1, metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = 0, record_id = 1, metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = "1", record_id = 1, metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = TRUE, record_id = 1, metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = c(1, 2), record_id = 1, metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = 1.5, record_id = 1, metric_id = 1, value = "test")) +}) + +test_that("set_record_measure rejects invalid record_id", { + expect_error(set_record_measure(vol_id = 1, record_id = -1, metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = 0, metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = "1", metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = TRUE, metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = c(1, 2), metric_id = 1, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = 1.5, metric_id = 1, value = "test")) +}) + +test_that("set_record_measure rejects invalid metric_id", { + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = -1, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 0, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = "1", value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = TRUE, value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = c(1, 2), value = "test")) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1.5, value = "test")) +}) + +test_that("set_record_measure rejects invalid vb parameter", { + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1, value = "test", vb = -1)) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1, value = "test", vb = 3)) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1, value = "test", vb = "a")) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1, value = "test", vb = c(TRUE, FALSE))) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1, value = "test", vb = NULL)) +}) + +test_that("set_record_measure rejects invalid rq parameter", { + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1, value = "test", rq = "a")) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1, value = "test", rq = -1)) + expect_error(set_record_measure(vol_id = 1, record_id = 1, metric_id = 1, value = "test", rq = TRUE)) +}) + +test_that("set_record_measure works with numeric values", { + record_id <- make_test_record("Numeric measure test") + skip_if_null_response(record_id, "create_volume_record for numeric measure test") + + measure_result <- set_record_measure( + vol_id = TEST_VOL_ID, + record_id = record_id, + metric_id = TEST_METRIC_ID, + value = 42.5, + vb = FALSE + ) + + skip_if_null_response(measure_result, "set_record_measure numeric") + + expect_true(!is.null(measure_result)) +}) diff --git a/tests/testthat/test-snake_case_list.R b/tests/testthat/test-snake_case_list.R new file mode 100644 index 00000000..b8fd6948 --- /dev/null +++ b/tests/testthat/test-snake_case_list.R @@ -0,0 +1,101 @@ +# snake_case_list() ----------------------------------------------------------- +# These are unit tests that exercise the iterative implementation directly +# (no network calls required). + +test_that("snake_case_list converts camelCase keys", { + input <- list(firstName = "Jane", lastName = "Doe") + result <- databraryr:::snake_case_list(input) + expect_equal(names(result), c("first_name", "last_name")) + expect_equal(result$first_name, "Jane") +}) + +test_that("snake_case_list converts nested structures", { + input <- list( + categoryId = 1, + measures = list(heightCm = 120, weightKg = 25), + participant = list( + birthDate = list(year = 2020, monthOfYear = 1, dayOfMonth = 15) + ) + ) + result <- databraryr:::snake_case_list(input) + expect_equal(names(result), c("category_id", "measures", "participant")) + expect_equal(names(result$measures), c("height_cm", "weight_kg")) + expect_equal(names(result$participant), c("birth_date")) + expect_equal(names(result$participant$birth_date), c("year", "month_of_year", "day_of_month")) +}) + +test_that("snake_case_list handles unnamed lists (arrays)", { + input <- list( + list(recordId = 1, categoryId = 10), + list(recordId = 2, categoryId = 20) + ) + result <- databraryr:::snake_case_list(input) + expect_null(names(result)) + expect_equal(names(result[[1]]), c("record_id", "category_id")) + expect_equal(names(result[[2]]), c("record_id", "category_id")) +}) + +test_that("snake_case_list handles scalar passthrough", { + expect_equal(databraryr:::snake_case_list(42), 42) + expect_equal(databraryr:::snake_case_list("hello"), "hello") + expect_equal(databraryr:::snake_case_list(TRUE), TRUE) + expect_null(databraryr:::snake_case_list(NULL)) +}) + +test_that("snake_case_list handles empty list", { + result <- databraryr:::snake_case_list(list()) + expect_equal(result, list()) +}) + +test_that("snake_case_list handles named vectors", { + input <- c(totalDays = 100, formattedValue = "3 months") + result <- databraryr:::snake_case_list(input) + expect_equal(names(result), c("total_days", "formatted_value")) +}) + +test_that("snake_case_list handles deeply nested record with age (QA repro)", { + # Simulates the API response that caused stack overflow + input <- list( + id = 123, + volume = 2136, + categoryId = 1, + measures = list("1" = "P001", "2" = "Female"), + birthday = list(metricId = 4, value = list(year = 2020, month = 3, day = 15)), + age = list( + years = 5, + months = 64, + days = 1948, + totalDays = 1948, + formattedValue = "5 years, 4 months", + isEstimated = FALSE, + isBlurred = FALSE + ) + ) + result <- databraryr:::snake_case_list(input) + + expect_equal(result$category_id, 1) + expect_equal(names(result$age), c( + "years", "months", "days", "total_days", + "formatted_value", "is_estimated", "is_blurred" + )) + expect_equal(result$age$total_days, 1948) + expect_equal(names(result$birthday), c("metric_id", "value")) +}) + +test_that("snake_case_list handles wide list of records without stack overflow", { + # Create a wide list simulating a paginated response with many records + records <- lapply(seq_len(200), function(i) { + list( + recordId = i, + categoryId = 1, + measures = list(nameField = paste0("Record_", i)), + age = list(totalDays = i * 10, formattedValue = paste0(i, " days")) + ) + }) + page <- list(count = 200L, nextUrl = NULL, previousUrl = NULL, results = records) + + result <- databraryr:::snake_case_list(page) + expect_equal(result$count, 200L) + expect_equal(names(result$results[[1]]), c("record_id", "category_id", "measures", "age")) + expect_equal(result$results[[200]]$age$total_days, 2000) +}) diff --git a/tests/testthat/test-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-unassign_record_from_file.R b/tests/testthat/test-unassign_record_from_file.R new file mode 100644 index 00000000..1c577742 --- /dev/null +++ b/tests/testthat/test-unassign_record_from_file.R @@ -0,0 +1,197 @@ +# unassign_record_from_file() -------------------------------------------------- +login_test_account() + +test_that("unassign_record_from_file unassigns a record from a file", { + sid <- make_test_session("unassign_record happy session") + skip_if_null_response(sid, "create_session for unassign test") + + asset_name <- sprintf("unassign_probe_%d.txt", sample(100000L:999999L, 1L)) + file_id <- upload_test_session_asset(sid, file_basename = asset_name) + skip_if_null_response(file_id, "upload for unassign test") + + create_result <- create_volume_record( + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, + name = sprintf("Unassign test %d", sample(100000L:999999L, 1L)), + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for unassign test") + + record_id <- create_result$record_id + withr::defer( + { + try( + unassign_record_from_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ), + silent = TRUE + ) + try( + delete_volume_record(vol_id = TEST_VOL_ID, record_id = record_id, vb = FALSE), + silent = TRUE + ) + }, + envir = parent.frame() + ) + + assign_record_to_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) + + unassign_result <- unassign_record_from_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) + + expect_true(unassign_result) +}) + +test_that("unassign_record_from_file returns FALSE for non-assigned record", { + sid <- make_test_session("unassign_record fail session") + skip_if_null_response(sid, "create_session for unassign fail test") + + asset_name <- sprintf("unassign_fail_%d.txt", sample(100000L:999999L, 1L)) + file_id <- upload_test_session_asset(sid, file_basename = asset_name) + skip_if_null_response(file_id, "upload for unassign fail test") + + create_result <- create_volume_record( + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, + name = sprintf("Unassign fail %d", sample(100000L:999999L, 1L)), + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for unassign fail test") + + record_id <- create_result$record_id + withr::defer( + try(delete_volume_record(vol_id = TEST_VOL_ID, record_id = record_id, vb = FALSE), silent = TRUE), + envir = parent.frame() + ) + + unassign_result <- unassign_record_from_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) + + expect_false(unassign_result) +}) + +test_that("unassign_record_from_file works with verbose mode", { + sid <- make_test_session("unassign_record verbose session") + skip_if_null_response(sid, "create_session for unassign verbose test") + + asset_name <- sprintf("unassign_verbose_%d.txt", sample(100000L:999999L, 1L)) + file_id <- upload_test_session_asset(sid, file_basename = asset_name) + skip_if_null_response(file_id, "upload for unassign verbose test") + + create_result <- create_volume_record( + vol_id = TEST_VOL_ID, + category_id = TEST_CATEGORY_ID, + name = sprintf("Unassign verbose %d", sample(100000L:999999L, 1L)), + vb = FALSE + ) + skip_if_null_response(create_result, "create_volume_record for unassign verbose test") + + record_id <- create_result$record_id + withr::defer( + { + try( + unassign_record_from_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ), + silent = TRUE + ) + try( + delete_volume_record(vol_id = TEST_VOL_ID, record_id = record_id, vb = FALSE), + silent = TRUE + ) + }, + envir = parent.frame() + ) + + assign_record_to_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = FALSE + ) + + unassign_result <- unassign_record_from_file( + vol_id = TEST_VOL_ID, + session_id = sid, + file_id = file_id, + record_id = record_id, + vb = TRUE + ) + + expect_true(unassign_result) +}) + +test_that("unassign_record_from_file rejects invalid vol_id", { + expect_error(unassign_record_from_file(vol_id = -1, session_id = 1, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 0, session_id = 1, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = "1", session_id = 1, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = TRUE, session_id = 1, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = c(1, 2), session_id = 1, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1.5, session_id = 1, file_id = 1, record_id = 1)) +}) + +test_that("unassign_record_from_file rejects invalid session_id", { + expect_error(unassign_record_from_file(vol_id = 1, session_id = -1, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 0, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = "1", file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = TRUE, file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = c(1, 2), file_id = 1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1.5, file_id = 1, record_id = 1)) +}) + +test_that("unassign_record_from_file rejects invalid file_id", { + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = -1, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 0, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = "1", record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = TRUE, record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = c(1, 2), record_id = 1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1.5, record_id = 1)) +}) + +test_that("unassign_record_from_file rejects invalid record_id", { + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = -1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 0)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = "1")) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = TRUE)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = c(1, 2))) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1.5)) +}) + +test_that("unassign_record_from_file rejects invalid vb parameter", { + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = -1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = 3)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = "a")) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, vb = NULL)) +}) + +test_that("unassign_record_from_file rejects invalid rq parameter", { + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, rq = "a")) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, rq = -1)) + expect_error(unassign_record_from_file(vol_id = 1, session_id = 1, file_id = 1, record_id = 1, rq = TRUE)) +}) diff --git a/tests/testthat/test-update_folder.R b/tests/testthat/test-update_folder.R new file mode 100644 index 00000000..51eca4bf --- /dev/null +++ b/tests/testthat/test-update_folder.R @@ -0,0 +1,126 @@ +# update_folder() -------------------------------------------------------------- +login_test_account() + +test_that("update_folder replaces name via PUT", { + fid <- make_test_folder("update_folder original") + skip_if_null_response(fid, "create_folder for update_folder name test") + + result <- update_folder( + vol_id = TEST_VOL_ID, + folder_id = fid, + name = "update_folder replaced", + vb = FALSE + ) + skip_if_null_response(result, "update_folder(name=...)") + + expect_type(result, "list") + expect_equal(result$name, "update_folder replaced") + expect_equal(as.integer(result$id), as.integer(fid)) +}) + +test_that("update_folder replaces source_date with a Date object", { + fid <- make_test_folder("update_folder source_date Date") + skip_if_null_response(fid, "create_folder for update_folder source_date Date") + + result <- update_folder( + vol_id = TEST_VOL_ID, + folder_id = fid, + name = "update_folder source_date Date", + source_date = as.Date("2024-03-15"), + vb = FALSE + ) + skip_if_null_response(result, "update_folder(source_date=Date)") + expect_type(result, "list") +}) + +test_that("update_folder returns NULL for non-existent folder", { + result <- update_folder( + vol_id = TEST_VOL_ID, + folder_id = TEST_MISSING_ID, + name = "nope", + vb = FALSE + ) + expect_null(result) +}) + +test_that("update_folder works with verbose mode", { + fid <- make_test_folder("update_folder vb") + skip_if_null_response(fid, "create_folder for update_folder vb") + + result <- update_folder( + vol_id = TEST_VOL_ID, + folder_id = fid, + name = "update_folder vb replaced", + vb = TRUE + ) + skip_if_null_response(result, "update_folder vb") + expect_type(result, "list") +}) + +test_that("update_folder works with custom request object", { + fid <- make_test_folder("update_folder custom rq") + skip_if_null_response(fid, "create_folder for update_folder custom rq") + + custom_rq <- databraryr::make_default_request() + result <- update_folder( + vol_id = TEST_VOL_ID, + folder_id = fid, + name = "update_folder custom rq replaced", + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "update_folder custom rq") + expect_type(result, "list") +}) + +test_that("update_folder rejects missing/invalid name", { + expect_error(update_folder(vol_id = 1, folder_id = 1)) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "")) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = " ")) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = 123)) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = c("A", "B"))) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = NULL)) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = NA)) +}) + +test_that("update_folder rejects malformed source_date", { + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", source_date = "not-a-date")) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", source_date = "")) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", source_date = 123)) +}) + +test_that("update_folder rejects invalid release_level", { + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", release_level = "")) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", release_level = 1)) +}) + +test_that("update_folder rejects invalid vol_id", { + expect_error(update_folder(vol_id = -1, folder_id = 1, name = "x")) + expect_error(update_folder(vol_id = 0, folder_id = 1, name = "x")) + expect_error(update_folder(vol_id = "1", folder_id = 1, name = "x")) + expect_error(update_folder(vol_id = TRUE, folder_id = 1, name = "x")) + expect_error(update_folder(vol_id = c(1, 2), folder_id = 1, name = "x")) + expect_error(update_folder(vol_id = 1.5, folder_id = 1, name = "x")) +}) + +test_that("update_folder rejects invalid folder_id", { + expect_error(update_folder(vol_id = 1, folder_id = -1, name = "x")) + expect_error(update_folder(vol_id = 1, folder_id = 0, name = "x")) + expect_error(update_folder(vol_id = 1, folder_id = "1", name = "x")) + expect_error(update_folder(vol_id = 1, folder_id = TRUE, name = "x")) + expect_error(update_folder(vol_id = 1, folder_id = c(1, 2), name = "x")) + expect_error(update_folder(vol_id = 1, folder_id = 1.5, name = "x")) +}) + +test_that("update_folder rejects invalid vb parameter", { + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", vb = -1)) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", vb = "a")) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", vb = NULL)) +}) + +test_that("update_folder rejects invalid rq parameter", { + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", rq = "a")) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", rq = -1)) + expect_error(update_folder(vol_id = 1, folder_id = 1, name = "x", rq = TRUE)) +}) diff --git a/tests/testthat/test-update_session.R b/tests/testthat/test-update_session.R new file mode 100644 index 00000000..d4818c49 --- /dev/null +++ b/tests/testthat/test-update_session.R @@ -0,0 +1,156 @@ +# update_session() ------------------------------------------------------------- +login_test_account() + +test_that("update_session replaces name via PUT", { + sid <- make_test_session("update_session original") + skip_if_null_response(sid, "create_session for update_session name test") + + result <- update_session( + vol_id = TEST_VOL_ID, + session_id = sid, + name = "update_session replaced", + vb = FALSE + ) + skip_if_null_response(result, "update_session(name=...)") + + expect_type(result, "list") + expect_equal(result$name, "update_session replaced") + expect_equal(as.integer(result$id), as.integer(sid)) +}) + +test_that("update_session replaces source_date with a Date object", { + sid <- make_test_session("update_session source_date Date") + skip_if_null_response(sid, "create_session for update_session source_date Date") + + result <- update_session( + vol_id = TEST_VOL_ID, + session_id = sid, + name = "update_session source_date Date", + source_date = as.Date("2024-03-15"), + vb = FALSE + ) + skip_if_null_response(result, "update_session(source_date=Date)") + expect_type(result, "list") +}) + +test_that("update_session returns NULL for non-existent session", { + result <- update_session( + vol_id = TEST_VOL_ID, + session_id = TEST_MISSING_ID, + name = "nope", + vb = FALSE + ) + expect_null(result) +}) + +test_that("update_session works with verbose mode", { + sid <- make_test_session("update_session vb") + skip_if_null_response(sid, "create_session for update_session vb") + + result <- update_session( + vol_id = TEST_VOL_ID, + session_id = sid, + name = "update_session vb replaced", + vb = TRUE + ) + skip_if_null_response(result, "update_session vb") + expect_type(result, "list") +}) + +test_that("update_session works with custom request object", { + sid <- make_test_session("update_session custom rq") + skip_if_null_response(sid, "create_session for update_session custom rq") + + custom_rq <- databraryr::make_default_request() + result <- update_session( + vol_id = TEST_VOL_ID, + session_id = sid, + name = "update_session custom rq replaced", + rq = custom_rq, + vb = FALSE + ) + skip_if_null_response(result, "update_session custom rq") + expect_type(result, "list") +}) + +test_that("update_session rejects missing/invalid name", { + expect_error(update_session(vol_id = 1, session_id = 1)) + expect_error(update_session(vol_id = 1, session_id = 1, name = "")) + expect_error(update_session(vol_id = 1, session_id = 1, name = " ")) + expect_error(update_session(vol_id = 1, session_id = 1, name = 123)) + expect_error(update_session(vol_id = 1, session_id = 1, name = c("A", "B"))) + expect_error(update_session(vol_id = 1, session_id = 1, name = NULL)) + expect_error(update_session(vol_id = 1, session_id = 1, name = NA)) +}) + +test_that("update_session rejects providing both source_date and date", { + expect_error( + update_session( + vol_id = 1, + session_id = 1, + name = "x", + source_date = "2024-03-15", + date = list(year = 2024, month = 3, day = 15) + ) + ) +}) + +test_that("update_session rejects malformed source_date", { + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", source_date = "not-a-date")) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", source_date = "")) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", source_date = 123)) +}) + +test_that("update_session rejects malformed date", { + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", date = "2024-03-15")) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", date = list(2024, 3, 15))) +}) + +test_that("update_session rejects invalid release_level", { + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", release_level = "")) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", release_level = 1)) +}) + +test_that("update_session rejects invalid date_precision", { + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", date_precision = "")) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", date_precision = 1)) +}) + +test_that("update_session rejects invalid default_records", { + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", default_records = "1")) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", default_records = c(1, -2))) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", default_records = c(1, 0))) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", default_records = c(1.5, 2))) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", default_records = integer(0))) +}) + +test_that("update_session rejects invalid vol_id", { + expect_error(update_session(vol_id = -1, session_id = 1, name = "x")) + expect_error(update_session(vol_id = 0, session_id = 1, name = "x")) + expect_error(update_session(vol_id = "1", session_id = 1, name = "x")) + expect_error(update_session(vol_id = TRUE, session_id = 1, name = "x")) + expect_error(update_session(vol_id = c(1, 2), session_id = 1, name = "x")) + expect_error(update_session(vol_id = 1.5, session_id = 1, name = "x")) +}) + +test_that("update_session rejects invalid session_id", { + expect_error(update_session(vol_id = 1, session_id = -1, name = "x")) + expect_error(update_session(vol_id = 1, session_id = 0, name = "x")) + expect_error(update_session(vol_id = 1, session_id = "1", name = "x")) + expect_error(update_session(vol_id = 1, session_id = TRUE, name = "x")) + expect_error(update_session(vol_id = 1, session_id = c(1, 2), name = "x")) + expect_error(update_session(vol_id = 1, session_id = 1.5, name = "x")) +}) + +test_that("update_session rejects invalid vb parameter", { + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", vb = -1)) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", vb = "a")) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", vb = NULL)) +}) + +test_that("update_session rejects invalid rq parameter", { + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", rq = "a")) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", rq = -1)) + expect_error(update_session(vol_id = 1, session_id = 1, name = "x", rq = TRUE)) +}) diff --git a/tests/testthat/test-update_session_file.R b/tests/testthat/test-update_session_file.R new file mode 100644 index 00000000..3212563c --- /dev/null +++ b/tests/testthat/test-update_session_file.R @@ -0,0 +1,103 @@ +# update_session_file() -------------------------------------------------------- +login_test_account() + +test_that("update_session_file returns NULL for non-existent file", { + result <- update_session_file( + vol_id = TEST_VOL_ID, + session_id = TEST_MISSING_ID, + file_id = TEST_MISSING_ID, + name = "nope", + vb = FALSE + ) + expect_null(result) +}) + +test_that("update_session_file rejects missing/invalid name", { + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = " ")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = 123)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = c("A", "B"))) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = NULL)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = NA)) +}) + +test_that("update_session_file rejects providing both source_date and date", { + expect_error( + update_session_file( + vol_id = 1, + session_id = 1, + file_id = 1, + name = "x", + source_date = "2024-03-15", + date = list(year = 2024, month = 3, day = 15) + ) + ) +}) + +test_that("update_session_file rejects malformed source_date", { + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", source_date = "not-a-date")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", source_date = "")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", source_date = 123)) +}) + +test_that("update_session_file rejects malformed date", { + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", date = "2024-03-15")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", date = list(2024, 3, 15))) +}) + +test_that("update_session_file rejects invalid release_level", { + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", release_level = "")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", release_level = 1)) +}) + +test_that("update_session_file rejects invalid date_precision", { + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", date_precision = "")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", date_precision = 1)) +}) + +test_that("update_session_file rejects invalid is_estimated", { + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", is_estimated = "yes")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", is_estimated = c(TRUE, FALSE))) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", is_estimated = 1)) +}) + +test_that("update_session_file rejects invalid vol_id", { + expect_error(update_session_file(vol_id = -1, session_id = 1, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 0, session_id = 1, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = "1", session_id = 1, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = TRUE, session_id = 1, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = c(1, 2), session_id = 1, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1.5, session_id = 1, file_id = 1, name = "x")) +}) + +test_that("update_session_file rejects invalid session_id", { + expect_error(update_session_file(vol_id = 1, session_id = -1, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = 0, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = "1", file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = TRUE, file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = c(1, 2), file_id = 1, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = 1.5, file_id = 1, name = "x")) +}) + +test_that("update_session_file rejects invalid file_id", { + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = -1, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 0, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = "1", name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = TRUE, name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = c(1, 2), name = "x")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1.5, name = "x")) +}) + +test_that("update_session_file rejects invalid vb parameter", { + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", vb = -1)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", vb = "a")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", vb = c(TRUE, FALSE))) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", vb = NULL)) +}) + +test_that("update_session_file rejects invalid rq parameter", { + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", rq = "a")) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", rq = -1)) + expect_error(update_session_file(vol_id = 1, session_id = 1, file_id = 1, name = "x", rq = TRUE)) +}) diff --git a/tests/testthat/test-update_volume_record.R b/tests/testthat/test-update_volume_record.R new file mode 100644 index 00000000..ce315eec --- /dev/null +++ b/tests/testthat/test-update_volume_record.R @@ -0,0 +1,88 @@ +# update_volume_record() ------------------------------------------------------- +login_test_account() + +test_that("update_volume_record updates an existing record", { + record_id <- make_test_record("Initial value") + skip_if_null_response(record_id, "create_volume_record for update test") + + update_result <- update_volume_record( + vol_id = TEST_VOL_ID, + record_id = record_id, + measures = list("29" = "Updated value"), + vb = FALSE + ) + + skip_if_null_response(update_result, "update_volume_record") + + expect_type(update_result, "list") + expect_named(update_result, c( + "record_id", "record_volume", "record_volume_name", "record_category_id", + "measures", "birthday", "age", "default_sessions", "record_source_kind" + )) + expect_equal(update_result$record_id, record_id) + expect_true(!is.null(update_result$measures)) +}) + +test_that("update_volume_record returns NULL for non-existent record", { + result <- update_volume_record( + vol_id = TEST_VOL_ID, + record_id = TEST_MISSING_ID, + measures = list("29" = "Test"), + vb = FALSE + ) + expect_null(result) +}) + +test_that("update_volume_record works with verbose mode", { + record_id <- make_test_record("Update verbose test") + skip_if_null_response(record_id, "create_volume_record for update verbose test") + + update_result <- update_volume_record( + vol_id = TEST_VOL_ID, + record_id = record_id, + measures = list("29" = "Test"), + vb = TRUE + ) + + skip_if_null_response(update_result, "update_volume_record with vb = TRUE") + + expect_type(update_result, "list") +}) + +test_that("update_volume_record rejects invalid vol_id", { + expect_error(update_volume_record(vol_id = -1, record_id = 1)) + expect_error(update_volume_record(vol_id = 0, record_id = 1)) + expect_error(update_volume_record(vol_id = "1", record_id = 1)) + expect_error(update_volume_record(vol_id = TRUE, record_id = 1)) + expect_error(update_volume_record(vol_id = c(1, 2), record_id = 1)) + expect_error(update_volume_record(vol_id = 1.5, record_id = 1)) +}) + +test_that("update_volume_record rejects invalid record_id", { + expect_error(update_volume_record(vol_id = 1, record_id = -1)) + expect_error(update_volume_record(vol_id = 1, record_id = 0)) + expect_error(update_volume_record(vol_id = 1, record_id = "1")) + expect_error(update_volume_record(vol_id = 1, record_id = TRUE)) + expect_error(update_volume_record(vol_id = 1, record_id = c(1, 2))) + expect_error(update_volume_record(vol_id = 1, record_id = 1.5)) +}) + +test_that("update_volume_record rejects invalid measures", { + expect_error(update_volume_record(vol_id = 1, record_id = 1, measures = "text")) + expect_error(update_volume_record(vol_id = 1, record_id = 1, measures = 123)) + expect_error(update_volume_record(vol_id = 1, record_id = 1, measures = TRUE)) +}) + +test_that("update_volume_record rejects invalid vb parameter", { + expect_error(update_volume_record(vol_id = 1, record_id = 1, vb = -1)) + expect_error(update_volume_record(vol_id = 1, record_id = 1, vb = 3)) + expect_error(update_volume_record(vol_id = 1, record_id = 1, vb = "a")) + expect_error(update_volume_record(vol_id = 1, record_id = 1, vb = c(TRUE, FALSE))) + expect_error(update_volume_record(vol_id = 1, record_id = 1, vb = NULL)) +}) + +test_that("update_volume_record rejects invalid rq parameter", { + expect_error(update_volume_record(vol_id = 1, record_id = 1, rq = "a")) + expect_error(update_volume_record(vol_id = 1, record_id = 1, rq = -1)) + expect_error(update_volume_record(vol_id = 1, record_id = 1, rq = TRUE)) +}) diff --git a/tests/testthat/test-upload_file.R b/tests/testthat/test-upload_file.R new file mode 100644 index 00000000..b08ae4c1 --- /dev/null +++ b/tests/testthat/test-upload_file.R @@ -0,0 +1,111 @@ +# upload_file() ---------------------------------------------------------------- +login_test_account() + +test_that("upload_file rejects missing or empty path", { + expect_error(upload_file( + path = "/nope/does/not/exist", destination_type = "session", object_id = 1 + )) + expect_error(upload_file( + path = "", destination_type = "session", object_id = 1 + )) +}) + +test_that("upload_file rejects empty file", { + empty <- tempfile() + file.create(empty) + on.exit(unlink(empty), add = TRUE) + expect_error(upload_file( + path = empty, destination_type = "session", object_id = 1 + )) +}) + +test_that("upload_file uploads a small file end-to-end", { + sid <- make_test_session("upload_file test") + skip_if_null_response(sid, "create_session for upload_file") + + tmp <- tempfile(fileext = ".txt") + on.exit(unlink(tmp), add = TRUE) + writeLines(strrep("x", 2048L), tmp, useBytes = FALSE) + + result <- upload_file( + path = tmp, + destination_type = "session", + object_id = sid, + content_type = "text/plain", + vb = FALSE + ) + skip_if_null_response(result, "upload_file end-to-end") + + expect_type(result, "list") + expect_true(!is.null(result$status_url)) + expect_true(result$upload_type %in% c("single", "multipart")) +}) + +test_that("upload_file infers filename and content_type", { + sid <- make_test_session("upload_file inference test") + skip_if_null_response(sid, "create_session for upload_file inference") + + tmp <- tempfile(fileext = ".mp4") + on.exit(unlink(tmp), add = TRUE) + writeBin(as.raw(seq_len(1024L) %% 256L), tmp) + + result <- upload_file( + path = tmp, + destination_type = "session", + object_id = sid, + vb = FALSE + ) + skip_if_null_response(result, "upload_file inference") + + expect_type(result, "list") +}) + +# Internal helpers ------------------------------------------------------------- + +test_that("read_file_chunk reads a byte range", { + tmp <- tempfile() + on.exit(unlink(tmp), add = TRUE) + writeBin(as.raw(0:255), tmp) + + expect_equal(databraryr:::read_file_chunk(tmp, 0, 4), as.raw(0:3)) + expect_equal(databraryr:::read_file_chunk(tmp, 10, 3), as.raw(10:12)) + # Past EOF returns whatever remains. + expect_equal( + length(databraryr:::read_file_chunk(tmp, 250, 100)), + 6L + ) +}) + +test_that("unquote_etag strips surrounding quotes", { + expect_equal(databraryr:::unquote_etag('"abc123"'), "abc123") + expect_equal(databraryr:::unquote_etag("abc123"), "abc123") + expect_equal(databraryr:::unquote_etag(""), "") + expect_null(databraryr:::unquote_etag(NULL)) +}) + +test_that("normalize_part_urls sorts by part_number", { + shuffled <- list( + list(part_number = 3L, url = "c"), + list(part_number = 1L, url = "a"), + list(part_number = 2L, url = "b") + ) + sorted <- databraryr:::normalize_part_urls(shuffled) + expect_equal( + vapply(sorted, function(p) p$url, character(1)), + c("a", "b", "c") + ) +}) + +test_that("guess_content_type maps common extensions", { + expect_equal(databraryr:::guess_content_type("a.mp4"), "video/mp4") + expect_equal(databraryr:::guess_content_type("a.MP4"), "video/mp4") + expect_equal(databraryr:::guess_content_type("a.csv"), "text/csv") + expect_equal( + databraryr:::guess_content_type("a.unknown"), + "application/octet-stream" + ) + expect_equal( + databraryr:::guess_content_type("noext"), + "application/octet-stream" + ) +}) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 5c77bf54..e309db26 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1,71 +1,35 @@ -# 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 ---------------------------------------------------- test_that("get_supported_file_types returns data.frame", { - expect_true(is.data.frame(get_supported_file_types())) + login_test_account() + result <- get_supported_file_types() + skip_if_null_response(result, "get_supported_file_types()") + expect_true(is.data.frame(result)) }) test_that("get_supported_file_types rejects bad input parameters", { @@ -74,42 +38,6 @@ test_that("get_supported_file_types rejects bad input parameters", { expect_error(get_supported_file_types(vb = "a")) }) -# HHMMSSmmm_to_ms --------------------------------------------------- -test_that("HHMMSSmmm_to_ms returns number", { - expect_true(class(HHMMSSmmm_to_ms()) == "numeric") -}) - -test_that("HHMMSSmmm_to_ms rejects bad input parameters", { - expect_error(HHMMSSmmm_to_ms(HHMMSSmmm = -1)) - #expect_error(HHMMSSmmm_to_ms(HHMMSSmmm = "a")) - #expect_error(HHMMSSmmm_to_ms(HHMMSSmmm = list(a=1, b=2))) - expect_error(HHMMSSmmm_to_ms(HHMMSSmmm = TRUE)) -}) - -# 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-volume_categories.R b/tests/testthat/test-volume_categories.R new file mode 100644 index 00000000..db66c248 --- /dev/null +++ b/tests/testthat/test-volume_categories.R @@ -0,0 +1,135 @@ +# get_volume_enabled_categories() – validation -------------------------------- + +test_that("get_volume_enabled_categories rejects invalid vol_id", { + expect_error(get_volume_enabled_categories(vol_id = -1)) + expect_error(get_volume_enabled_categories(vol_id = 0)) + expect_error(get_volume_enabled_categories(vol_id = "a")) + expect_error(get_volume_enabled_categories(vol_id = TRUE)) + expect_error(get_volume_enabled_categories(vol_id = c(1, 2))) + expect_error(get_volume_enabled_categories(vol_id = 1.5)) +}) + +test_that("get_volume_enabled_categories rejects invalid vb", { + expect_error(get_volume_enabled_categories(vol_id = 1, vb = -1)) + expect_error(get_volume_enabled_categories(vol_id = 1, vb = "a")) + expect_error(get_volume_enabled_categories(vol_id = 1, vb = c(TRUE, FALSE))) +}) + +test_that("get_volume_enabled_categories rejects invalid rq", { + expect_error(get_volume_enabled_categories(vol_id = 1, rq = "a")) + expect_error(get_volume_enabled_categories(vol_id = 1, rq = -1)) + expect_error(get_volume_enabled_categories(vol_id = 1, rq = TRUE)) +}) + +# set_volume_enabled_categories() – validation -------------------------------- + +test_that("set_volume_enabled_categories rejects invalid vol_id", { + expect_error(set_volume_enabled_categories(vol_id = -1, category_ids = c(1))) + expect_error(set_volume_enabled_categories(vol_id = 0, category_ids = c(1))) + expect_error(set_volume_enabled_categories(vol_id = "a", category_ids = c(1))) + expect_error(set_volume_enabled_categories(vol_id = TRUE, category_ids = c(1))) +}) + +test_that("set_volume_enabled_categories rejects invalid vb", { + expect_error(set_volume_enabled_categories(vol_id = 1, category_ids = c(1), vb = -1)) + expect_error(set_volume_enabled_categories(vol_id = 1, category_ids = c(1), vb = "a")) +}) + +test_that("set_volume_enabled_categories rejects invalid rq", { + expect_error(set_volume_enabled_categories(vol_id = 1, category_ids = c(1), rq = "a")) + expect_error(set_volume_enabled_categories(vol_id = 1, category_ids = c(1), rq = -1)) +}) + +# enable_volume_category() – validation --------------------------------------- + +test_that("enable_volume_category rejects invalid vol_id", { + expect_error(enable_volume_category(vol_id = -1, category_id = 1)) + expect_error(enable_volume_category(vol_id = 0, category_id = 1)) + expect_error(enable_volume_category(vol_id = "a", category_id = 1)) + expect_error(enable_volume_category(vol_id = TRUE, category_id = 1)) +}) + +test_that("enable_volume_category rejects invalid category_id", { + expect_error(enable_volume_category(vol_id = 1, category_id = -1)) + expect_error(enable_volume_category(vol_id = 1, category_id = 0)) + expect_error(enable_volume_category(vol_id = 1, category_id = "a")) + expect_error(enable_volume_category(vol_id = 1, category_id = TRUE)) + expect_error(enable_volume_category(vol_id = 1, category_id = c(1, 2))) +}) + +test_that("enable_volume_category rejects invalid vb", { + expect_error(enable_volume_category(vol_id = 1, category_id = 1, vb = -1)) + expect_error(enable_volume_category(vol_id = 1, category_id = 1, vb = "a")) +}) + +# disable_volume_category() – validation -------------------------------------- + +test_that("disable_volume_category rejects invalid vol_id", { + expect_error(disable_volume_category(vol_id = -1, category_id = 1)) + expect_error(disable_volume_category(vol_id = 0, category_id = 1)) + expect_error(disable_volume_category(vol_id = "a", category_id = 1)) + expect_error(disable_volume_category(vol_id = TRUE, category_id = 1)) +}) + +test_that("disable_volume_category rejects invalid category_id", { + expect_error(disable_volume_category(vol_id = 1, category_id = -1)) + expect_error(disable_volume_category(vol_id = 1, category_id = 0)) + expect_error(disable_volume_category(vol_id = 1, category_id = "a")) + expect_error(disable_volume_category(vol_id = 1, category_id = TRUE)) + expect_error(disable_volume_category(vol_id = 1, category_id = c(1, 2))) +}) + +test_that("disable_volume_category rejects invalid vb", { + expect_error(disable_volume_category(vol_id = 1, category_id = 1, vb = -1)) + expect_error(disable_volume_category(vol_id = 1, category_id = 1, vb = "a")) +}) + +# Integration tests (require staging credentials) ---------------------------- + +login_test_account() + +test_that("get_volume_enabled_categories returns a list", { + result <- get_volume_enabled_categories(vol_id = 1, vb = FALSE) + skip_if_null_response(result, "get_volume_enabled_categories") + + expect_type(result, "list") +}) + +test_that("enable and disable category round-trip works", { + vol_id <- TEST_VOL_ID + + initial <- get_volume_enabled_categories(vol_id = vol_id, vb = FALSE) + skip_if_null_response(initial, "get_volume_enabled_categories for round-trip") + + initial_ids <- vapply(initial, function(c) as.integer(c$id), integer(1)) + test_cat <- TEST_CATEGORY_ID + + withr::defer( + set_volume_enabled_categories( + vol_id = vol_id, category_ids = initial_ids, vb = FALSE + ), + envir = parent.frame() + ) + + if (test_cat %in% initial_ids) { + disable_volume_category(vol_id = vol_id, category_id = test_cat, vb = FALSE) + } + + enable_result <- enable_volume_category( + vol_id = vol_id, category_id = test_cat, vb = FALSE + ) + skip_if_null_response(enable_result, "enable_volume_category") + + after_enable <- get_volume_enabled_categories(vol_id = vol_id, vb = FALSE) + enabled_ids <- vapply(after_enable, function(c) as.integer(c$id), integer(1)) + expect_true(test_cat %in% enabled_ids) + + disable_result <- disable_volume_category( + vol_id = vol_id, category_id = test_cat, vb = FALSE + ) + skip_if_null_response(disable_result, "disable_volume_category") + + after_disable <- get_volume_enabled_categories(vol_id = vol_id, vb = FALSE) + disabled_ids <- vapply(after_disable, function(c) as.integer(c$id), integer(1)) + expect_false(test_cat %in% disabled_ids) +}) 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..c1b74685 100644 --- a/vignettes/accessing-data.Rmd +++ b/vignettes/accessing-data.Rmd @@ -48,15 +48,15 @@ Use `tempdir()` to find the directory where `test.mp4` is stored. Now, let's see what other files are shared in volume 1, not just those in session (slot) 9807. This takes a moment to run because there are *many* files in this volume. -```{r} +**NOTE**: With Databrary 2.0, all Databrary API access requires authentication. Log in with `login_db()` first (see [authorized users](authorized-users.Rmd)). + +```{r, eval=FALSE} databraryr::list_volume_assets() ``` - -**NOTE**: These commands return public data, that is, data we do not need an account or log-in to see. We have not provided an `httr2` request parameter, so the function generates a default one. We can see this happening if we set `vb = TRUE`. -```{r} +```{r, eval=FALSE} databraryr::list_volume_assets(vb = TRUE) ``` @@ -71,14 +71,14 @@ Obviously, you would need to supply a `vol_id` for some other non-public dataset The `list_volume_assets()` command returns a data frame we can manipulate using standard R commands. Here are the variables in the data frame. -```{r} +```{r, eval=FALSE} vol1_assets <- databraryr::list_volume_assets() names(vol1_assets) ``` Or, if you use the R (> version 4.3) 'pipe' syntax: -```{r} +```{r, eval=FALSE} databraryr::list_volume_assets() |> names() ``` @@ -87,14 +87,14 @@ The `magrittr` package pipe ('%>%') also works (as of databraryr v0.6.2). The `asset_format_id` variable tells us information about the type of the data file. -```{r} +```{r, eval=FALSE} unique(vol1_assets$asset_format_id) ``` But this isn't especially informative since the `asset_format` is a code, and we don't really know what `-800` or `6` or the other numbers refer to. To decode it, we create a data frame of all the file formats Databrary currently recognizes. -```{r} +```{r, eval=FALSE} db_constants <- databraryr::assign_constants() formats_df <- purrr::map(db_constants$format, as.data.frame) |> @@ -111,13 +111,13 @@ As of 0.6.0, `list_volume_assets()` adds this information to the data frame. We can summarize the number of files using the `stats::xtabs()` function: -```{r} +```{r, eval=FALSE} stats::xtabs(~ format_name, data = vol1_assets) ``` So, there are lots of videos and PDFs to examine in volume 1. Here is a table of the ten longest videos. -```{r} +```{r, eval=FALSE} vol1_assets |> dplyr::filter(format_name == "MPEG-4 video") |> dplyr::select(asset_name, asset_duration) |> @@ -132,72 +132,68 @@ 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() +```{r, eval=FALSE} +databraryr::list_volume_collaborators() ``` The command (and many like it) can be "vectorized" using the `purrr` package. This let's us generate a tibble with the owners of the first fifteen volumes. -```{r} -purrr::map(1:15, databraryr::list_volume_owners) |> +```{r, eval=FALSE} +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} +```{r, eval=FALSE} 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) +```{r, eval=FALSE} +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} +```{r, eval=FALSE} db_constants <- databraryr::assign_constants() db_constants$permission ``` The `permission` array is indexed beginning with 0. -So the 1th (1st) value is "`r db_constants$permission[2]`". -So, the `1` means that the volumes shown above are all visible to the public, and to you. - -Volumes that you have not shared and are not visible to the public, will have `permission` equal to 5, or "`r db_constants$permission[6]`". -We can't demonstrate this to you because we don't have privileges on the same unshared volume, but you can try it on a volume you've created but not yet shared. +The first value typically means volumes visible to the public. +Volumes that you have not shared and are not visible to the public will have `access_level` equal to 5. +We can't demonstrate this in the vignette because we don't have privileges on the same unshared volume, but you can try it on a volume you've created but not yet shared. Other functions with the form `list_volume_*()` provide information about Databrary volumes. For example, the `list_volume_funding()` command returns information about any funders listed for the project. Again, the default volume is 1. -```{r} +```{r, eval=FALSE} databraryr::list_volume_funding() ``` The `list_volume_links()` command returns information about any external (web) links that have been added to a volume, such as to related publications or a GitHub repo. -```{r} +```{r, eval=FALSE} databraryr::list_volume_links() ``` -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 @@ -206,7 +202,7 @@ The following set of commands downloads all of the 'csv' files in volume 1 using The code below creates a new directory based on the session/slot ID (9807). The function returns the file path to the downloaded files. -```{r} +```{r, eval=FALSE} vol1_assets |> dplyr::filter(format_extension == "csv") |> databraryr::download_session_assets_fr_df() diff --git a/vignettes/databrary.Rmd b/vignettes/databrary.Rmd index 8fedbbc6..f84f7a97 100644 --- a/vignettes/databrary.Rmd +++ b/vignettes/databrary.Rmd @@ -46,47 +46,42 @@ Then, when you log in with your new credentials, you'll select an existing insti - The latest version of the code is v0.6.5. The v0.6.x code uses the `httr2` package under the hood, and it runs much faster than v0.5.x. -## First steps (while you await authorization) - -But even before formal authorization is complete, a user can access the public materials on Databrary. -For this vignette, we'll assume you fall into this category. +## First steps +All Databrary API access requires authentication. See the [authorized users](authorized-users.Rmd) vignette to learn how to log in. Once you've installed the package following one of the above routes, it's a good idea to check that your installation worked by loading it into your local workspace. ```{r eval=FALSE} library(databraryr) ``` -Then, try this command to pull data about one of Databrary's founders: +After logging in with `login_db()`, you can try this command to pull data about one of Databrary's founders: -```{r get_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, eval=FALSE} +# Retrieve 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} +```{r list-people-5-7, eval=FALSE} # 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() ``` @@ -96,7 +91,7 @@ You can also try seeing what's new on Databrary. The `get_db_stats()` command gives you information about the newly authorized people, institutions, and newly uploaded datasets. Try this: -```{r get-db-stats} +```{r get-db-stats, eval=FALSE} databraryr::get_db_stats("stats") databraryr::get_db_stats("people") databraryr::get_db_stats("institutions")