From e249a142095766393e73c0c74b0ec8d1c491faec Mon Sep 17 00:00:00 2001 From: Rob Ashton Date: Thu, 4 Apr 2024 09:54:21 +0100 Subject: [PATCH 01/11] Add new endpoint for returning the path to download result --- R/api.R | 10 ++++++++++ R/endpoints.R | 15 +++++++++++++++ inst/schema/DownloadResultResponse.schema.json | 17 +++++++++++++++++ 3 files changed, 42 insertions(+) create mode 100644 inst/schema/DownloadResultResponse.schema.json diff --git a/R/api.R b/R/api.R index 910c6e6e..51f74b13 100644 --- a/R/api.R +++ b/R/api.R @@ -24,6 +24,7 @@ api_build <- function(queue, validate = FALSE, logger = NULL) { api$handle(endpoint_download_submit(queue)) api$handle(endpoint_download_status(queue)) api$handle(endpoint_download_result(queue)) + api$handle(endpoint_download_result_path(queue)) api$handle(endpoint_download_result_head(queue)) api$handle(endpoint_adr_metadata(queue)) api$handle(endpoint_rehydrate_submit(queue)) @@ -413,6 +414,15 @@ endpoint_download_result_head <- function(queue) { validate = FALSE) } +endpoint_download_result_path <- function(queue) { + response <- porcelain::porcelain_returning_json( + "DownloadResultResponse.schema", schema_root()) + porcelain::porcelain_endpoint$new("GET", + "/download/result/path/", + download_result_path(queue), + returning = response) +} + endpoint_adr_metadata <- function(queue) { response <- porcelain::porcelain_returning_json( "AdrMetadataResponse.schema", schema_root()) diff --git a/R/endpoints.R b/R/endpoints.R index 3c6d644f..994aeb6f 100644 --- a/R/endpoints.R +++ b/R/endpoints.R @@ -833,6 +833,21 @@ download_result <- function(queue) { } } +download_result_path <- function(queue) { + function(id) { + tryCatch( + res <- get_download_result(queue, id, "FAILED_DOWNLOAD"), + error = function(e) { + if (is_porcelain_error(e)) { + stop(e) + } else { + hintr_error(api_error_msg(e), "FAILED_TO_RETRIEVE_RESULT") + } + } + ) + } +} + build_content_disp_header <- function(areas, filename, ext) { sprintf('attachment; filename="%s"', paste0(paste(c(areas, filename, iso_time_str()), collapse = "_"), diff --git a/inst/schema/DownloadResultResponse.schema.json b/inst/schema/DownloadResultResponse.schema.json new file mode 100644 index 00000000..5b7ccc1a --- /dev/null +++ b/inst/schema/DownloadResultResponse.schema.json @@ -0,0 +1,17 @@ +{ + "$schema": "http://json-schema.org/draft-04/schema#", + "type": "object", + "properties": { + "path": { "type": "string" }, + "metadata": { + "type": "object", + "properties": { + "description": { "type": "string" }, + "areas": { "type": "string" }, + "type": { "type": "string" } + } + }, + "required": [ "description", "areas", "type" ] + }, + "required": [ "path", "metadata" ] +} From a603cd9136f1abdbfb2bb4eeea202a75ff138715 Mon Sep 17 00:00:00 2001 From: Rob Ashton Date: Thu, 4 Apr 2024 15:01:30 +0100 Subject: [PATCH 02/11] Fix schema --- inst/schema/DownloadResultResponse.schema.json | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/inst/schema/DownloadResultResponse.schema.json b/inst/schema/DownloadResultResponse.schema.json index 5b7ccc1a..5bc6bd30 100644 --- a/inst/schema/DownloadResultResponse.schema.json +++ b/inst/schema/DownloadResultResponse.schema.json @@ -9,9 +9,9 @@ "description": { "type": "string" }, "areas": { "type": "string" }, "type": { "type": "string" } - } + }, + "required": [ "description", "areas", "type" ] }, - "required": [ "description", "areas", "type" ] }, "required": [ "path", "metadata" ] } From 69d5250bd62d27b8ab9e2bb2391404d0a091f7fb Mon Sep 17 00:00:00 2001 From: Rob Ashton Date: Thu, 4 Apr 2024 15:26:57 +0100 Subject: [PATCH 03/11] Return scalar from metadata path endpoints --- R/endpoints.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/endpoints.R b/R/endpoints.R index 994aeb6f..842e40c9 100644 --- a/R/endpoints.R +++ b/R/endpoints.R @@ -836,7 +836,7 @@ download_result <- function(queue) { download_result_path <- function(queue) { function(id) { tryCatch( - res <- get_download_result(queue, id, "FAILED_DOWNLOAD"), + recursive_scalar(get_download_result(queue, id, "FAILED_DOWNLOAD")), error = function(e) { if (is_porcelain_error(e)) { stop(e) From 5d0867c61315051638d546c79f4e71eba57c9047 Mon Sep 17 00:00:00 2001 From: Rob Ashton Date: Thu, 4 Apr 2024 15:49:24 +0100 Subject: [PATCH 04/11] Return output relative to results directory --- R/endpoints.R | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/R/endpoints.R b/R/endpoints.R index 842e40c9..c53f11b3 100644 --- a/R/endpoints.R +++ b/R/endpoints.R @@ -835,16 +835,20 @@ download_result <- function(queue) { download_result_path <- function(queue) { function(id) { - tryCatch( - recursive_scalar(get_download_result(queue, id, "FAILED_DOWNLOAD")), - error = function(e) { - if (is_porcelain_error(e)) { - stop(e) - } else { - hintr_error(api_error_msg(e), "FAILED_TO_RETRIEVE_RESULT") - } + tryCatch({ + res <- get_download_result(queue, id, "FAILED_DOWNLOAD") + relative_path <- sub(paste0(queue$results_dir, .Platform$file.sep), "", + res$path, perl = TRUE) + res$path <- relative_path + recursive_scalar(res) + }, + error = function(e) { + if (is_porcelain_error(e)) { + stop(e) + } else { + hintr_error(api_error_msg(e), "FAILED_TO_RETRIEVE_RESULT") } - ) + }) } } From c8b1781a597d1a18c44ebf958b85c819ef3e529c Mon Sep 17 00:00:00 2001 From: Rob Ashton Date: Fri, 5 Apr 2024 15:44:09 +0100 Subject: [PATCH 05/11] Add tests for new download path endpoint --- R/endpoints.R | 37 ++++++++++++------- .../schema/DownloadResultResponse.schema.json | 7 +++- tests/testthat/integration-server.R | 17 ++++++++- tests/testthat/test-01-endpoints-download.R | 22 +++++++++++ 4 files changed, 66 insertions(+), 17 deletions(-) diff --git a/R/endpoints.R b/R/endpoints.R index c53f11b3..b8a604d6 100644 --- a/R/endpoints.R +++ b/R/endpoints.R @@ -800,26 +800,34 @@ get_download_result <- function(queue, id, error_message) { res } +download_file_label <- function(type) { + switch(type, + spectrum = "naomi-output", + coarse_output = "coarse-output", + summary = "summary-report", + comparison = "comparison-report", + agyw = "AGYW") +} + +download_file_extension <- function(type) { + switch(type, + spectrum = ".zip", + coarse_output = ".zip", + summary = ".html", + comparison = ".html", + agyw = ".xlsx") +} + download_result <- function(queue) { function(id) { tryCatch({ res <- get_download_result(queue, id, "FAILED_DOWNLOAD") - filename <- switch(res$metadata$type, - spectrum = "naomi-output", - coarse_output = "coarse-output", - summary = "summary-report", - comparison = "comparison-report", - agyw = "AGYW") - ext <- switch(res$metadata$type, - spectrum = ".zip", - coarse_output = ".zip", - summary = ".html", - comparison = ".html", - agyw = ".xlsx") + file_label <- download_file_label(res$metadata$type) + ext <- download_file_extension(res$metadata$type) bytes <- readBin(res$path, "raw", n = file.size(res$path)) bytes <- porcelain::porcelain_add_headers(bytes, list( "Content-Disposition" = build_content_disp_header(res$metadata$areas, - filename, ext), + file_label, ext), "Content-Length" = length(bytes))) bytes }, @@ -840,6 +848,9 @@ download_result_path <- function(queue) { relative_path <- sub(paste0(queue$results_dir, .Platform$file.sep), "", res$path, perl = TRUE) res$path <- relative_path + res$metadata$id <- id + res$metadata$file_label <- download_file_label(res$metadata$type) + res$metadata$file_extension <- download_file_extension(res$metadata$type) recursive_scalar(res) }, error = function(e) { diff --git a/inst/schema/DownloadResultResponse.schema.json b/inst/schema/DownloadResultResponse.schema.json index 5bc6bd30..427ccbaa 100644 --- a/inst/schema/DownloadResultResponse.schema.json +++ b/inst/schema/DownloadResultResponse.schema.json @@ -6,11 +6,14 @@ "metadata": { "type": "object", "properties": { + "id": { "type": "string" }, "description": { "type": "string" }, "areas": { "type": "string" }, - "type": { "type": "string" } + "type": { "type": "string" }, + "file_extension": { "type": "string" }, + "file_label": { "type": "string" } }, - "required": [ "description", "areas", "type" ] + "required": [ "description", "areas", "type", "file_extension", "file_label" ] }, }, "required": [ "path", "metadata" ] diff --git a/tests/testthat/integration-server.R b/tests/testthat/integration-server.R index 9b7ce478..08608d8f 100644 --- a/tests/testthat/integration-server.R +++ b/tests/testthat/integration-server.R @@ -1,6 +1,10 @@ +results_dir <- tempfile("results") +dir.create(results_dir) + withr::with_dir(testthat::test_path(), { server <- porcelain::porcelain_background$new( - api, args = list(queue_id = paste0("hintr:", ids::random_id()))) + api, args = list(queue_id = paste0("hintr:", ids::random_id()), + results_dir = results_dir)) server$start() }) @@ -608,11 +612,20 @@ test_that("download streams bytes", { ## Can get ADR metadata adr_res <- server$request("GET", paste0("/meta/adr/", response$data$id)) - expect_equal(httr::status_code(r), 200) + expect_equal(httr::status_code(adr_res), 200) adr_r <- response_from_json(adr_res) expect_equal(names(adr_r$data), c("type", "description")) expect_equal(adr_r$data$type, "spectrum") expect_type(adr_r$data$description, "character") + + ## Can get path to output file + path_res <- server$request("GET", + paste0("/download/result/path/", response$data$id)) + expect_equal(httr::status_code(path_res), 200) + path_r <- response_from_json(path_res) + expect_true(file.exists(file.path(results_dir, path_r$data$path))) + expect_equal(path_r$data$file_label, "naomi-output") + expect_equal(path_r$data$file_extension, ".zip") }) test_that("can quit", { diff --git a/tests/testthat/test-01-endpoints-download.R b/tests/testthat/test-01-endpoints-download.R index 49f64f08..8576d422 100644 --- a/tests/testthat/test-01-endpoints-download.R +++ b/tests/testthat/test-01-endpoints-download.R @@ -40,6 +40,20 @@ test_that("spectrum download returns bytes", { 'attachment; filename="MWI_naomi-output_\\d+-\\d+.zip"') expect_equal(head_response$headers$`Content-Length`, size) expect_null(head_response$body, NULL) + + ## Get download result path + path_data <- endpoint_download_result_path(q$queue) + path_response <- path_data$run(status_response$data$id) + expect_equal(path_response$status_code, 200) + path <- path_response$data + expect_true(file.exists(file.path(q$queue$results_dir, path$path))) + expect_equal(path$metadata$type, scalar("spectrum")) + expect_equal(path$metadata$areas, scalar("MWI")) + expect_match(path$metadata$description, + "Naomi output uploaded from Naomi web app") + expect_equal(path$metadata$id, scalar(status_response$data_id)) + expect_equal(path$metadata$file_label, scalar("naomi-output")) + expect_equal(path$metadata$file_extension, scalar(".zip")) }) test_that("api can call spectrum download", { @@ -327,6 +341,14 @@ test_that("trying to download result for errored model run returns error", { expect_equal(names(error$data[[1]]), c("error", "detail", "key")) expect_equal(error$data[[1]]$error, scalar("OUTPUT_GENERATION_FAILED")) expect_equal(error$data[[1]]$detail, scalar("test error")) + + ## Getting path to output file returns error + result_path <- download_result_path(queue) + path_error <- expect_error(result_path(response$id)) + expect_equal(path_error$status_code, 400) + expect_equal(names(path_error$data[[1]]), c("error", "detail", "key")) + expect_equal(path_error$data[[1]]$error, scalar("OUTPUT_GENERATION_FAILED")) + expect_equal(path_error$data[[1]]$detail, scalar("test error")) }) test_that("download result returns formatted error if unexpected issue", { From 99358070df9ebd0891fc9175855700328a6ec144 Mon Sep 17 00:00:00 2001 From: Rob Ashton Date: Fri, 5 Apr 2024 15:52:03 +0100 Subject: [PATCH 06/11] Bump version number and add NEWS item --- DESCRIPTION | 2 +- NEWS.md | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index da92b28b..420e6c1c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: hintr Title: R API for calling naomi district level HIV model -Version: 1.2.0 +Version: 1.2.1 Authors@R: person(given = "Robert", family = "Ashton", diff --git a/NEWS.md b/NEWS.md index f809955a..f7dd868d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +# hintr 1.2.1 + +* Add new endpoint `/download/result/path/` to return path to the download file on disk + + # hintr 1.2.0 * Update plot metadata format to make it more generic and generally usable From 57b23f8b7824aa240642406f0aaa96321ca97ee9 Mon Sep 17 00:00:00 2001 From: Rob Ashton Date: Fri, 5 Apr 2024 16:39:01 +0100 Subject: [PATCH 07/11] Use fs helper --- R/endpoints.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/endpoints.R b/R/endpoints.R index b8a604d6..190d359d 100644 --- a/R/endpoints.R +++ b/R/endpoints.R @@ -664,7 +664,8 @@ calibrate_result_path <- function(queue) { function(id) { verify_result_available(queue, id) result <- queue$result(id) - relative_path <- fs::path_rel(result$plot_data_path, start = queue$results_dir) + relative_path <- fs::path_rel(result$plot_data_path, + start = queue$results_dir) list( path = scalar(relative_path) ) @@ -845,8 +846,7 @@ download_result_path <- function(queue) { function(id) { tryCatch({ res <- get_download_result(queue, id, "FAILED_DOWNLOAD") - relative_path <- sub(paste0(queue$results_dir, .Platform$file.sep), "", - res$path, perl = TRUE) + relative_path <- fs::path_rel(res$path, start = queue$results_dir) res$path <- relative_path res$metadata$id <- id res$metadata$file_label <- download_file_label(res$metadata$type) From c86ceafb9c6ec7e86486c8e663b2dcf953e88ff6 Mon Sep 17 00:00:00 2001 From: Rob Ashton Date: Fri, 5 Apr 2024 16:40:55 +0100 Subject: [PATCH 08/11] Fix typo in schema --- inst/schema/DownloadResultResponse.schema.json | 4 ++-- tests/testthat/integration-server.R | 4 ++-- tests/testthat/test-01-endpoints-download.R | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/inst/schema/DownloadResultResponse.schema.json b/inst/schema/DownloadResultResponse.schema.json index 427ccbaa..ec51e92d 100644 --- a/inst/schema/DownloadResultResponse.schema.json +++ b/inst/schema/DownloadResultResponse.schema.json @@ -13,8 +13,8 @@ "file_extension": { "type": "string" }, "file_label": { "type": "string" } }, - "required": [ "description", "areas", "type", "file_extension", "file_label" ] - }, + "required": [ "id", "description", "areas", "type", "file_extension", "file_label" ] + } }, "required": [ "path", "metadata" ] } diff --git a/tests/testthat/integration-server.R b/tests/testthat/integration-server.R index 08608d8f..ddfa1ac6 100644 --- a/tests/testthat/integration-server.R +++ b/tests/testthat/integration-server.R @@ -624,8 +624,8 @@ test_that("download streams bytes", { expect_equal(httr::status_code(path_res), 200) path_r <- response_from_json(path_res) expect_true(file.exists(file.path(results_dir, path_r$data$path))) - expect_equal(path_r$data$file_label, "naomi-output") - expect_equal(path_r$data$file_extension, ".zip") + expect_equal(path_r$data$metadata$file_label, "naomi-output") + expect_equal(path_r$data$metadata$file_extension, ".zip") }) test_that("can quit", { diff --git a/tests/testthat/test-01-endpoints-download.R b/tests/testthat/test-01-endpoints-download.R index 8576d422..9e3c5904 100644 --- a/tests/testthat/test-01-endpoints-download.R +++ b/tests/testthat/test-01-endpoints-download.R @@ -51,7 +51,7 @@ test_that("spectrum download returns bytes", { expect_equal(path$metadata$areas, scalar("MWI")) expect_match(path$metadata$description, "Naomi output uploaded from Naomi web app") - expect_equal(path$metadata$id, scalar(status_response$data_id)) + expect_equal(path$metadata$id, scalar(status_response$data$id)) expect_equal(path$metadata$file_label, scalar("naomi-output")) expect_equal(path$metadata$file_extension, scalar(".zip")) }) From 87299afe4eab9fe18bbfd13386f310b2eb0cc1c2 Mon Sep 17 00:00:00 2001 From: Rob Ashton Date: Mon, 8 Apr 2024 13:52:47 +0100 Subject: [PATCH 09/11] Add test for result path error case --- tests/testthat/test-01-endpoints-download.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/testthat/test-01-endpoints-download.R b/tests/testthat/test-01-endpoints-download.R index 9e3c5904..b67bf721 100644 --- a/tests/testthat/test-01-endpoints-download.R +++ b/tests/testthat/test-01-endpoints-download.R @@ -362,6 +362,17 @@ test_that("download result returns formatted error if unexpected issue", { expect_equal(error$data[[1]]$detail, scalar("Missing result for task: '1'")) }) +test_that("download result path returns formatted error if unexpected issue", { + queue <- MockQueue$new(workers = 0) + download <- download_result_path(queue) + error <- expect_error(download("1")) + + expect_equal(error$status_code, 400) + expect_equal(names(error$data[[1]]), c("error", "detail", "key")) + expect_equal(error$data[[1]]$error, scalar("FAILED_TO_RETRIEVE_RESULT")) + expect_equal(error$data[[1]]$detail, scalar("Missing result for task: '1'")) +}) + test_that("download submit returns error if queueing fails", { test_redis_available() ## Create mocks From 6a27c1893cf3e1a6b7870a927c2ff208bca8a6eb Mon Sep 17 00:00:00 2001 From: Rob Ashton Date: Tue, 27 Aug 2024 15:29:52 +0100 Subject: [PATCH 10/11] Ensure optional duckdb dependency is installed --- .github/workflows/R-CMD-check.yaml | 2 +- .github/workflows/R-integration-test.yaml | 2 +- .github/workflows/test-coverage.yaml | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index be76566f..e11c68aa 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -50,7 +50,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::rcmdcheck + extra-packages: any::rcmdcheck, any::duckdb needs: check - name: Start Redis diff --git a/.github/workflows/R-integration-test.yaml b/.github/workflows/R-integration-test.yaml index 1b8ec37e..a610389f 100644 --- a/.github/workflows/R-integration-test.yaml +++ b/.github/workflows/R-integration-test.yaml @@ -50,7 +50,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::devtools + extra-packages: any::devtools, any::duckdb - name: Start Redis if: runner.os != 'Windows' diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 33445540..469d6c30 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -30,7 +30,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::covr + extra-packages: any::covr, any::duckdb needs: coverage - name: Start Redis From bab8eb78e99074859d0aba3e0d856cc29deb0bc8 Mon Sep 17 00:00:00 2001 From: Rob Ashton Date: Mon, 16 Sep 2024 15:15:04 +0100 Subject: [PATCH 11/11] Remove workflow changes --- .github/workflows/R-CMD-check.yaml | 2 +- .github/workflows/R-integration-test.yaml | 2 +- .github/workflows/test-coverage.yaml | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index e11c68aa..be76566f 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -50,7 +50,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::rcmdcheck, any::duckdb + extra-packages: any::rcmdcheck needs: check - name: Start Redis diff --git a/.github/workflows/R-integration-test.yaml b/.github/workflows/R-integration-test.yaml index a610389f..1b8ec37e 100644 --- a/.github/workflows/R-integration-test.yaml +++ b/.github/workflows/R-integration-test.yaml @@ -50,7 +50,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::devtools, any::duckdb + extra-packages: any::devtools - name: Start Redis if: runner.os != 'Windows' diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 469d6c30..33445540 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -30,7 +30,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::covr, any::duckdb + extra-packages: any::covr needs: coverage - name: Start Redis