1
2context("http")
3
4test_that("GET", {
5  do <- async(function() {
6    http_get(http$url("/get", query = list(q = 42)))$
7      then(~ rawToChar(.$content))$
8      then(~ expect_match(., "\"q\":[ ]*\"42\""))
9  })
10  synchronise(do())
11})
12
13test_that("HEAD", {
14  do <- async(function() {
15    http_head(http$url("/"))$
16      then(function(value) {
17        expect_equal(value$status_code, 200)
18      })
19  })
20  synchronise(do())
21})
22
23test_that("headers", {
24  xx <- NULL
25  do <- async(function() {
26    headers = c("X-Header-Test" = "foobar", "X-Another" = "boooyakasha")
27    http_get(http$url("/headers"), headers = headers)$
28      then(~ jsonlite::fromJSON(rawToChar(.$content), simplifyVector = FALSE))$
29      then(function(x) xx <<- x)
30  })
31  synchronise(do())
32  expect_equal(xx$headers$`X-Header-Test`, "foobar")
33  expect_equal(xx$headers$`X-Another`, "boooyakasha")
34})
35
36test_that("304 is not an error", {
37  do <- async(function() {
38    http_get(http$url("/status/304"))$
39      then(http_stop_for_status)
40  })
41  expect_silent(synchronise(do()))
42})
43
44test_that("http progress bars", {
45  xx <- NULL
46  totalx <- NULL
47  currentx <- 0
48  tmp <- tempfile()
49
50  do <- async(function() {
51    on.exit(unlink(tmp, recursive = TRUE), add = TRUE)
52    http_get(
53      http$url("/image/jpeg"),
54      file = tmp <<- tempfile(),
55      on_progress = function(data) {
56        if (!is.null(data$total)) totalx <<- data$total
57        if (!is.null(data$current)) currentx <<- data$current
58      }
59    )$then(function(x) xx <<- x)
60  })
61
62  synchronise(do())
63
64  expect_equal(xx$status_code, 200)
65  expect_true(file.exists(tmp))
66  expect_equal(file.info(tmp)$size, currentx)
67  expect_equal(totalx, currentx)
68})
69
70test_that("http progress bar, remove callback", {
71  xx <- NULL
72  totalx <- NULL
73  currentx <- 0
74  tmp <- tempfile()
75  on.exit(unlink(tmp, recursive = TRUE), add = TRUE)
76
77  do <- async(function() {
78    progress_callback <- function(data) {
79      if (!is.null(data$total)) totalx <<- data$total
80      if (!is.null(data$current)) currentx <<- data$current
81    }
82    hx <- http_get(
83      http$url("/image/jpeg"),
84      file = tmp <<- tempfile(),
85      on_progress = progress_callback)
86
87    rm(progress_callback)
88    gc(); gc()
89
90    hx$then(function(x) xx <<- x)
91  })
92
93  synchronise(do())
94
95  expect_equal(xx$status_code, 200)
96  expect_true(file.exists(tmp))
97  expect_equal(file.info(tmp)$size, currentx)
98  expect_equal(totalx, currentx)
99})
100
101test_that("http progress bars & etags", {
102  xx <- NULL
103  totalx <- NULL
104  currentx <- NULL
105  statusx <- NULL
106  tmp <- tempfile()
107
108  do <- async(function() {
109    on.exit(unlink(tmp, recursive = TRUE), add = TRUE)
110    http_get(
111      http$url("/etag/etag"),
112      file = tmp,
113      headers = c("If-None-Match" = "etag"),
114      on_progress = function(data) {
115        if (!is.null(data$total)) totalx <<- data$total
116        currentx <<- c(currentx, data$current)
117        statusx <<- curl::handle_data(data$handle)$status_code
118      }
119    )$then(function(x) xx <<- x)
120  })
121  synchronise(do())
122  expect_equal(xx$status_code, 304)
123  expect_equal(statusx, 304)
124  expect_equal(length(xx[["content"]]), 0)
125  expect_true(file.exists(tmp))
126  expect_equal(file.info(tmp)$size, 0)
127})
128
129test_that("progress bar for in-memory data", {
130  u1 <- http$url("/stream-bytes/2048", c(chunk_size=1024))
131
132  called <- 0L
133  bytes <- 0L
134  do <- async(function() {
135    http_get(
136      u1, options = list(buffersize = 1100),
137      on_progress = function(data) {
138        called <<- called + 1L
139        if (length(data$current)) bytes <<- data$current
140      }
141    )
142  })
143
144  ret <- synchronise(do())
145  expect_true(called >= 2)
146  ## Skip this for now, curl 3.2 seems to be misreporting it
147  ## expect_equal(bytes, 2048)
148  expect_equal(length(ret$content), 2048)
149})
150
151test_that("error, invalid arg", {
152
153  do <- function() {
154    dx <- http_get(12123)
155  }
156
157  err <- tryCatch(synchronise(do()), error = identity)
158  expect_s3_class(err, "async_rejected")
159})
160
161test_that("automatic cancellation", {
162  called <- 0L
163  do <- function() {
164    r1 <- http_get(http$url("/delay/5"))$
165      then(function() called <<- called + 1L)
166    r2 <- http_get(http$url("/get"))$
167      then(function() called <<- called + 1L)
168    when_any(r1, r2)
169  }
170
171  tic <- Sys.time()
172  synchronise(do())
173  toc <- Sys.time()
174
175  expect_equal(called, 1L)
176  expect_true(toc - tic < as.difftime(4, units = "secs"))
177})
178
179test_that("http_status",  {
180  expect_error(
181    http_status(0),
182    "Unknown http status code"
183  )
184})
185
186test_that("timeout, failed request", {
187  do <- function() {
188    http_get(http$url("/delay/5"), options = list(timeout = 1))
189  }
190
191  tic <- Sys.time()
192  err <- tryCatch(synchronise(do()), error = identity)
193  toc <- Sys.time()
194
195  expect_s3_class(err, "async_rejected")
196  expect_match(conditionMessage(err), "timed out")
197  expect_true(toc - tic < as.difftime(4, units = "secs"))
198
199  do2 <- function() {
200    do()$catch(error = ~ "fixed")
201  }
202
203  tic <- Sys.time()
204  res <- synchronise(do2())
205  toc <- Sys.time()
206
207  expect_equal(res, "fixed")
208  expect_true(toc - tic < as.difftime(4, units = "secs"))
209})
210
211test_that("more sophisticated timeouts", {
212  do <- function() {
213    withr::local_options(list(
214      async_http_timeout = 6,
215      async_http_low_speed_time = 2,
216      async_http_low_speed_limit = 10
217    ))
218    http_get(http$url(
219      "/drip",
220      c(duration = 5, numbytes = 10, code = 200, delay = 0)
221    ))
222  }
223
224  tic <- Sys.time()
225  err <- tryCatch(synchronise(do()), error = identity)
226  toc <- Sys.time()
227
228  expect_s3_class(err, "async_rejected")
229  expect_match(conditionMessage(err), "too slow")
230  expect_true(toc - tic < as.difftime(5, units = "secs"))
231})
232
233test_that("errors contain the response", {
234  do <- function() {
235    http_get(http$url("/status/418"))$
236      then(http_stop_for_status)
237  }
238
239  err <- tryCatch(synchronise(do()), error = identity)
240  expect_s3_class(err, "async_rejected")
241  expect_s3_class(err, "async_http_418")
242  expect_match(rawToChar(err$response$content), "teapot")
243})
244
245test_that("errors contain the response if 'file' arg given", {
246  tmp <- tempfile()
247  do <- function() {
248    http_get(http$url("/status/418"), file = tmp)$
249      then(http_stop_for_status)
250  }
251
252  err <- tryCatch(synchronise(do()), error = identity)
253  expect_s3_class(err, "async_rejected")
254  expect_s3_class(err, "async_http_418")
255  expect_true(any(grepl("teapot", readLines(tmp))))
256})
257
258test_that("http_post", {
259  resp <- NULL
260  obj <- list(baz = 100, foo = "bar")
261  data <- jsonlite::toJSON(obj)
262
263  do <- function() {
264    headers <- c("content-type" = "application/json")
265    http_post(http$url("/post"), data = data, headers = headers)$
266      then(http_stop_for_status)$
267      then(function(x) resp <<- x)
268  }
269
270  synchronise(do())
271  expect_equal(resp$status_code, 200)
272  cnt <- jsonlite::fromJSON(rawToChar(resp$content), simplifyVector = TRUE)
273  expect_equal(cnt$json, obj)
274})
275