httpuv test app and curl fetch, in the same process

webapp.R

library(httpuv)

# Create a web server app which returns the time and prints out the value of
# a header named "test-header".
handle_request <- function(req) {
  list(
    status = 200L,
    headers = list('Content-Type' = 'text/plain'),
    body = paste0(
      "The time is: ", Sys.time(), "\n",
      'The value of `test-header`: "', req$HTTP_TEST_HEADER, '"'
    )
  )
}
s <- httpuv::startServer("0.0.0.0", 5000,
  list(
    call = function(req) handle_request(req)
  )
)


# Request a URL from the local web app
fetch <- function(url, headers = list()) {
  h <- curl::new_handle()
  do.call(curl::handle_setheaders, c(list(h), headers))

  # Make the request
  x <- NULL
  curl::curl_fetch_multi(
    url,
    handle = h,
    done = function(res) { x <<- res },
    fail = function(msg) {
      x <<- FALSE
      message("Failed: ", msg)
    }
  )
  # Pump both the curl and httpuv/later event loops until the download is finished.
  while (is.null(x)) {
    curl::multi_run(0)
    later::run_now()
  }

  x
}

x <- fetch("http://127.0.0.1:5000", list("test-header" = "abc"))
cat(rawToChar(x$content))
#> The time is: 2020-05-28 16:33:22
#> The value of `test-header`: "abc"