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 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..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) ) @@ -800,26 +801,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 }, @@ -833,6 +842,27 @@ download_result <- function(queue) { } } +download_result_path <- function(queue) { + function(id) { + tryCatch({ + res <- get_download_result(queue, id, "FAILED_DOWNLOAD") + 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) + res$metadata$file_extension <- download_file_extension(res$metadata$type) + recursive_scalar(res) + }, + 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..ec51e92d --- /dev/null +++ b/inst/schema/DownloadResultResponse.schema.json @@ -0,0 +1,20 @@ +{ + "$schema": "http://json-schema.org/draft-04/schema#", + "type": "object", + "properties": { + "path": { "type": "string" }, + "metadata": { + "type": "object", + "properties": { + "id": { "type": "string" }, + "description": { "type": "string" }, + "areas": { "type": "string" }, + "type": { "type": "string" }, + "file_extension": { "type": "string" }, + "file_label": { "type": "string" } + }, + "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 9b7ce478..ddfa1ac6 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$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 49f64f08..b67bf721 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", { @@ -340,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