tests/testthat/test-traffic.R

In rstudio/httpuv: HTTP and WebSocket Server Library

context("traffic")

skip_if_not_possible <- function() {
  # Temporarily disable these tests because they may not run reliably on
  # some platforms.
  skip("")
  # skip_on_cran()

  if (Sys.which("ab")[[1]] == "") {
    skip("ab (Apache bench) not available for running traffic tests")
  }
}

parse_ab_output <- function(p) {
  text <- readLines(p$get_output_file())

  if (!any(grepl("^Complete requests:\\s+", text))) {
    return(list(
      completed = NULL,
      failed = NULL,
      hang = TRUE,
      text = text
    ))
  }

  results <- list(
    hang = FALSE,
    text = text
  )

  line <- text[grepl("^Complete requests:\\s+", text)]
  results$completed <- as.integer(sub("^Complete requests:\\s+(\\d+).*", "\\1", line))

  line <- text[grepl("^Failed requests:\\s+", text)]
  results$failed <- as.integer(sub("^Failed requests:\\s+(\\d+).*", "\\1", line))

  results
}

# Launch sample_app process and return process object
start_app <- function(port) {
  outfile <- tempfile()
  callr::r_bg(
    function(app_port) {
      source(testthat::test_path('sample_app.R'), local = TRUE)
      service(Inf)
    },
    args = list(app_port = port),
    stdout = outfile, stderr = outfile, supervise = TRUE
  )
}

# Start an apachebench test
start_ab <- function(port, path, n = 400, concurrent = 100) {
  outfile <- tempfile()
  callr::process$new(
    "ab",
    args = c(paste0("-n", n), paste0("-c", concurrent), sprintf("http://127.0.0.1:%d%s", port, path)),
    stdout = outfile, stderr = outfile
  )
}


test_that("Basic traffic test", {
  skip_if_not_possible()
  port <- randomPort()
  p <- start_app(port)
  Sys.sleep(1)

  bench <- start_ab(port, "/")
  bench$wait(20000)

  results <- parse_ab_output(bench)
  expect_false(results$hang)
  expect_equal(results$completed, 400)

  p$kill()
  bench$kill()
})

test_that("Two concurrent", {
  skip_if_not_possible()
  port <- randomPort()
  p <- start_app(port)
  Sys.sleep(1)
  expect_true(p$is_alive())

  bench <- start_ab(port, "/")
  bencha <- start_ab(port, "/")

  bench$wait(20000)
  bencha$wait(20000)

  results <- parse_ab_output(bench)
  expect_false(results$hang)
  expect_equal(results$completed, 400)

  resultsa <- parse_ab_output(bencha)
  expect_false(resultsa$hang)
  expect_equal(resultsa$completed, 400)

  p$kill()
  bench$kill()
  bencha$kill()
})


test_that("/header /sync endpoints", {
  skip_if_not_possible()
  port <- randomPort()
  p <- start_app(port)

  Sys.sleep(1)
  expect_true(p$is_alive())

  bench <- start_ab(port, "/header")
  bencha <- start_ab(port, "/sync")

  bench$wait(40000)
  bencha$wait(40000)

  results <- parse_ab_output(bench)
  expect_false(results$hang)
  expect_equal(results$completed, 400)

  resultsa <- parse_ab_output(bencha)
  expect_false(resultsa$hang)
  expect_equal(resultsa$completed, 400)

  p$kill()
  bench$kill()
  bencha$kill()
})

test_that("/header /async endpoints", {
  skip_if_not_possible()
  port <- randomPort()
  p <- start_app(port)

  Sys.sleep(1)
  expect_true(p$is_alive())

  bench <- start_ab(port, "/header")
  bencha <- start_ab(port, "/async")

  bench$wait(40000)
  bencha$wait(40000)

  results <- parse_ab_output(bench)
  expect_false(results$hang)
  expect_equal(results$completed, 400)

  resultsa <- parse_ab_output(bencha)
  expect_false(resultsa$hang)
  expect_equal(resultsa$completed, 400)

  p$kill()
  bench$kill()
  bencha$kill()
})


test_that("/header /async-error endpoints", {
  skip_if_not_possible()
  port <- randomPort()
  p <- start_app(port)

  Sys.sleep(1)
  expect_true(p$is_alive())

  bench <- start_ab(port, "/header")
  bencha <- start_ab(port, "/async-error")

  bench$wait(40000)
  bencha$wait(40000)

  results <- parse_ab_output(bench)
  expect_false(results$hang)
  expect_equal(results$completed, 400)

  resultsa <- parse_ab_output(bencha)
  expect_false(resultsa$hang)
  expect_equal(resultsa$completed, 400)

  p$kill()
  bench$kill()
  bencha$kill()
})


test_that("/async /async-error endpoints", {
  skip_if_not_possible()
  port <- randomPort()
  p <- start_app(port)

  Sys.sleep(1)
  expect_true(p$is_alive())

  bench <- start_ab(port, "/async")
  bencha <- start_ab(port, "/async-error")

  bench$wait(40000)
  bencha$wait(40000)

  results <- parse_ab_output(bench)
  expect_false(results$hang)
  expect_equal(results$completed, 400)

  resultsa <- parse_ab_output(bencha)
  expect_false(resultsa$hang)
  expect_equal(resultsa$completed, 400)

  p$kill()
  bench$kill()
  bencha$kill()
})



test_that("/body-error /async-error endpoints", {
  skip_if_not_possible()
  port <- randomPort()
  p <- start_app(port)

  Sys.sleep(1)
  expect_true(p$is_alive())

  bench <- start_ab(port, "/body-error")
  bencha <- start_ab(port, "/async-error")

  bench$wait(40000)
  bencha$wait(40000)

  results <- parse_ab_output(bench)
  expect_false(results$hang)
  expect_equal(results$completed, 400)

  resultsa <- parse_ab_output(bencha)
  expect_false(resultsa$hang)
  expect_equal(resultsa$completed, 400)

  p$kill()
  bench$kill()
  bencha$kill()
})


test_that("static paths", {
  skip_if_not_possible()
  port <- randomPort()
  p <- start_app(port)

  Sys.sleep(1)
  expect_true(p$is_alive())

  bench <- start_ab(port, "/static", n = 2000)
  bencha <- start_ab(port, "/static/missing_file", n = 2000)

  bench$wait(20000)
  bencha$wait(20000)

  results <- parse_ab_output(bench)
  expect_false(results$hang)
  expect_equal(results$completed, 2000)

  resultsa <- parse_ab_output(bencha)
  expect_false(resultsa$hang)
  expect_equal(resultsa$completed, 2000)

  bench$kill()
  bencha$kill()


  # Check fallthrough
  bench <- start_ab(port, "/static_fallthrough", n = 2000)
  bencha <- start_ab(port, "/static_fallthrough/missing_file", n = 1000)

  bench$wait(20000)
  bencha$wait(20000)

  results <- parse_ab_output(bench)
  expect_false(results$hang)
  expect_equal(results$completed, 2000)

  resultsa <- parse_ab_output(bencha)
  expect_false(resultsa$hang)
  expect_equal(resultsa$completed, 1000)

  p$kill()
  bench$kill()
  bencha$kill()
})