test-request_handler-crul.R
In vcr: Record 'HTTP' Calls to Disk

test_that("crul POST requests works", {
  withr::local_options(warnPartialMatchDollar = FALSE)
  local_vcr_configure(dir = withr::local_tempdir())

  # body type: named list
  use_cassette("crul_post_named_list", {
    x <- crul::HttpClient$new(hb("/post"))$post(body = list(foo = "bar"))
  })
  expect_s3_class(x, "HttpResponse")
  expect_equal(x$status_code, 200)
  strj <- jsonlite::fromJSON(vcr_last_response()$body$string)
  expect_equal(strj$form, list(foo = "bar"))

  # body type: character
  use_cassette("crul_post_string", {
    z <- crul::HttpClient$new(hb("/post"))$post(body = "some string")
  })
  expect_s3_class(z, "HttpResponse")
  expect_equal(z$status_code, 200)
  strj <- jsonlite::fromJSON(vcr_last_response()$body$string)
  # FIXME: the body should be found in data slot, fix in crul
  expect_named(strj$form, "some string")

  # body type: raw
  use_cassette("crul_post_raw", {
    z <- crul::HttpClient$new(hb("/post"))$post(body = charToRaw("some string"))
  })
  expect_s3_class(z, "HttpResponse")
  expect_equal(z$status_code, 200)
  strj <- jsonlite::fromJSON(vcr_last_response()$body$string)
  # FIXME: the body should be found in data slot, fix in crul
  expect_named(strj$form, "some string")

  # body type: upload_file
  ## upload_file in a list
  ff <- withr::local_tempfile(fileext = ".txt")
  cat("hello world\n", file = ff)
  use_cassette("crul_post_upload_file", {
    b <- crul::HttpClient$new(hb("/post"))$post(
      body = list(y = crul::upload(ff))
    )
  })
  expect_s3_class(b, "HttpResponse")
  expect_equal(b$status_code, 200)
  strj <- jsonlite::fromJSON(vcr_last_response()$body$string)
  expect_equal(strj$files$y$filename, basename(ff)) # files not empty

  ## upload_file not in a list
  use_cassette("crul_post_upload_file_no_list", {
    d <- crul::HttpClient$new(hb("/post"))$post(
      body = crul::upload(system.file("CITATION"))
    )
  })
  expect_s3_class(d, "HttpResponse")
  expect_equal(d$status_code, 200)
  strj <- jsonlite::fromJSON(vcr_last_response()$body$string)
  expect_equal(length(strj$files), 0) # files empty
  expect_match(strj$data, "bibentry\\(") # data not empty

  # body type: NULL
  use_cassette("crul_post_null", {
    m <- crul::HttpClient$new(hb("/post"))$post(body = NULL)
  })
  expect_s3_class(z, "HttpResponse")
  expect_equal(z$status_code, 200)
  strj <- jsonlite::fromJSON(vcr_last_response()$body$string)
  expect_equal(strj$headers$`Content-Length`, "0")
})

test_that("JSON-encoded body", {
  local_vcr_configure(dir = withr::local_tempdir())

  cli <- crul::HttpClient$new(url = hb())

  ### matchers: method, uri, body
  # run it
  aa <- use_cassette(
    "testing1",
    res <- cli$post("post", body = list(foo = "bar"), encode = "json"),
    match_requests_on = c("method", "uri", "body")
  )
  # run it again
  bb <- use_cassette(
    "testing1",
    res <- cli$post("post", body = list(foo = "bar"), encode = "json"),
    match_requests_on = c("method", "uri", "body")
  )
  # the recorded_at time doesn't change
  # - that is, the request matched and the recorded response in aa
  # - was used
  expect_identical(recorded_at(aa), recorded_at(bb))
  expect_s3_class(aa, "Cassette")
  expect_type(aa$name, "character")
  expect_equal(aa$name, "testing1")
  expect_equal(aa$match_requests_on, c("method", "uri", "body"))

  # matching fails when comparing multipart- and json-encoded bodies
  expect_error(
    # fails when comparing multipart- and json-encoded bodies
    use_cassette(
      "testing1",
      cli$post("post", body = list(foo = "bar")),
      match_requests_on = c("method", "uri", "body")
    ),
    class = "vcr_unhandled"
  )

  # matching fails when the body changes
  expect_error(
    use_cassette(
      "testing1",
      res <- cli$post("post", body = list(foo = "baz"), encode = "json"),
      match_requests_on = "body"
    ),
    class = "vcr_unhandled"
  )

  # matching succeeds when the changed body is ignored
  cc <- use_cassette(
    "testing1",
    res <- cli$post("post", body = list(foo = "baz"), encode = "json"),
    match_requests_on = c("uri", "method")
  )
  expect_identical(recorded_at(aa), recorded_at(cc))
})


test_that("can write files to disk", {
  write_path <- withr::local_tempdir()
  local_vcr_configure(
    dir = withr::local_tempdir(),
    write_disk_path = write_path
  )
  path <- file.path(withr::local_tempdir(), "test.png")
  download_image <- \() {
    crul::HttpClient$new(
      url = hb("/image"),
      headers = list(Accept = "image/png")
    )$get(disk = path)
  }

  # Both requests use vcr path
  use_cassette("test3", out <- download_image())
  expect_equal(out$content, file.path(write_path, "test.png"))

  use_cassette("test3", out2 <- download_image())
  expect_equal(out2$content, file.path(write_path, "test.png"))

  # Content is the same
  expect_equal(out$parse(), out2$parse())
})

test_that("match_requests_on - body works", {
  local_vcr_configure(dir = withr::local_tempdir())
  cli <- crul::HttpClient$new(url = hb())

  ### matchers: method, uri, body
  # run it
  aa <- use_cassette(
    "testing1",
    res <- cli$post("post", body = list(foo = "bar")),
    match_requests_on = c("method", "uri", "body")
  )
  # run it again
  bb <- use_cassette(
    "testing1",
    res <- cli$post("post", body = list(foo = "bar")),
    match_requests_on = c("method", "uri", "body")
  )
  # the recorded_at time doesn't change
  # - that is, the request matched and the recorded response in aa
  # - was used
  expect_identical(recorded_at(aa), recorded_at(bb))
  expect_s3_class(aa, "Cassette")
  expect_type(aa$name, "character")
  expect_equal(aa$name, "testing1")
  expect_equal(aa$match_requests_on, c("method", "uri", "body"))

  ### matchers: method, body (uri ignored essentially)
  # run it
  aa <- use_cassette(
    "testing2",
    res <- cli$post("post", query = list(a = 5), body = list(foo = "bar")),
    match_requests_on = c("method", "body")
  )
  # run it again
  bb <- use_cassette(
    "testing2",
    res <- cli$post("post", query = list(b = 2), body = list(foo = "bar")),
    match_requests_on = c("method", "body")
  )
  # the recorded_at time doesn't change
  # - that is, the request matched and the recorded response in aa
  # - was used
  expect_identical(recorded_at(aa), recorded_at(bb))
  expect_s3_class(aa, "Cassette")
  expect_type(aa$name, "character")
  expect_equal(aa$name, "testing2")
  expect_equal(aa$match_requests_on, c("method", "body"))

  ### matchers: body only
  # run it
  # FIXME: still not quite working
  cli2 <- crul::HttpClient$new(url = "https://stuff.com")
  aa <- use_cassette(
    "testing3",
    res <- cli$put("put", body = list(foo = "bar")),
    match_requests_on = "body"
  )
  # run it again, method and uri changed
  bb <- use_cassette(
    "testing3",
    res2 <- cli$post("post", body = list(foo = "bar")),
    match_requests_on = "body"
  )
  # the recorded_at time doesn't change
  # - that is, the request matched and the recorded response in aa
  # - was used
  expect_identical(recorded_at(aa), recorded_at(bb))
  expect_s3_class(aa, "Cassette")
  expect_type(aa$name, "character")
  expect_equal(aa$name, "testing3")
  expect_equal(aa$match_requests_on, "body")

  ### matchers: host only (note how query is ignored)
  # run it
  aa <- use_cassette(
    "testing_host1",
    res <- crul::HttpClient$new(url = hb())$get(query = list(b = 99999)),
    match_requests_on = "host"
  )
  # run it again
  bb <- use_cassette(
    "testing_host1",
    res2 <- crul::HttpClient$new(url = hb())$get(query = list(a = 5)),
    match_requests_on = "host"
  )
  # the recorded_at time doesn't change
  # - that is, the request matched and the recorded response in aa
  # - was used
  expect_identical(recorded_at(aa), recorded_at(bb))
  expect_s3_class(aa, "Cassette")
  expect_type(aa$name, "character")
  expect_equal(aa$name, "testing_host1")
  expect_equal(aa$match_requests_on, "host")

  ### matchers: path only (note how host and query differences are ignored)
  # run it
  aa <- use_cassette(
    "testing_path1",
    res <- crul::HttpClient$new("https://scottchamberlain.info")$get(
      "about",
      query = list(b = 99999)
    ),
    match_requests_on = "path"
  )
  # run it again
  bb <- use_cassette(
    "testing_path1",
    res2 <- crul::HttpClient$new("https://ropensci.org")$get(
      "about",
      query = list(a = 5)
    ),
    match_requests_on = "path"
  )
  # the recorded_at time doesn't change
  # - that is, the request matched and the recorded response in aa
  # - was used
  expect_identical(recorded_at(aa), recorded_at(bb))
  expect_s3_class(aa, "Cassette")
  expect_type(aa$name, "character")
  expect_equal(aa$name, "testing_path1")
  expect_equal(aa$match_requests_on, "path")

  ### matchers: host and path only (notice how HTTP method and query are ignored)
  # run it
  aa <- use_cassette(
    "testing_host_path",
    res <- crul::HttpClient$new(url = "https://ropensci.org")$get(
      "about",
      query = list(b = 99999)
    ),
    match_requests_on = c("host", "path")
  )
  # run it again
  bb <- use_cassette(
    "testing_host_path",
    res2 <- crul::HttpClient$new(url = "https://ropensci.org")$post(
      "about",
      query = list(a = 5)
    ),
    match_requests_on = c("host", "path")
  )
  # the recorded_at time doesn't change
  # - that is, the request matched and the recorded response in aa
  # - was used
  expect_identical(recorded_at(aa), recorded_at(bb))
  expect_s3_class(aa, "Cassette")
  expect_type(aa$name, "character")
  expect_equal(aa$name, "testing_host_path")
  expect_equal(aa$match_requests_on, c("host", "path"))
})