sdk/R/tests/testthat/test-HttpRequest.R

   1 # Copyright (C) The Arvados Authors. All rights reserved.
   2 #
   3 # SPDX-License-Identifier: Apache-2.0
   4
   5 context("Http Request")
   6
   7
   8 test_that("execute raises exception if http verb is not valid", {
   9
  10     http <- HttpRequest$new()
  11     expect_that(http$exec("FAKE VERB", "url"),
  12                throws_error("Http verb is not valid."))
  13 })
  14
  15 test_that("createQuery generates and encodes query portion of http", {
  16
  17     http <- HttpRequest$new()
  18     queryParams <- list()
  19     queryParams$filters <- list(list("color", "=", "red"))
  20     queryParams$limit <- 20
  21     queryParams$offset <- 50
  22     expect_that(http$createQuery(queryParams),
  23                 equals(paste0("/?filters=%5B%5B%22color%22%2C%22%3D%22%2C%22red",
  24                               "%22%5D%5D&limit=20&offset=50")))
  25 })
  26
  27 test_that("createQuery generates and empty string when queryParams is an empty list", {
  28
  29     http <- HttpRequest$new()
  30     expect_that(http$createQuery(list()), equals(""))
  31 })
  32
  33 test_that("exec calls httr functions correctly", {
  34     httrNamespace <- getNamespace("httr")
  35
  36     # Monkeypatch httr functions and assert that they are called later
  37     add_headersCalled <- FALSE
  38     unlockBinding("add_headers", httrNamespace)
  39     newAddHeaders <- function(h)
  40     {
  41         add_headersCalled <<- TRUE
  42         list()
  43     }
  44     httrNamespace$add_headers <- newAddHeaders
  45     lockBinding("add_headers", httrNamespace)
  46
  47     expectedConfig <- list()
  48     retryCalled <- FALSE
  49     unlockBinding("RETRY", httrNamespace)
  50     newRETRY <- function(verb, url, body, config, times)
  51     {
  52         retryCalled <<- TRUE
  53         expectedConfig <<- config
  54     }
  55     httrNamespace$RETRY <- newRETRY
  56     lockBinding("RETRY", httrNamespace)
  57
  58     Sys.setenv("ARVADOS_API_HOST_INSECURE" = TRUE)
  59     http <- HttpRequest$new()
  60     http$exec("GET", "url")
  61
  62     expect_that(add_headersCalled, is_true())
  63     expect_that(retryCalled, is_true())
  64     expect_that(expectedConfig$options, equals(list(ssl_verifypeer = 0L)))
  65 })
  66
  67 test_that("getConnection calls curl functions correctly", {
  68     curlNamespace <- getNamespace("curl")
  69
  70     # Monkeypatch curl functions and assert that they are called later
  71     curlCalled <- FALSE
  72     unlockBinding("curl", curlNamespace)
  73     newCurl <- function(url, open, handle) curlCalled <<- TRUE
  74     curlNamespace$curl <- newCurl
  75     lockBinding("curl", curlNamespace)
  76
  77     new_handleCalled <- FALSE
  78     unlockBinding("new_handle", curlNamespace)
  79     newHandleFun <- function()
  80     {
  81         new_handleCalled <<- TRUE
  82         list()
  83     }
  84     curlNamespace$new_handle <- newHandleFun
  85     lockBinding("new_handle", curlNamespace)
  86
  87     handle_setheadersCalled <- FALSE
  88     unlockBinding("handle_setheaders", curlNamespace)
  89     newHandleSetHeaders <- function(h, .list) handle_setheadersCalled <<- TRUE
  90     curlNamespace$handle_setheaders <- newHandleSetHeaders
  91     lockBinding("handle_setheaders", curlNamespace)
  92
  93     handle_setoptCalled <- FALSE
  94     unlockBinding("handle_setopt", curlNamespace)
  95     newHandleSetOpt <- function(h, ssl_verifypeer) handle_setoptCalled <<- TRUE
  96     curlNamespace$handle_setopt <- newHandleSetOpt
  97     lockBinding("handle_setopt", curlNamespace)
  98
  99
 100     Sys.setenv("ARVADOS_API_HOST_INSECURE" = TRUE)
 101     http <- HttpRequest$new()
 102     http$getConnection("location", list(), "r")
 103
 104     expect_that(new_handleCalled, is_true())
 105     expect_that(handle_setheadersCalled, is_true())
 106     expect_that(handle_setoptCalled, is_true())
 107     expect_that(curlCalled, is_true())
 108 })