tests/testthat/test-plugin-test.R

In tjpalanca/webtools: Web Server Tools

test_that("Testing tools work", {

  # Application
  app <- App$new(TestPlugin$new())

  # Request router
  app$router("/", function(request, response, keys, ...) {
    response$body <- runif(1L)
    app$set_data("response", response$body)
    return(FALSE)
  })
  res <- app$test$request("/")
  expect_equal(res$status, 200L)
  expect_character(res$body)
  app$router("/", attach = "header", function(request, response, keys, ...) {
    return(FALSE)
  })
  res <- app$test$request("/")
  expect_equal(res$body, "")
  expect_error(app$router_remove("/", attach = "header"), NA)

  # Header Router
  app$router("/", attach = "header", function(request, response, keys, ...) {
    app$set_data("header", Sys.time())
    return(TRUE)
  }, replace = TRUE)
  expect_null(app$test$header("/"))
  time <- expect_posixct(app$get_data("header"))

  # Message Router
  app$set_path_extractor(function(msg, bin) msg$path)
  app$router(
    "/ws/message",
    attach = "message",
    function(request, response, keys, ...) {
      app$set_data("message", request$body$message)
      return(FALSE)
    }
  )
  message <- stri_rand_strings(1, 12)
  app$test$message(list(path = "/ws/message", message = message))
  expect_equal(app$get_data("message"), message)

})