Add unit tests for static file serving

tests/testthat/apps/content/data.txt

@@ -0,0 +1,2 @@
+This is a text file.
+

tests/testthat/apps/content/index.html

@@ -0,0 +1,3 @@
+This is the index file!
+
+Here's a UTF-8 emoji: 😀

tests/testthat/apps/content/mtcars.csv

@@ -0,0 +1,33 @@
+"mpg","cyl","disp","hp","drat","wt","qsec","vs","am","gear","carb"
+21,6,160,110,3.9,2.62,16.46,0,1,4,4
+21,6,160,110,3.9,2.875,17.02,0,1,4,4
+22.8,4,108,93,3.85,2.32,18.61,1,1,4,1
+21.4,6,258,110,3.08,3.215,19.44,1,0,3,1
+18.7,8,360,175,3.15,3.44,17.02,0,0,3,2
+18.1,6,225,105,2.76,3.46,20.22,1,0,3,1
+14.3,8,360,245,3.21,3.57,15.84,0,0,3,4
+24.4,4,146.7,62,3.69,3.19,20,1,0,4,2
+22.8,4,140.8,95,3.92,3.15,22.9,1,0,4,2
+19.2,6,167.6,123,3.92,3.44,18.3,1,0,4,4
+17.8,6,167.6,123,3.92,3.44,18.9,1,0,4,4
+16.4,8,275.8,180,3.07,4.07,17.4,0,0,3,3
+17.3,8,275.8,180,3.07,3.73,17.6,0,0,3,3
+15.2,8,275.8,180,3.07,3.78,18,0,0,3,3
+10.4,8,472,205,2.93,5.25,17.98,0,0,3,4
+10.4,8,460,215,3,5.424,17.82,0,0,3,4
+14.7,8,440,230,3.23,5.345,17.42,0,0,3,4
+32.4,4,78.7,66,4.08,2.2,19.47,1,1,4,1
+30.4,4,75.7,52,4.93,1.615,18.52,1,1,4,2
+33.9,4,71.1,65,4.22,1.835,19.9,1,1,4,1
+21.5,4,120.1,97,3.7,2.465,20.01,1,0,3,1
+15.5,8,318,150,2.76,3.52,16.87,0,0,3,2
+15.2,8,304,150,3.15,3.435,17.3,0,0,3,2
+13.3,8,350,245,3.73,3.84,15.41,0,0,3,4
+19.2,8,400,175,3.08,3.845,17.05,0,0,3,2
+27.3,4,79,66,4.08,1.935,18.9,1,1,4,1
+26,4,120.3,91,4.43,2.14,16.7,0,1,5,2
+30.4,4,95.1,113,3.77,1.513,16.9,1,1,5,2
+15.8,8,351,264,4.22,3.17,14.5,0,1,5,4
+19.7,6,145,175,3.62,2.77,15.5,0,1,5,6
+15,8,301,335,3.54,3.57,14.6,0,1,5,8
+21.4,4,121,109,4.11,2.78,18.6,1,1,4,2

tests/testthat/apps/content/subdir/index.html

@@ -0,0 +1 @@
+This is the index file for content/subdir/

tests/testthat/apps/content_1/index.html

@@ -0,0 +1 @@
+Index file for content1.

tests/testthat/helper-app.R

@@ -0,0 +1,130 @@
+library(curl)
+library(promises)
+
+
+random_open_port <- function(min = 3000, max = 9000, n = 20) {
+  # Unsafe port list from shiny::runApp()
+  valid_ports <- setdiff(min:max, c(3659, 4045, 6000, 6665:6669, 6697))
+
+  # Try up to n ports
+  for (port in sample(valid_ports, n)) {
+    handle <- NULL
+
+    # Check if port is open
+    tryCatch(
+      handle <- httpuv::startServer("127.0.0.1", port, list()),
+      error = function(e) { }
+    )
+    if (!is.null(handle)) {
+      httpuv::stopServer(handle)
+      return(port)
+    }
+  }
+
+  stop("Cannot find an available port")
+}
+
+
+curl_fetch_async <- function(url, pool = NULL, data = NULL, handle = new_handle()) {
+  p <- promises::promise(function(resolve, reject) {
+    curl_fetch_multi(url, done = resolve, fail = reject, pool = pool, data = data, handle = handle)
+  })
+
+  finished <- FALSE
+  poll <- function() {
+    if (!finished) {
+      multi_run(timeout = 0, poll = TRUE, pool = pool)
+      later::later(poll, 0.01)
+    }
+  }
+  poll()
+
+  p %>% finally(function() {
+    finished <<- TRUE
+  })
+}
+
+
+# A way of sending an HTTP request using a socketConnection. This isn't as
+# reliable as using curl, so we'll use it only when curl can't do what we want.
+http_request_con_async <- function(request, host, port) {
+  resolve_fun <- NULL
+  reject_fun  <- NULL
+  con         <- NULL
+
+  p <- promises::promise(function(resolve, reject) {
+    resolve_fun <<- resolve
+    reject_fun  <<- reject
+    con <<- socketConnection(host, port)
+    writeLines(c(request, ""), con)
+  })
+
+  result   <- NULL
+  # finished <- FALSE
+  poll <- function() {
+    result <<- readLines(con)
+    if (length(result) > 0) {
+      resolve_fun(result)
+    } else {
+      later::later(poll, 0.01)
+    }
+  }
+  poll()
+
+  p %>% finally(function() {
+    close(con)
+  })
+}
+
+
+wait_for_it <- function() {
+  while (!later::loop_empty()) {
+    later::run_now()
+  }
+}
+
+
+# Block until the promise is resolved/rejected. If resolved, return the value.
+# If rejected, throw (yes throw, not return) the error.
+extract <- function(promise) {
+  promise_value <- NULL
+  error <- NULL
+  promise %...>%
+    (function(value) promise_value <<- value) %...!%
+    (function(reason) error <<- reason)
+
+  wait_for_it()
+  if (!is.null(error))
+    stop(error)
+  else
+    promise_value
+}
+
+
+# Make an HTTP request using curl.
+fetch <- function(url, handle = new_handle()) {
+  p <- curl_fetch_async(url, handle = handle)
+  extract(p)
+}
+
+# Make an HTTP request using a socketConnection. Not as robust as fetch(), so
+# we'll use this only when necessary.
+http_request_con <- function(request, host, port) {
+  p <- http_request_con_async(request, host, port)
+  extract(p)
+}
+
+
+local_url <- function(path, port) {
+  stopifnot(grepl("^/", path))
+  paste0("http://127.0.0.1:", port, path)
+}
+
+parse_http_date <- function(x) {
+  strptime(x, format = "%a, %d %b %Y %H:%M:%S GMT", tz = "GMT")  
+}
+
+raw_file_content <- function(filename) {
+  size <- file.info(filename)$size
+  readBin(filename, "raw", n = size)
+}

tests/testthat/test-app.R

@@ -0,0 +1,46 @@
+context("basic")
+
+test_that("Basic functionality", {
+  s1 <- startServer("127.0.0.1", random_open_port(),
+    list(
+      call = function(req) {
+        list(
+          status = 200L,
+          headers = list('Content-Type' = 'text/html'),
+          body = "server 1"
+        )
+      }
+    )
+  )
+  expect_equal(length(listServers()), 1)
+
+  s2 <- startServer("127.0.0.1", random_open_port(),
+    list(
+      call = function(req) {
+        list(
+          status = 200L,
+          headers = list('Content-Type' = 'text/html'),
+          body = "server 2"
+        )
+      }
+    )
+  )
+  expect_equal(length(listServers()), 2)
+
+  r1 <- fetch(local_url("/", s1$getPort()))
+  r2 <- fetch(local_url("/", s2$getPort()))
+
+  expect_equal(r1$status_code, 200)
+  expect_equal(r2$status_code, 200)
+
+  expect_identical(rawToChar(r1$content), "server 1")
+  expect_identical(rawToChar(r2$content), "server 2")
+
+  expect_identical(parse_headers_list(r1$headers)$`content-type`, "text/html")
+  expect_identical(parse_headers_list(r1$headers)$`content-length`, "8")
+
+  s1$stop()
+  expect_equal(length(listServers()), 1)
+  stopAllServers()
+  expect_equal(length(listServers()), 0)
+})