tests/testthat/test-fire.R

In tjpalanca/webtools: Web Server Tools

test_that("Fire initializes", {
  fire <- expect_r6(Fire$new(), "Fire")
})

test_that("Fire event triggering works", {

  fire <- Fire$new(port = 3838)
  fire$on("custom", function(server, ...) {
    server$set_data("custom", TRUE)
  })
  fire$on("cycle-start", function(server, ...) {
    server$set_data("cycle_started", TRUE)
  })
  fire$trigger("custom")
  expect_true(fire$get_data("custom"))
  expect_error(fire$trigger("cycle-start", check = TRUE))
  fire$trigger("cycle-start", check = FALSE)
  expect_true(fire$get_data("cycle_started"))
  expect_true(fire$data$cycle_started)

})

test_that("Fire starts and stops", {

  fire <- Fire$new(port = 3838)
  expect_error(fire$start(block = FALSE), NA)
  expect_true(fire$is_running())
  expect_error(fire$stop(), NA)

  later(function() fire$stop(), delay = 5L)
  expect_error(fire$start(block = TRUE), NA)
  expect_false(fire$is_running())

})

test_that("Fire routing functions work as expected", {

  fire <- Fire$new(port = 3838)
  fire$on_router(
    path = "test",
    handler = function(request, response, keys, ...) {
      response$status_with_text(200L)
      return(FALSE)
    }
  )
  fire$build_routers()
  expect_list(fire$handles, len = 1L)
  expect_error(fire$on_router(
    path = "test",
    handler = function(request, response, keys, ...) NULL
  ))
  expect_length(unlist(fire$routers), 1L)
  fire$build_routers()
  expect_r6(fire$plugins$request_routr, "RouteStack")
  res <- fire$test_request(fake_request("https://localhost:3838/test"))
  expect_equal(res$status, 200L)
  expect_equal(res$body, "OK")

  expect_error(fire$start(block = FALSE), NA)
  expect_true(fire$is_running())
  expect_error(fire$stop(), NA)

  fire$off_router(name = "test")
  expect_length(unlist(fire$routers), 0L)
  fire$build_routers()
  res <- fire$test_request(fake_request("https://localhost:3838/test"))
  expect_equal(res$status, 404L)

})

test_that("Fire static path functions work as expected", {

  fire <- Fire$new(port = 3838)
  with_tempdir(fire$on_static("test", getwd()))
  expect_error(with_tempdir(fire$on_static("test", getwd())))
  expect_class(fire$statics$test, "staticPath")

  expect_error(fire$start(block = FALSE), NA)
  expect_true(fire$is_running())
  expect_error(fire$stop(), NA)

  fire$off_static(name = "test")
  expect_length(fire$statics, 0L)

})

test_that("Fire improved plugin support works as expected", {

  fire  <- Fire$new(port = 3838)
  stack <- RouteStack$new()
  stack$add_route(name = "message", routr::Route$new(all = list(
    "/*" = function(request, response, keys, ...) {
      response$status_with_text(200L)
      return(FALSE)
    }
  )))

  expect_error(fire$attach(stack), NA)
  expect_error(fire$attach(stack))
  expect_length(fire$plugins, 1L)

  res <- fire$test_request(fake_request("http://localhost:3838/"))
  expect_equal(res$status, 200L)
  expect_equal(res$body, "OK")

  expect_error(fire$detach("request_routr"), NA)
  expect_length(fire$plugins, 0L)

  res <- fire$test_request(fake_request("http://localhost:3838/"))
  expect_equal(res$status, 404L)

  expect_error(fire$attach(stack), NA)
  expect_length(fire$plugins, 1L)

  expect_error(fire$detach_all(), NA)
  expect_length(fire$plugins, 0L)

  expect_error(fire$attach(stack), NA)
  plugin <- list(name = "error", requires = "missing")
  expect_error(fire$attach(plugin))
  plugin <- list(name      = "pass",
                 requires  = "request_routr",
                 on_attach = function(...) NULL)
  expect_error(fire$attach(plugin))
  plugin <- list(name      = "pass",
                 requires  = "request_routr",
                 on_attach = function(...) "handler_id")
  expect_error(fire$attach(plugin), NA)

})

test_that("Miscellaneous utilities for Fire work", {

  fire <- Fire$new(port = 3838)
  expect_error(fire$browse(), NA)
  expect_equal(as.character(fire$url), "http://127.0.0.1:3838/")
  expect_named(fire$events,
               c("start", "resume", "end",
                 "cycle-start", "cycle-end",
                 "header", "before-request", "request", "after-request",
                 "before-message", "message", "after-message",
                 "send", "websocket-closed"))
  expect_class(fire$sockets, "environment")

})

stop_all()