GET /study & GET /study/{study_id} endpoints

R/api_get_study.R

@@ -0,0 +1,100 @@
+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) |>
+    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"
+    ))
+  }
+
+  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_elements <-
+    list(
+      strata = strata,
+      arms = arms
+    )
+
+  study_list <- c(
+    study |>
+      dplyr::select(-parameters),
+    study$parameters |>
+      jsonlite::fromJSON() |>
+      purrr::flatten_dfr() |>
+      dplyr::select(p, method),
+    study_elements
+  )
+
+  return(study_list)
+}

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

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
@@ -44,3 +43,34 @@ sentryR::with_captured_calls(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 read
+#* @get /
+#* @serializer unboxedJSON
+#*
+
+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 /<study_id:int>
+#*
+#* @serializer unboxedJSON
+#*
+
+sentryR::with_captured_calls(function(study_id, req, res) {
+  return(
+    unbiased:::api_get_study_records(study_id, req, res)
+  )
+})

tests/testthat/test-E2E-get-study.R

@@ -0,0 +1,112 @@
+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")
+  )
+
+  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)
+})

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") |>