From b4d1ceb1c0fac79e50285275ef3b0961289689da Mon Sep 17 00:00:00 2001 From: Kinga Date: Mon, 12 Feb 2024 12:19:51 +0000 Subject: [PATCH 1/4] GET /study endpoint --- R/api_get_study.R | 12 ++++++++++++ inst/plumber/unbiased_api/study.R | 15 +++++++++++++++ 2 files changed, 27 insertions(+) create mode 100644 R/api_get_study.R diff --git a/R/api_get_study.R b/R/api_get_study.R new file mode 100644 index 0000000..14d767a --- /dev/null +++ b/R/api_get_study.R @@ -0,0 +1,12 @@ +api_get_study <- function(res, req){ + db_connection_pool <- get("db_connection_pool") + + + study_list <- + dplyr::tbl(db_connection_pool, "study") |> + dplyr::select(study_id = id, name, method, timestamp) |> + dplyr::collect() |> + tibble::as_tibble() + + return(study_list) +} diff --git a/inst/plumber/unbiased_api/study.R b/inst/plumber/unbiased_api/study.R index f613b4e..4e8bd59 100644 --- a/inst/plumber/unbiased_api/study.R +++ b/inst/plumber/unbiased_api/study.R @@ -42,3 +42,18 @@ function(study_id, current_state, req, res) { unbiased:::api__randomize_patient(study_id, current_state, req, res) ) } + +#' Get all available studies +#' +#' @return tibble with study_id, identifier, name and method +#' +#' @tag other +#' @get / +#' +#' @serializer unboxedJSON +#' +function(req, res){ + return( + unbiased:::api_get_study(req, res) + ) +} From d2ba21feb26a444671718afa443384c4cdd089e2 Mon Sep 17 00:00:00 2001 From: Kinga Date: Mon, 19 Feb 2024 10:27:12 +0000 Subject: [PATCH 2/4] Adding the GET/study and GET/study/{study_id} endpoints along with tests. Adding new tag: `read` for reading data from the database. --- R/api_get_study.R | 94 ++++++++++++++- inst/plumber/unbiased_api/plumber.R | 1 + inst/plumber/unbiased_api/study.R | 17 ++- tests/testthat/test-E2E-get-study.R | 114 ++++++++++++++++++ .../test-E2E-study-minimisation-pocock.R | 2 - 5 files changed, 223 insertions(+), 5 deletions(-) create mode 100644 tests/testthat/test-E2E-get-study.R diff --git a/R/api_get_study.R b/R/api_get_study.R index 14d767a..7d8c5fd 100644 --- a/R/api_get_study.R +++ b/R/api_get_study.R @@ -1,12 +1,102 @@ -api_get_study <- function(res, req){ +api_get_study <- function(res, req) { db_connection_pool <- get("db_connection_pool") study_list <- dplyr::tbl(db_connection_pool, "study") |> - dplyr::select(study_id = id, name, method, timestamp) |> + dplyr::select(study_id = id, identifier, name, method, last_edited = timestamp) |> dplyr::collect() |> tibble::as_tibble() return(study_list) } + +api_get_study_records <- function(study_id, req, res) { + db_connection_pool <- get("db_connection_pool") + + is_study <- + checkmate::test_subset( + x = req$args$study_id, + choices = dplyr::tbl(db_connection_pool, "study") |> + dplyr::select(id) |> + dplyr::pull() + ) + + if (!is_study) { + res$status <- 404 + return(list( + error = "Study not found", + details = r$error + )) + } + + study <- + dplyr::tbl(db_connection_pool, "study") |> + dplyr::filter(id == !!study_id) |> + dplyr::select( + study_id = id, name, randomization_method = method, + last_edited = timestamp, parameters + ) |> + dplyr::collect() |> + tibble::remove_rownames() + + strata <- + dplyr::tbl(db_connection_pool, "stratum") |> + dplyr::filter(study_id == !!study_id) |> + dplyr::select(stratum_id = id, stratum_name = name, value_type) |> + collect() |> + left_join( + bind_rows( + dplyr::tbl(db_connection_pool, "factor_constraint") |> + dplyr::collect(), + dplyr::tbl(db_connection_pool, "numeric_constraint") |> + dplyr::collect() + ), + by = "stratum_id" + ) |> + tidyr::unite("value_num", c("min_value", "max_value"), + sep = " - ", na.rm = TRUE + ) |> + dplyr::mutate(value = ifelse(is.na(value), value_num, value)) |> + dplyr::select(stratum_name, value_type, value) |> + left_join( + study$parameters |> + jsonlite::fromJSON() |> + purrr::flatten_dfr() |> + select(-c(p, method)) |> + tidyr::pivot_longer( + cols = everything(), + names_to = "stratum_name", + values_to = "weight" + ), + by = "stratum_name" + ) |> + group_by(stratum_name, value_type, weight) |> + summarise(levels = list(value)) + + arms <- + dplyr::tbl(db_connection_pool, "arm") |> + dplyr::filter(study_id == !!study_id) |> + dplyr::select(arm_name = name, ratio) |> + dplyr::collect() |> + tidyr::pivot_wider(names_from = arm_name, values_from = ratio) |> + as.list() + + study_list <- + list( + strata = strata, + arms = arms + ) + + study_list <- c( + study |> + dplyr::select(-parameters), + study$parameters |> + jsonlite::fromJSON() |> + purrr::flatten_dfr() |> + dplyr::select(p, method), + study_list + ) + + return(study_list) +} diff --git a/inst/plumber/unbiased_api/plumber.R b/inst/plumber/unbiased_api/plumber.R index 3f2b07d..3a34650 100644 --- a/inst/plumber/unbiased_api/plumber.R +++ b/inst/plumber/unbiased_api/plumber.R @@ -15,6 +15,7 @@ #* randomization method and parameters. #* @apiTag randomize Endpoints that randomize individual patients after the #* study was created. +#* @apiTag read Endpoints that read created records #* @apiTag other Other endpoints (helpers etc.). #* #* @plumber diff --git a/inst/plumber/unbiased_api/study.R b/inst/plumber/unbiased_api/study.R index 4e8bd59..efe0764 100644 --- a/inst/plumber/unbiased_api/study.R +++ b/inst/plumber/unbiased_api/study.R @@ -47,7 +47,7 @@ function(study_id, current_state, req, res) { #' #' @return tibble with study_id, identifier, name and method #' -#' @tag other +#' @tag read #' @get / #' #' @serializer unboxedJSON @@ -57,3 +57,18 @@ function(req, res){ unbiased:::api_get_study(req, res) ) } + +#' Get all records for chosen study +#' +#' @param study_id:int Study identifier +#' +#' @tag read +#' @get / +#' +#' @serializer unboxedJSON +#' +function(study_id, req, res){ + return( + unbiased:::api_get_study_records(study_id, req, res) + ) +} diff --git a/tests/testthat/test-E2E-get-study.R b/tests/testthat/test-E2E-get-study.R new file mode 100644 index 0000000..12f76f8 --- /dev/null +++ b/tests/testthat/test-E2E-get-study.R @@ -0,0 +1,114 @@ +test_that("correct request to reads studies with the structure of the returned result", { + source("./test-helpers.R") + + conn <- pool::localCheckout( + get("db_connection_pool", envir = globalenv()) + ) + with_db_fixtures("fixtures/example_study.yml") + + response <- request(api_url) |> + req_url_path("study", "") |> + req_method("GET") |> + req_perform() + + response_body <- + response |> + resp_body_json() + + testthat::expect_equal(response$status_code, 200) + + checkmate::expect_names( + names(response_body[[1]]), + identical.to = c("study_id", "identifier", "name", "method", "last_edited") + ) + + checkmate::expect_list( + response_body[[1]], + any.missing = TRUE, + null.ok = FALSE, + len = 5, + type = c("numeric", "character", "character", "character", "character") + ) + + # Compliance of the number of tests + + n_studies <- + dplyr::tbl(db_connection_pool, "study") |> + collect() |> + nrow() + + testthat::expect_equal(length(response_body), n_studies) +}) + +test_that("correct request to reads records for chosen study_id with the structure of the returned result", { + response <- request(api_url) |> + req_url_path("study", "minimisation_pocock") |> + req_method("POST") |> + req_body_json( + data = list( + identifier = "ABC-X", + name = "Study ABC-X", + method = "var", + p = 0.85, + arms = list( + "placebo" = 1, + "active" = 1 + ), + covariates = list( + sex = list( + weight = 1, + levels = c("female", "male") + ), + weight = list( + weight = 1, + levels = c("up to 60kg", "61-80 kg", "81 kg or more") + ) + ) + ) + ) |> + req_perform() + + response_body <- + response |> + resp_body_json() + + response_study <- + request(api_url) |> + req_url_path("study", response_body$study$id) |> + req_method("GET") |> + req_perform() + + response_study_body <- + response_study |> + resp_body_json() + + testthat::expect_equal(response$status_code, 200) + + checkmate::expect_names( + names(response_study_body), + identical.to = c("study_id", "name", "randomization_method", "last_edited", "p", "method", "strata", "arms") + ) + + checkmate::expect_list( + response_study_body, + any.missing = TRUE, + null.ok = TRUE, + len = 8, + type = c("numeric", "character", "character", "character", "numeric", "character", "list", "character") + ) + + # Request with non-existent study_id + # trycatch i 404 + response_study_id <- + tryCatch( + { + request(api_url) |> + req_url_path("study", response_body$study$id + 1) |> + req_method("GET") |> + req_perform() + }, + error = function(e) e + ) + + testthat::expect_equal(response_study_id$status, 404) +}) diff --git a/tests/testthat/test-E2E-study-minimisation-pocock.R b/tests/testthat/test-E2E-study-minimisation-pocock.R index 3ba3e19..aa4c6c6 100644 --- a/tests/testthat/test-E2E-study-minimisation-pocock.R +++ b/tests/testthat/test-E2E-study-minimisation-pocock.R @@ -1,5 +1,3 @@ -pool <- get("db_connection_pool", envir = globalenv()) - test_that("correct request with the structure of the returned result", { response <- request(api_url) |> req_url_path("study", "minimisation_pocock") |> From 7358b3c10b94470e35268ea7a43157b651c3b437 Mon Sep 17 00:00:00 2001 From: Kinga Date: Mon, 19 Feb 2024 11:44:27 +0000 Subject: [PATCH 3/4] Added sentry to endpoints --- inst/plumber/unbiased_api/study.R | 51 ++++++++++++++--------------- tests/testthat/test-E2E-get-study.R | 2 -- 2 files changed, 25 insertions(+), 28 deletions(-) diff --git a/inst/plumber/unbiased_api/study.R b/inst/plumber/unbiased_api/study.R index d4e5e6e..93fa34e 100644 --- a/inst/plumber/unbiased_api/study.R +++ b/inst/plumber/unbiased_api/study.R @@ -19,8 +19,7 @@ #* @serializer unboxedJSON #* sentryR::with_captured_calls(function( - identifier, name, method, arms, covariates, p, req, res -) { + identifier, name, method, arms, covariates, p, req, res) { return( unbiased:::api__minimization_pocock( identifier, name, method, arms, covariates, p, req, res @@ -43,35 +42,35 @@ sentryR::with_captured_calls(function(study_id, current_state, req, res) { return( unbiased:::api__randomize_patient(study_id, current_state, req, res) ) -} +}) + +#* Get all available studies +#* +#* @return tibble with study_id, identifier, name and method +#* +#* @tag read +#* @get / +#* @serializer unboxedJSON +#* -#' Get all available studies -#' -#' @return tibble with study_id, identifier, name and method -#' -#' @tag read -#' @get / -#' -#' @serializer unboxedJSON -#' -function(req, res){ +sentryR::with_captured_calls(function(req, res) { return( unbiased:::api_get_study(req, res) ) -} +}) + +#* Get all records for chosen study +#* +#* @param study_id:int Study identifier +#* +#* @tag read +#* @get / +#* +#* @serializer unboxedJSON +#* -#' Get all records for chosen study -#' -#' @param study_id:int Study identifier -#' -#' @tag read -#' @get / -#' -#' @serializer unboxedJSON -#' -function(study_id, req, res){ +sentryR::with_captured_calls(function(study_id, req, res) { return( unbiased:::api_get_study_records(study_id, req, res) ) -} - +}) diff --git a/tests/testthat/test-E2E-get-study.R b/tests/testthat/test-E2E-get-study.R index 12f76f8..038c111 100644 --- a/tests/testthat/test-E2E-get-study.R +++ b/tests/testthat/test-E2E-get-study.R @@ -97,8 +97,6 @@ test_that("correct request to reads records for chosen study_id with the structu type = c("numeric", "character", "character", "character", "numeric", "character", "list", "character") ) - # Request with non-existent study_id - # trycatch i 404 response_study_id <- tryCatch( { From d76250a7f2b1983274a2a791ee3917bae1ba465c Mon Sep 17 00:00:00 2001 From: Kinga Date: Mon, 19 Feb 2024 13:37:37 +0000 Subject: [PATCH 4/4] Changes resulting from code review + fix for catching errors --- R/api_get_study.R | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/R/api_get_study.R b/R/api_get_study.R index 7d8c5fd..16b4a4a 100644 --- a/R/api_get_study.R +++ b/R/api_get_study.R @@ -1,7 +1,6 @@ api_get_study <- function(res, req) { db_connection_pool <- get("db_connection_pool") - study_list <- dplyr::tbl(db_connection_pool, "study") |> dplyr::select(study_id = id, identifier, name, method, last_edited = timestamp) |> @@ -25,8 +24,7 @@ api_get_study_records <- function(study_id, req, res) { if (!is_study) { res$status <- 404 return(list( - error = "Study not found", - details = r$error + error = "Study not found" )) } @@ -82,7 +80,7 @@ api_get_study_records <- function(study_id, req, res) { tidyr::pivot_wider(names_from = arm_name, values_from = ratio) |> as.list() - study_list <- + study_elements <- list( strata = strata, arms = arms @@ -95,7 +93,7 @@ api_get_study_records <- function(study_id, req, res) { jsonlite::fromJSON() |> purrr::flatten_dfr() |> dplyr::select(p, method), - study_list + study_elements ) return(study_list)