tests/testthat/test-4-async-http.R

In pkgcache: Cache 'CRAN'-Like Metadata and R Packages

test_that("read_etag", {
  cat("foobar\n", file = tmp <- tempfile())
  expect_equal(read_etag(tmp), "foobar")

  cat("\"foobar\"", file = tmp)
  expect_equal(read_etag(tmp), "\"foobar\"")

  cat(" ", file = tmp)
  expect_equal(read_etag(tmp), " ")

  cat("", file = tmp)
  expect_true(length(tmp) == 1 && is.na(read_etag(tmp)))

  cat("foo\nbar", file = tmp)
  expect_equal(read_etag(tmp), "foo")

  expect_true(is.na(read_etag(tempfile())))
})

test_that("download_file", {

  dir.create(dir <- tempfile())
  dx <- synchronise(download_file(
    url    <- http$url("/response-headers?etag=foobar"),
    target <- file.path(dir, "file1"),
    etag   <- file.path(dir, "etag"),
    headers = c("accept-encoding" = "")
  ))

  expect_true(file.exists(target))
  expect_equal(jsonlite::fromJSON(target)$etag, "foobar")
  expect_true(file.exists(etag))
  expect_equal(read_lines(etag), "foobar")
})

test_that("download_file, errors", {
  tmp <- tempfile()
  err <- tryCatch(
    synchronise(download_file("http://0.42.42.42", tmp)),
    error = function(e) e
  )
  expect_s3_class(err, "async_rejected")
  expect_s3_class(err, "async_http_error")

  err2 <- tryCatch(
    synchronise(download_file(http$url("/status/404"), tmp)),
    error = function(e) e
  )
  expect_s3_class(err2, "async_rejected")
  expect_s3_class(err2, "async_http_404")
  expect_s3_class(err2, "async_http_error")

  ret <- synchronise(download_file(
    http$url("/statud/404"),
    tmp,
    error_on_status = FALSE
  ))
  expect_s3_class(ret, "async_rejected")
  expect_s3_class(ret, "async_http_404")
  expect_s3_class(ret, "async_http_error")
})

test_that("download_if_newer, no etag file", {

  dir.create(dir <- tempfile())
  dx <- synchronise(download_if_newer(
    url    <- http$url("/etag/foobar"),
    target <- file.path(dir, "file1"),
    etag   <- file.path(dir, "etag"),
    headers = c("accept-encoding" = "")
  ))

  expect_true(file.exists(target))
  expect_equal(jsonlite::fromJSON(target)$url, url)
  expect_true(file.exists(etag))
  expect_equal(read_lines(etag), "foobar")
})

test_that("download_if_newer, different etag", {

  dir.create(dir <- tempfile())

  cat("eeeetag\n", file = etag <- file.path(dir, "etag"))
  dx <- synchronise(download_if_newer(
    url    <- http$url("/etag/foobar"),
    target <- file.path(dir, "file1"),
    etag,
    headers = c("accept-encoding" = "")
  ))

  expect_true(file.exists(target))
  expect_equal(jsonlite::fromJSON(target)$url, url)
  expect_true(file.exists(etag))
  expect_equal(read_lines(etag), "foobar")
})

test_that("download_if_newer, matching etag", {

  dir.create(dir <- tempfile())

  cat("foobar\n", file = etag <- file.path(dir, "etag"))
  cat("dummy\n", file = target <- file.path(dir, "file1"))
  dx <- synchronise(download_if_newer(
    url    <- http$url("/etag/foobar"),
    target,
    etag
  ))

  expect_true(file.exists(target))
  expect_equal(read_lines(target), "dummy")
  expect_true(file.exists(etag))
  expect_equal(read_lines(etag), "foobar")
  expect_equal(dx$response$status_code, 304)
})

test_that("download_if_newer, error", {

  cat("dummy\n", file = target <- tempfile())
  on.exit(unlink(target), add = TRUE)

  err <- tryCatch(
    synchronise(download_if_newer(
      url <- "http://0.42.42.42",
      destfile = target
    )),
    error = function(e) e
  )
  expect_s3_class(err, "async_rejected")
  expect_s3_class(err, "async_http_error")

  err <- tryCatch(
    synchronise(download_if_newer(
      url <- http$url("/status/404"),
      destfile = target
    )),
    error = function(e) e
  )
  expect_s3_class(err, "async_rejected")
  expect_s3_class(err, "async_http_404")
  expect_s3_class(err, "async_http_error")

  err <- tryCatch(
    synchronise(download_if_newer(
      http$url("/status/201"),
      destfile = target
    )),
    error = function(e) e)
  expect_s3_class(err, "async_rejected")
  expect_match(conditionMessage(err), "Unknown HTTP response")

  ret <- synchronise(download_if_newer(
    http$url("/status/404"),
    destfile = target,
    error_on_status = FALSE
  ))
  expect_s3_class(ret, "async_rejected")
  expect_s3_class(ret, "async_http_404")
  expect_s3_class(ret, "async_http_error")
})

test_that("download_one_of", {

  dx <- synchronise(download_one_of(
    http$url(c("/status/404", "/status/403", "/get?q=1")),
    tmp <- tempfile()
  ))

  res <- jsonlite::fromJSON(
    read_lines(tmp, warn = FALSE),
    simplifyVector = FALSE
  )
  expect_equal(res$args$q, "1")
})

test_that("download_one_of, etag", {

  dir.create(dir <- tempfile())

  cat("eeeetag\n", file = etag <- file.path(dir, "etag"))
  dx <- synchronise(download_one_of(
    c(http$url("/status/404"),
      http$url("/status/403"),
      url <- http$url("/etag/foobar")),
    target <- file.path(dir, "file1"),
    etag_file = etag,
    headers = c("accept-encoding" = "")
  ))

  expect_true(file.exists(target))
  expect_equal(jsonlite::fromJSON(target)$url, url)
  expect_true(file.exists(etag))
  expect_equal(read_lines(etag), "foobar")
})

test_that("download_one_of, matching etag", {

  dir.create(dir <- tempfile())

  cat("foobar\n", file = etag <- file.path(dir, "etag"))
  cat("dummy\n", file = target <- file.path(dir, "file1"))
  dx <- synchronise(download_one_of(
    http$url(c("/status/404", "/status/403", "/etag/foobar")),
    target,
    etag_file = etag
  ))

  expect_true(file.exists(target))
  expect_equal(read_lines(target), "dummy")
  expect_true(file.exists(etag))
  expect_equal(read_lines(etag), "foobar")
})

test_that("download_one_of, errors", {

  tmp <- tempfile()

  afun <- async(function() {
    download_one_of(
      http$url(c("/status/404", "/status/403", "/status/404")),
      tmp
    )
  })

  err <- tryCatch(synchronise(afun()), error = identity)
  expect_match(conditionMessage(err), "All URLs failed")
  expect_true("download_one_of_error" %in% class(err))
  expect_false(file.exists(tmp))

  afun2 <- async(function() {
    download_one_of(
      http$url(c("/status/404", "/status/403")),
      error_on_status = FALSE,
      tmp
    )
  })
  ret <- synchronise(afun2())
  expect_s3_class(ret, "download_one_of_error")
  expect_s3_class(ret, "async_rejected")
  expect_equal(length(ret$error), 2)
  expect_s3_class(ret$error[[1]], "async_rejected")
  expect_s3_class(ret$error[[1]], "async_http_error")
  expect_s3_class(ret$error[[2]], "async_rejected")
  expect_s3_class(ret$error[[2]], "async_http_error")
  cl <- c(class(ret$error[[1]]), class(ret$error[[2]]))
  expect_true("async_http_404" %in% cl)
  expect_true("async_http_403" %in% cl)
})

test_that("download_files", {

  dir <- test_temp_dir()
  downloads <- data.frame(
    stringsAsFactors = FALSE,
    url  = http$url(paste0("/etag/foobar", 1:3)),
    path = file.path(dir, paste0("file", 1:3)),
    etag = file.path(dir, paste0("etag", 1:3))
  )

  ## First file has no etag file
  unlink(downloads$etag[1], recursive = TRUE)
  ## Second has a different etag, so response must be 200
  cat("eeeetag\n", file = downloads$etag[2])
  ## Third has the same
  cat("foobar3\n", file = downloads$etag[3])
  cat("dummy\n", file = downloads$path[3])

  ret <- suppressMessages(synchronise(download_files(
    downloads,
    headers = c("accept-encoding" = "")
  )))

  expect_equal(file.exists(downloads$path), rep(TRUE, 3))
  expect_equal(file.exists(downloads$etag), rep(TRUE, 3))
  for (i in 1:2) {
    expect_equal(jsonlite::fromJSON(downloads$path[i])$url,
                 downloads$url[i])
    expect_equal(read_lines(downloads$etag[i]), paste0("foobar", i))
  }
  expect_equal(read_lines(downloads$path[3]), "dummy")

  expect_equal(ret[[1]]$response$status_code, 200)
  expect_equal(ret[[2]]$response$status_code, 200)
  expect_equal(ret[[3]]$response$status_code, 304)
})

test_that("download_files errors", {

  dir <- test_temp_dir()
  downloads <- data.frame(
    stringsAsFactors = FALSE,
    url  = http$url(paste0("/etag/foobar", 1:3)),
    path = "thesamepath",
    etag = file.path(dir, paste0("etag", 1:3))
  )

  expect_error(
    synchronise(download_files(downloads)),
    "Duplicate target paths")
})

test_that("download_files, no errors", {

  dir <- test_temp_dir()
  downloads <- data.frame(
    stringsAsFactors = FALSE,
    url  = http$url(paste0("/status/", 400 + 1:3)),
    path = file.path(dir, paste0("file", 1:3)),
    etag = file.path(dir, paste0("etag", 1:3))
  )

  ret <- suppressMessages(
    synchronise(download_files(downloads, error_on_status = FALSE))
  )
  expect_equal(length(ret), 3)
  expect_s3_class(ret[[1]], "async_rejected")
  expect_s3_class(ret[[1]], "async_http_401")
  expect_s3_class(ret[[1]], "async_http_error")

  expect_s3_class(ret[[2]], "async_rejected")
  expect_s3_class(ret[[2]], "async_http_402")
  expect_s3_class(ret[[2]], "async_http_error")

  expect_s3_class(ret[[3]], "async_rejected")
  expect_s3_class(ret[[3]], "async_http_403")
  expect_s3_class(ret[[3]], "async_http_error")
})

test_that("update_async_timeouts", {
  envs <- list(
    PKGCACHE_TIMEOUT = 200,
    PKGCACHE_CONNECTTIMEOUT = 200,
    PKGCACHE_LOW_SPEED_TIME = 200,
    PKGCACHE_LOW_SPEED_LIMIT = 200,
    PKGCACHE_HTTP_VERSION = 200
  )
  withr::local_envvar(envs)

  opts <- list(
    pkgcache_timeout = 100,
    pkgcache_connecttimeout = 100,
    pkgcache_low_speed_time = 100,
    pkgcache_low_speed_limit = 100,
    pkgcache_http_version = 100
  )
  withr::local_options(opts)

  arg <- list(
    timeout = 10,
    connecttimeout = 10,
    low_speed_time = 10,
    low_speed_limit = 10,
    http_version = 10
  )

  # arg takes precedence
  expect_equal(
    update_async_timeouts(arg),
    arg
  )

  # extra options in arg are kept
  arg2 <- utils::modifyList(arg, list(foo = "bar"))
  expect_equal(
    update_async_timeouts(arg2),
    arg2
  )

  # options are used next
  exp <- c(list(foo = "bar"), opts)
  names(exp) <- sub("^pkgcache_", "", names(exp))
  expect_equal(
    update_async_timeouts(list(foo = "bar")),
    exp
  )

  # env vars are used next
  withr::local_options(
    pkgcache_timeout = NULL,
    pkgcache_connecttimeout = NULL,
    pkgcache_low_speed_time = NULL,
    pkgcache_low_speed_limit = NULL,
    pkgcache_http_version = NULL
  )
  exp2 <- c(list(foo = "bar"), envs)
  names(exp2) <- sub("^pkgcache_", "", tolower(names(exp2)))
  expect_equal(
    update_async_timeouts(list(foo = "bar")),
    exp2
  )

  # finally, fall back to defaults
  withr::local_envvar(
    PKGCACHE_TIMEOUT = NA_character_,
    PKGCACHE_CONNECTTIMEOUT = NA_character_,
    PKGCACHE_LOW_SPEED_TIME = NA_character_,
    PKGCACHE_LOW_SPEED_LIMIT = NA_character_,
    PKGCACHE_HTTP_VERSION = NA_character_
  )
  exp3 <- list(
    foo = "bar",
    timeout = 0,
    connecttimeout = 300,
    low_speed_time = 0,
    low_speed_limit = 0,
    http_version = default_http_version()
  )
  expect_equal(
    update_async_timeouts(list(foo = "bar")),
    exp3
  )
})

test_that("default_http_version", {
  mockery::stub(default_http_version, "Sys.info", c(sysname = "Darwin"))
  expect_equal(default_http_version(), 2)
  mockery::stub(default_http_version, "Sys.info", c(sysname = "Linux"))
  expect_equal(default_http_version(), 2)
  mockery::stub(default_http_version, "Sys.info", c(sysname = "Windows"))
  expect_equal(default_http_version(), 0)
})