From 3fb3c5faf12e348c1e4e30285cfc6a15ad0dddfb Mon Sep 17 00:00:00 2001 From: A Wokaty Date: Mon, 23 Feb 2026 16:05:29 -0500 Subject: [PATCH 1/3] Add test_request --- inst/service/bedbase/README.md | 14 ++++++++++++++ inst/service/bedbase/api.yaml | 35 ++++++++++++++++++++++++++++++++++ 2 files changed, 49 insertions(+) diff --git a/inst/service/bedbase/README.md b/inst/service/bedbase/README.md index 3c73fea..237b8c9 100644 --- a/inst/service/bedbase/README.md +++ b/inst/service/bedbase/README.md @@ -26,3 +26,17 @@ Convert openapi.json from OpenAPI 3.1 to 3.0: Convert from OpenAPI 3.0 to Swagger 2.0: api-spec-converter -f openapi_3 -t swagger_2 openapi_3_0.json > api.yaml + +Run `add_test_requests` to add a hidden parameter `test_request` for the +following endpoints: + +* /v1/bed/search/text +* /v1/bed/{bed_id}/metadata +* /v1/bedset/{bedset_id}/metadata +* /v1/bedset/list +* /v1/files/{file_path} + +If `test_request` is TRUE, the request will not be counted in BEDbase +statistics. + + bash add_test_request diff --git a/inst/service/bedbase/api.yaml b/inst/service/bedbase/api.yaml index 87cea4f..628e919 100644 --- a/inst/service/bedbase/api.yaml +++ b/inst/service/bedbase/api.yaml @@ -369,6 +369,13 @@ "name": "offset", "required": false, "type": "integer" + }, + { + "default": false, + "in": "query", + "name": "test_request", + "required": false, + "type": "boolean" } ], "responses": { @@ -532,6 +539,13 @@ "in": "query", "name": "full", "required": false + }, + { + "default": false, + "in": "query", + "name": "test_request", + "required": false, + "type": "boolean" } ], "responses": { @@ -1031,6 +1045,13 @@ "name": "offset", "required": false, "type": "integer" + }, + { + "default": false, + "in": "query", + "name": "test_request", + "required": false, + "type": "boolean" } ], "responses": { @@ -1109,6 +1130,13 @@ "name": "full", "required": false, "type": "boolean" + }, + { + "default": false, + "in": "query", + "name": "test_request", + "required": false, + "type": "boolean" } ], "responses": { @@ -1390,6 +1418,13 @@ "name": "file_path", "required": true, "type": "string" + }, + { + "default": false, + "in": "query", + "name": "test_request", + "required": false, + "type": "boolean" } ], "responses": { From 74528cf0abd3785642c3807d05f5c3739118bebf Mon Sep 17 00:00:00 2001 From: A Wokaty Date: Tue, 24 Feb 2026 15:37:17 -0500 Subject: [PATCH 2/3] Update functions, tests to use test_request --- DESCRIPTION | 3 +- R/bedbaser.R | 22 ++++---- R/utils.R | 69 +++++++++++--------------- inst/service/bedbase/add_test_requests | 18 +++++++ man/bedbaser-package.Rd | 2 +- tests/testthat/setup.R | 4 ++ tests/testthat/test-cache.R | 8 ++- tests/testthat/test-utils.R | 14 ++---- vignettes/bedbaser.Rmd | 13 +++++ 9 files changed, 90 insertions(+), 63 deletions(-) create mode 100644 inst/service/bedbase/add_test_requests create mode 100644 tests/testthat/setup.R diff --git a/DESCRIPTION b/DESCRIPTION index 1f0a326..07321c6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -48,7 +48,8 @@ Suggests: BiocStyle, knitr, liftOver, - testthat (>= 3.0.0) + testthat (>= 3.0.0), + withr Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.3 diff --git a/R/bedbaser.R b/R/bedbaser.R index f29dfca..372cc20 100644 --- a/R/bedbaser.R +++ b/R/bedbaser.R @@ -308,12 +308,14 @@ bb_example <- function(bedbase, rec_type = c("bed", "bedset")) { bb_metadata <- function(bedbase, id, full = FALSE) { rsp <- bedbase$get_bed_metadata_v1_bed__bed_id__metadata_get( bed_id = id, - full = full + full = full, + test_request = .is_test_request() ) if (rsp$status_code != 200) { rsp <- bedbase$get_bedset_metadata_v1_bedset__bedset_id__metadata_get( bedset_id = id, - full = full + full = full, + test_request = .is_test_request() ) } result <- httr::content(rsp) @@ -391,7 +393,8 @@ bb_list_bedsets <- function(bedbase, query = "", limit = 1000, offset = 0) { rsp <- bedbase$list_bedsets_v1_bedset_list_get( query = query, limit = limit, - offset = offset + offset = offset, + test_request = .is_test_request() ) recs <- httr::content(rsp) results <- tibble::tibble() @@ -480,7 +483,8 @@ bb_bed_text_search <- function(bedbase, query, genome = NULL, assay = NULL, genome = genome, assay = assay, limit = limit, - offset = offset + offset = offset, + test_request = .is_test_request() ) recs <- httr::content(rsp) results <- tibble::tibble() @@ -516,11 +520,7 @@ bb_bed_text_search <- function(bedbase, query, genome = NULL, assay = NULL, #' #' @export bb_to_granges <- function(bedbase, bed_id, extra_cols = NULL, quietly = TRUE) { - metadata <- bb_metadata(bedbase, bed_id, TRUE) - file_path <- .get_file( - metadata, getCache(bedbase, "bedfiles"), "http", - quietly - ) + file_path <- .get_file(bedbase, bed_id, getCache(bedbase, "bedfiles"), quietly) tryCatch( R.utils::gunzip(file_path, remove = FALSE), @@ -529,6 +529,7 @@ bb_to_granges <- function(bedbase, bed_id, extra_cols = NULL, quietly = TRUE) { } ) + metadata <- bb_metadata(bedbase, bed_id, TRUE) .bed_file_to_granges(file_path, metadata, extra_cols, quietly) } @@ -597,7 +598,6 @@ bb_save <- function(bedbase, bed_or_bedset_id, path, quietly = TRUE) { ) } for (id in ids) { - metadata <- bb_metadata(bedbase, id, TRUE) - .get_file(metadata, path, "http", quietly) + .get_file(bedbase, id, path, quietly) } } diff --git a/R/utils.R b/R/utils.R index 392a967..2ef6c43 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,3 +1,15 @@ +#' Return TRUE if a test_request to prevent impact to BEDbase statistics +#' +#' @param default logical(1) (default \code{FALSE}) internal parameter for +#' testing purposes +#' +#' @return logical(1) +#' +#' @noRd +.is_test_request <- function(default = FALSE) { + getOption("bedbaser.test_request", default = default) +} + #' Get file name from URL for a file #' #' @param a_url character(1) URL @@ -13,42 +25,16 @@ url_parts[length(url_parts)] } -#' Get BEDbase url for BED file -#' -#' @param records list() metadata -#' @param access_type character(1) s3 or http -#' -#' @return character(1) url to BED file -#' -#' @examples -#' bedbase <- BEDbase() -#' ex_bed <- bb_example(bedbase, "bed") -#' ex_metadata <- bb_metadata(bedbase, ex_bed$id, TRUE) -#' .get_url(ex_bed$files, "http") -#' -#' @noRd -.get_url <- function(metadata, access_type = c("s3", "http")) { - access_type <- match.arg(access_type) - file_details <- dplyr::bind_rows(metadata$files) |> - tidyr::unnest_wider(access_methods) |> - tidyr::unnest_wider(access_url) |> - dplyr::filter( - name == "bed_file", - access_id == access_type - ) - file_details$url -} - #' Get a BED file #' #' @description Download or retrieve the file the cache. If not available, get #' the file from bedbase.org and save to the cache or a path. If a directory #' does not exist along specified path, it will raise an error message. #' -#' @param metadata list() full metadata +#' @param bedbase BEDbase() object +#' @param bed_id integer(1) BED record identifier #' @param cache_or_path [BiocFileCache][BiocFileCache::BiocFileCache-class] or #' character(1) cache or save path -#' @param access_type character(1) s3 or http #' @param quietly logical(1) (default \code{TRUE}) display messages #' #' @return character(1) file path @@ -56,14 +42,19 @@ #' @examples #' bedbase <- BEDbase() #' ex_bed <- bb_example(bedbase, "bed") -#' md <- bb_metadata(bedbase, ex_bed$id, TRUE) -#' .get_file(md, tempdir(), "http") +#' .get_file(bedbase, ex_bed$id, tempdir()) #' #' @noRd -.get_file <- function(metadata, cache_or_path, access_type, quietly = TRUE) { - file_url <- .get_url(metadata, access_type) +.get_file <- function(bedbase, id, cache_or_path, quietly = TRUE) { + resp = httr::content( + bedbase$get_bed_files_v1_bed__bed_id__metadata_files_get(id) + ) + file_url <- bedbase$redirect_to_download_v1_files__file_path__get( + file_path = resp$bed_file$path, + test_request = .is_test_request() + )$url if (methods::is(cache_or_path, "BiocFileCache")) { - bed_file <- .cache_bedfile(metadata$id, file_url, cache_or_path) + bed_file <- .cache_bedfile(id, file_url, cache_or_path) } else { bed_file <- file.path(cache_or_path, .get_file_name(file_url)) curl::curl_download(file_url, bed_file, quiet = quietly) @@ -88,8 +79,7 @@ #' @examples #' bedbase <- BEDbase() #' ex_bedset <- bb_example(bedbase, "bedset") -#' md <- bb_metadata(bedbase, ex_bedset$bed_ids[[1]], TRUE) -#' file_path <- .get_file(md, getCache(bedbase), "http") +#' file_path <- .get_file(bedbase, ex_bedset$bed_ids[[1]], getCache(bedbase)) #' .get_extra_cols(file_path, 3, 9) #' #' @noRd @@ -123,8 +113,8 @@ #' @examples #' bedbase <- BEDbase() #' ex_bed <- bb_example(bedbase, "bed") -#' md <- bb_metadata(bedbase, ex_bed$id, TRUE) -#' file_path <- .get_file(md, getCache(bedbase), "http") +#' metadata <- bb_metadata(bedbase, ex_bed$id, TRUE) +#' file_path <- .get_file(bedbase, ex_bed$id, getCache(bedbase)) #' args <- list( #' con = file_path, #' format = gsub("peak", "Peak", metadata$data_format), @@ -158,8 +148,8 @@ #' @examples #' bedbase <- BEDbase() #' ex_bed <- bb_example(bedbase, "bed") +#' file_path <- .get_file(bedbase, ex_bed$id, getCache(bedbase)) #' md <- bb_metadata(bedbase, ex_bed$id, TRUE) -#' file_path <- .get_file(md, getCache(bedbase), "http") #' format <- .get_format(file_path, md$data_format) #' #' @noRd @@ -192,8 +182,7 @@ #' @examples #' bedbase <- BEDbase() #' ex_bed <- bb_example(bedbase, "bed") -#' md <- bb_metadata(bedbase, ex_bed$id, TRUE) -#' file_path <- .get_file(md, getCache(bedbase), "http") +#' file_path <- .get_file(bedbase, ex_bed$id, getCache(bedbase)) #' .bed_file_to_granges(file_path, md) #' #' @noRd diff --git a/inst/service/bedbase/add_test_requests b/inst/service/bedbase/add_test_requests new file mode 100644 index 0000000..4083998 --- /dev/null +++ b/inst/service/bedbase/add_test_requests @@ -0,0 +1,18 @@ +# requires jq +# run with +# bash add_test_requests + +jq --indent 2 ' + { + "default": false, + "in": "query", + "name": "test_request", + "required": false, + "type": "boolean" + } as $test_request | + .paths["/v1/bed/{bed_id}/metadata"].get.parameters += [$test_request] | + .paths["/v1/bed/search/text"].get.parameters += [$test_request] | + .paths["/v1/bedset/{bedset_id}/metadata"].get.parameters += [$test_request] | + .paths["/v1/bedset/list"].get.parameters += [$test_request] | + .paths["/v1/files/{file_path}"].get.parameters += [$test_request] +' api.yaml > tmp.yaml && mv tmp.yaml api.yaml diff --git a/man/bedbaser-package.Rd b/man/bedbaser-package.Rd index 9f24ad3..1bbe4fa 100644 --- a/man/bedbaser-package.Rd +++ b/man/bedbaser-package.Rd @@ -17,7 +17,7 @@ Useful links: } \author{ -\strong{Maintainer}: Andres Wokaty \email{jennifer.wokaty@sph.cuny.edu} (\href{https://orcid.org/0009-0008-0900-8793}{ORCID}) +\strong{Maintainer}: Andres Wokaty \email{andres.wokaty@sph.cuny.edu} (\href{https://orcid.org/0009-0008-0900-8793}{ORCID}) Authors: \itemize{ diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R new file mode 100644 index 0000000..9a97211 --- /dev/null +++ b/tests/testthat/setup.R @@ -0,0 +1,4 @@ +withr::local_options( + bedbaser.test_request = TRUE, + .local_envir = teardown_env() +) diff --git a/tests/testthat/test-cache.R b/tests/testthat/test-cache.R index 6f5f1e6..802aff7 100644 --- a/tests/testthat/test-cache.R +++ b/tests/testthat/test-cache.R @@ -42,7 +42,13 @@ test_that("bed files are cached", { cache <- getCache(bedbase, "bedfiles") rid <- BiocFileCache::bfcquery(cache, id, "rname")$rid expect_length(rid, 0) - bedbase_url <- .get_url(bb_metadata(bedbase, id, TRUE), "http") + resp <- httr::content( + bedbase$get_bed_files_v1_bed__bed_id__metadata_files_get(id) + ) + bedbase_url <- bedbase$redirect_to_download_v1_files__file_path__get( + file_path = resp$bed_file$path, + test_request = .is_test_request() + )$url rpath <- .cache_bedfile(id, bedbase_url, cache) expect_true(file.exists(rpath)) rid <- BiocFileCache::bfcquery(cache, id, "rname")$rid diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index f6cc8f4..1c2e117 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -10,21 +10,17 @@ test_that(".get_file_name returns file name", { ) }) -test_that(".get_url returns a url", { - file_url <- .get_url(ex_bed_md, "http") - expect_true(stringr::str_detect(file_url, "(https?|ftp|s3)://")) -}) - test_that(".get_file returns a valid file path", { - file_path <- .get_file(ex_bed_md, tempdir(), "http") + file_path <- .get_file(bedbase, ex_bed$id, tempdir()) expect_true(file.exists(file_path)) - file_path <- .get_file(ex_bed_md, getCache(bedbase, "bedfiles"), "http") + file_path <- .get_file(bedbase, ex_bed$id, getCache(bedbase, "bedfiles")) expect_true(file.exists(file_path)) }) test_that(".get_extra_cols returns a named vector", { - ex_bed_md2 <- bb_metadata(bedbase, ex_bedset$bed_ids[[1]], TRUE) - file_path <- .get_file(ex_bed_md2, getCache(bedbase, "bedfiles"), "http") + ids <- ex_bedset$bed_ids[[1]] + file_path <- .get_file(bedbase, ids, getCache(bedbase, "bedfiles")) + ex_bed_md2 <- bb_metadata(bedbase, ids, TRUE) x_y <- strsplit(gsub("bed", "", ex_bed_md2$bed_compliance), "+", fixed= TRUE)[[1]] diff --git a/vignettes/bedbaser.Rmd b/vignettes/bedbaser.Rmd index 03514c8..f5755e4 100644 --- a/vignettes/bedbaser.Rmd +++ b/vignettes/bedbaser.Rmd @@ -36,6 +36,13 @@ if (!"BiocManager" %in% rownames(installed.packages())) { BiocManager::install("bedbaser") ``` +```{r set-bedbaser-test_request, echo=FALSE, include=FALSE} +# We set .is_test_request to TRUE if !interactive() so we don't inflate +# statistics for BEDbase + +options(bedbaser.test_request = !interactive()) +``` + Load the package and create a BEDbase instance, optionally setting the cache to `cache_path`. If `cache_path` is not set, `r Biocpkg("bedbaser")` will choose the default location. @@ -233,6 +240,12 @@ genome(gro39) <- "mm39" gro39 ``` +```{r unset-bedbaser-test_request, echo=FALSE, include=FALSE} +# We unset bedbaser.test_request to FALSE + +options(bedbaser.test_request = FALSE) +``` + # SessionInfo() ```{r sessionInfo} From 9a1c910db4eb5d98a40ccabeb69d048edf5a8d07 Mon Sep 17 00:00:00 2001 From: A Wokaty Date: Wed, 25 Feb 2026 11:08:27 -0500 Subject: [PATCH 3/3] Fix .get_extra_cols test --- tests/testthat/test-utils.R | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 1c2e117..98ba64d 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1,7 +1,6 @@ bedbase <- BEDbase(tempdir(), quietly = TRUE) ex_bed <- bb_example(bedbase, "bed") ex_bedset <- bb_example(bedbase, "bedset") -ex_bed_md <- bb_metadata(bedbase, ex_bed$id, TRUE) test_that(".get_file_name returns file name", { expect_equal( @@ -18,12 +17,12 @@ test_that(".get_file returns a valid file path", { }) test_that(".get_extra_cols returns a named vector", { - ids <- ex_bedset$bed_ids[[1]] - file_path <- .get_file(bedbase, ids, getCache(bedbase, "bedfiles")) - ex_bed_md2 <- bb_metadata(bedbase, ids, TRUE) - x_y <- strsplit(gsub("bed", "", ex_bed_md2$bed_compliance), + id <- ex_bedset$bed_ids[[1]] + file_path <- .get_file(bedbase, id, getCache(bedbase, "bedfiles")) + ex_bed_md <- bb_metadata(bedbase, id, TRUE) + x_y <- strsplit(gsub("bed", "", ex_bed_md$bed_compliance), "+", - fixed= TRUE)[[1]] + fixed = TRUE)[[1]] extra_cols <- .get_extra_cols(file_path, as.numeric(x_y[1]), as.numeric(x_y[2]))