From 6b3f4b0d305730571bb928402feef94cb266f774 Mon Sep 17 00:00:00 2001 From: "Elian H. Thiele-Evans" <60372411+ElianHugh@users.noreply.github.com> Date: Mon, 24 Jun 2024 13:07:56 +1000 Subject: [PATCH] Housework - Add some defensive checks - Fix config check not using host or ignore - Remove message suppression from tests (no longer necessary) --- R/config.R | 8 ++++- R/engine.R | 10 ++++++ R/mirai.R | 4 +++ R/run.R | 2 +- TODO.md | 4 --- tests/testthat/helpers.R | 2 +- tests/testthat/test-cli.R | 12 ++------ tests/testthat/test-middleware.R | 52 +++++++++++++++----------------- 8 files changed, 49 insertions(+), 45 deletions(-) diff --git a/R/config.R b/R/config.R index d545bae..9e80bc9 100644 --- a/R/config.R +++ b/R/config.R @@ -30,13 +30,15 @@ new_config <- function(...) { host = host ), ignore = ignore, - runner_compute = "hotwater_runner" + runner_compute = "hotwater_runner" # todo fix ), class = c("hotwater_config", "list") ) } validate_config <- function(config) { + stopifnot(is_config(config)) + if (!file.exists(config$entry_path) || dir.exists(config$entry_path)) { error_invalid_path(config$entry_path) } @@ -69,4 +71,8 @@ new_port <- function(used, host = "127.0.0.1") { } } out +} + +is_config <- function(x) { + "hotwater_config" %in% class(x) } \ No newline at end of file diff --git a/R/engine.R b/R/engine.R index 65b0231..e3e2984 100644 --- a/R/engine.R +++ b/R/engine.R @@ -1,4 +1,5 @@ new_engine <- function(config) { + stopifnot(is_config(config)) structure( list2env( list( @@ -51,10 +52,13 @@ run_engine <- function(engine) { } kill_engine <- function(engine) { + stopifnot(is_engine(engine)) kill_runner(engine) } buildup_engine <- function(engine) { + stopifnot(is_engine(engine)) + cli_server_start_progress(engine) res <- new_runner(engine) if (!res) { @@ -67,6 +71,8 @@ buildup_engine <- function(engine) { } teardown_engine <- function(engine) { + stopifnot(is_engine(engine)) + cli_server_stop_progress() resp <- kill_engine(engine) if (isTRUE(resp)) { @@ -75,3 +81,7 @@ teardown_engine <- function(engine) { cli::cli_progress_done(result = "failed") } } + +is_engine <- function(x) { + "hotwater_engine" %in% class(x) +} \ No newline at end of file diff --git a/R/mirai.R b/R/mirai.R index 6459867..c047181 100644 --- a/R/mirai.R +++ b/R/mirai.R @@ -1,4 +1,6 @@ new_runner <- function(engine) { + stopifnot(is_engine(engine)) + mirai::daemons( n = 1L, dispatcher = FALSE, @@ -55,11 +57,13 @@ new_runner <- function(engine) { } kill_runner <- function(engine) { + stopifnot(is_engine(engine)) mirai::daemons(0L, .compute = engine$config$runner_compute) !is_runner_alive(engine) } is_runner_alive <- function(engine) { + stopifnot(is_engine(engine)) mirai::unresolved(engine$runner) } diff --git a/R/run.R b/R/run.R index 576292d..f01dc1a 100644 --- a/R/run.R +++ b/R/run.R @@ -44,5 +44,5 @@ should_reuse_engine <- function(old_config, config) { same_port <- identical(old_config$port, config$port) || is.null(config$port) same_host <- identical(old_config$host, config$host) || is.null(config$host) same_ignore <- identical(old_config$ignore, config$ignore) || is.null(config$ignore) - old_exists && same_path && same_port && same_dirs + old_exists && same_path && same_port && same_dirs && same_host && same_ignore } diff --git a/TODO.md b/TODO.md index 91ef76e..bb97b75 100644 --- a/TODO.md +++ b/TODO.md @@ -15,7 +15,3 @@ ## 4 - The CLI messages are a bit all over the place, and errors don't always cause the progress bar to fail - -## 6 - -- Should do some defensive prog diff --git a/tests/testthat/helpers.R b/tests/testthat/helpers.R index e88fca5..ae5f912 100644 --- a/tests/testthat/helpers.R +++ b/tests/testthat/helpers.R @@ -1,6 +1,6 @@ new_test_engine <- function() { new_engine( - config = new_config( + new_config( path = system.file("examples", "plumber.R", package = "hotwater") ) ) diff --git a/tests/testthat/test-cli.R b/tests/testthat/test-cli.R index f465a52..dfeb76e 100644 --- a/tests/testthat/test-cli.R +++ b/tests/testthat/test-cli.R @@ -1,14 +1,6 @@ test_that("startup/teardown messages don't error", { engine <- new_test_engine() - expect_no_error( - suppressMessages( - buildup_engine(engine) - ) - ) - expect_no_error( - suppressMessages( - teardown_engine(engine) - ) - ) + expect_no_error(suppressMessages(buildup_engine(engine))) + expect_no_error(suppressMessages(teardown_engine(engine))) cleanup_test_engine(engine) }) diff --git a/tests/testthat/test-middleware.R b/tests/testthat/test-middleware.R index 0a70919..0a04086 100644 --- a/tests/testthat/test-middleware.R +++ b/tests/testthat/test-middleware.R @@ -18,20 +18,18 @@ test_that("middleware injection works", { test_that("middleware injection works with filters", { engine <- new_test_engine() - runner <- suppressMessages( - mirai::mirai( - { - plumber::pr(config$entry_path) |> - plumber::pr_filter("foo", function(req, res) { - stop("I break things") - }) |> - middleware_filter() |> - plumber::pr_run(port = config$port) - }, - config = engine$config, - middleware_filter = middleware(engine), - .compute = engine$config$runner_compute - ) + runner <- mirai::mirai( + { + plumber::pr(config$entry_path) |> + plumber::pr_filter("foo", function(req, res) { + stop("I break things") + }) |> + middleware_filter() |> + plumber::pr_run(port = config$port) + }, + config = engine$config, + middleware_filter = middleware(engine), + .compute = engine$config$runner_compute ) i <- 1L @@ -50,20 +48,18 @@ test_that("middleware injection works with filters", { test_that("is_plumber_running works", { engine <- new_test_engine() - router <- suppressMessages( - mirai::mirai( - { - plumber::pr(config$entry_path) |> - plumber::pr_get( - "/__hotwater__", - function() "running", - serializer = plumber::serializer_text() - ) |> - plumber::pr_run(port = config$port) - }, - config = engine$config, - .compute = engine$config$runner_compute - ) + router <- mirai::mirai( + { + plumber::pr(config$entry_path) |> + plumber::pr_get( + "/__hotwater__", + function() "running", + serializer = plumber::serializer_text() + ) |> + plumber::pr_run(port = config$port) + }, + config = engine$config, + .compute = engine$config$runner_compute ) i <- 1L while (i < 20L && !is_plumber_running(engine)) {