tests/testthat/test-handle.R

In curl: A Modern and Flexible Web Client for R

context("Reusable handle")

h <- new_handle()

test_that("Perform", {
  expect_equal(curl_fetch_memory(httpbin("get"), handle = h)$status, 200)
  expect_equal(curl_fetch_memory(httpbin("cookies"), handle = h)$status, 200)
  expect_equal(curl_fetch_memory(httpbin("status/418"), handle = h)$status, 418)
})

test_that("Redirect", {
  expect_equal(curl_fetch_memory(httpbin("redirect/6"), handle = h)$status, 200)
  expect_equal(curl_fetch_memory(httpbin("relative-redirect/6"), handle = h)$status, 200)
  expect_equal(curl_fetch_memory(httpbin("absolute-redirect/6"), handle = h)$status, 200)
})

test_that("Cookies", {
  expect_equal(curl_fetch_memory(httpbin("cookies/set?foo=123&bar=456"), handle = h)$status, 200)
  expect_equal(jsonlite::fromJSON(rawToChar(curl_fetch_memory(httpbin("cookies"), handle = h)$content))$cookies$bar, "456")
  expect_equal(curl_fetch_memory(httpbin("cookies/delete?bar"), handle = h)$status, 200)
  if(curl::curl_version()$version == "7.62.0") Sys.sleep(1) #workaround for curl bug #3351
  expect_null(jsonlite::fromJSON(rawToChar(curl_fetch_memory(httpbin("cookies"), handle = h)$content))$cookies$bar)
})

test_that("Keep-Alive", {
  # Connection to httpbin already set in previous tests. Subsequent requests
  # should reuse the connection.
  # Capture the verbose curl output to look for the connection reuse message
  h <- handle_setopt(h, verbose=TRUE,
    debugfunction=function(type, msg) cat(readBin(msg, character())))
  req <- capture.output(curl_fetch_memory(httpbin("get"), handle=h))
  expect_true(any(grepl("existing connection", req)))
  handle_setopt(h, verbose=FALSE)
})

test_that("Opening and closing a connection",{
  # Create connection
  con <- curl(httpbin("cookies"), handle = h)

  # Handle is still usable
  expect_equal(curl_fetch_memory(httpbin("get"), handle = h)$status, 200)

  # Opening the connection locks the handle
  open(con)

  # Recent versions of libcurl will raise an error
  #if(compareVersion(curl_version()$version, "7.37") > 0){
  #  expect_error(curl_fetch_memory(httpbin("get", handle = h))
  #}

  expect_equal(jsonlite::fromJSON(readLines(con))$cookies$foo, "123")

  # After closing it is free again
  close(con)
  expect_equal(curl_fetch_memory(httpbin("get"), handle = h)$status, 200)

  # Removing the connection also unlocks the handle
  con <- curl(httpbin("cookies"), "rb", handle = h)

  # Recent versions of libcurl will raise an error
  #if(compareVersion(curl_version()$version, "7.37") > 0){
  #  expect_error(curl_fetch_memory(httpbin("get", handle = h))
  #}
  close(con)
  rm(con)
  expect_equal(curl_fetch_memory(httpbin("get"), handle = h)$status, 200)
})

test_that("Downloading to a file", {
  tmp <- tempfile()
  expect_error(curl_download(httpbin("status/418"), tmp, handle = h))

  curl_download(httpbin("get?test=boeboe"), tmp, handle = h)
  expect_equal(jsonlite::fromJSON(tmp)$args$test, "boeboe")

  curl_download(httpbin("cookies"), tmp, handle = h)
  expect_equal(jsonlite::fromJSON(tmp)$cookies$foo, "123")
})

test_that("handle_setopt validates options", {
  h <- new_handle()
  expect_identical(class(h), "curl_handle")
  expect_error(handle_setopt(h, invalid.option="foo"),
    "Unknown option: invalid.option")
  expect_error(handle_setopt(h, badopt1="foo", badopt2="bar"),
    "Unknown options: badopt1, badopt2")
  expect_identical(class(handle_setopt(h, username="foo")),
    "curl_handle") ## i.e. that's a valid option, so it succeeds
})

test_that("setting request headers", {
  h <- new_handle()
  expect_length(curl:::handle_getheaders(h), 0)
  handle_setheaders(h, foo = 'bar', baz = 'bak')
  expect_equal(curl:::handle_getheaders(h), c("foo: bar", "baz: bak", "Expect: "))
  handle_setheaders(h, foo = '123')
  expect_equal(curl:::handle_getheaders(h), c("foo: 123",  "Expect: "))
  handle_setopt(h, httpheader = c("test: blabla", "foobar: 123"))
  expect_equal(curl:::handle_getheaders(h), c("test: blabla", "foobar: 123"))
  handle_setheaders(h)
  expect_equal(curl:::handle_getheaders(h), c("Expect: "))
  handle_reset(h)
  expect_length(curl:::handle_getheaders(h), 0)
})


test_that("Set blank and NULL headers", {
  skip_if_not_installed('httpuv')
  skip_if_not_installed('webutils')
  h <- new_handle(url = 'https://httpbin.org/get')
  handle_setheaders(h, "accept-encoding" = "", "accept" = "", "user-agent" = "", foo = " ", bar = "\t")
  req <- curl::curl_echo(h)
  expect_equal(req$headers, c(bar = "", foo = "", host = "httpbin.org"))
})

test_that("Custom vector options", {
  h <- new_handle()
  x <- c("foo@gmail.com", "bar@jkhk.nl")
  handle_setopt(h, mail_rcpt = x)
  expect_equal(curl:::handle_getcustom(h), x)

  # This leaks a bit
  x <- c(x, "jeroen@test.nl")
  handle_setopt(h, quote = c("bla"))
  handle_setopt(h, mail_rcpt = x)
  expect_equal(curl:::handle_getcustom(h), x)

  # Test free'ing
  handle_setopt(h, quote = NULL)
  handle_setopt(h, mail_rcpt = NULL)
  handle_reset(h)
  handle_setopt(h, quote = c("bla"))
})

test_that("Custom URL parser", {
  h <- new_handle(timeout = 1L)
  expect_error(curl_fetch_memory('https://httpbin.org/delay/10', handle = h), 'Timeout was reached: [httpbin.org] ', fixed = TRUE)

  h <- new_handle(timeout = 1L)
  expect_error(curl_fetch_memory('httpbin.org/delay/10', handle = h), 'Timeout was reached: [httpbin.org] ', fixed = TRUE)
})

test_that("Platform specific features", {
  if(.Platform$OS.type == 'windows'){
    ssl_version <- curl_version()$ssl_version
    if(get_windows_build() < 7600 || grepl("openssl", Sys.getenv('CURL_SSL_BACKEND'), TRUE)){
      expect_match(ssl_version, "OpenSSL.*\\(Schannel\\)")
    } else {
      expect_match(ssl_version, "\\(OpenSSL.*\\) Schannel")
    }
  } else if(!is.na(curl_options()['unix_socket_path'])){
    # This should simply not error
    expect_is(new_handle(UNIX_SOCKET_PATH = ""), "curl_handle")
  }
})

rm(h)
test_that("GC works", {
  gc()
  expect_equal(total_handles(), 0L)
})