From fba33040ea730ccc30035557226fc1a1de32ba6e Mon Sep 17 00:00:00 2001 From: Fuad Muhic Date: Wed, 18 Jul 2018 12:36:41 +0200 Subject: [PATCH] add tests for exec and getConnection methods in HttpRequest class Arvados-DCO-1.1-Signed-off-by: Fuad Muhic --- sdk/R/R/ArvadosFile.R | 4 +- sdk/R/R/HttpRequest.R | 11 +++ sdk/R/R/RESTService.R | 12 +-- sdk/R/tests/testthat/fakes/FakeHttpRequest.R | 29 ++++-- sdk/R/tests/testthat/fakes/FakeRESTService.R | 4 +- sdk/R/tests/testthat/test-HttpRequest.R | 85 ++++++++++++++++- sdk/R/tests/testthat/test-RESTService.R | 99 +++++++++++--------- 7 files changed, 173 insertions(+), 71 deletions(-) diff --git a/sdk/R/R/ArvadosFile.R b/sdk/R/R/ArvadosFile.R index 8f737831c4..df323fbc48 100644 --- a/sdk/R/R/ArvadosFile.R +++ b/sdk/R/R/ArvadosFile.R @@ -144,8 +144,8 @@ ArvadosFile <- R6::R6Class( if (rw == "r" || rw == "rb") { REST <- private$collection$getRESTService() - return(REST$getConnection(private$collection$uuid, - self$getRelativePath(), + return(REST$getConnection(self$getRelativePath(), + private$collection$uuid, rw)) } else if (rw == "w") diff --git a/sdk/R/R/HttpRequest.R b/sdk/R/R/HttpRequest.R index abbe5b7b44..d1100a2e5f 100644 --- a/sdk/R/R/HttpRequest.R +++ b/sdk/R/R/HttpRequest.R @@ -58,6 +58,17 @@ HttpRequest <- R6::R6Class( } return("") + }, + + getConnection = function(url, headers, openMode) + { + h <- curl::new_handle() + curl::handle_setheaders(h, .list = headers) + + if(toString(Sys.getenv("ARVADOS_API_HOST_INSECURE") == "TRUE")) + curl::handle_setopt(h, ssl_verifypeer = 0L) + + conn <- curl::curl(url = url, open = openMode, handle = h) } ), diff --git a/sdk/R/R/RESTService.R b/sdk/R/R/RESTService.R index 7048b159cc..108aa1969f 100644 --- a/sdk/R/R/RESTService.R +++ b/sdk/R/R/RESTService.R @@ -186,21 +186,13 @@ RESTService <- R6::R6Class( self$httpParser$parseResponse(serverResponse, "text") }, - getConnection = function(uuid, relativePath, openMode) + getConnection = function(relativePath, uuid, openMode) { fileURL <- paste0(self$getWebDavHostName(), "c=", uuid, "/", relativePath); headers <- list(Authorization = paste("OAuth2", self$token)) - h <- curl::new_handle() - curl::handle_setheaders(h, .list = headers) - - if(toString(Sys.getenv("ARVADOS_API_HOST_INSECURE") == "TRUE")) - curl::handle_setopt(h, ssl_verifypeer = 0L) - - conn <- curl::curl(url = fileURL, open = openMode, handle = h) - - conn + conn <- self$http$getConnection(fileURL, headers, openMode) } ), diff --git a/sdk/R/tests/testthat/fakes/FakeHttpRequest.R b/sdk/R/tests/testthat/fakes/FakeHttpRequest.R index 2633abdf2c..2ebcda2e4d 100644 --- a/sdk/R/tests/testthat/fakes/FakeHttpRequest.R +++ b/sdk/R/tests/testthat/fakes/FakeHttpRequest.R @@ -22,11 +22,12 @@ FakeHttpRequest <- R6::R6Class( JSONEncodedBodyIsProvided = NULL, requestBodyIsProvided = NULL, - numberOfGETRequests = NULL, - numberOfDELETERequests = NULL, - numberOfPUTRequests = NULL, - numberOfPOSTRequests = NULL, - numberOfMOVERequests = NULL, + numberOfGETRequests = NULL, + numberOfDELETERequests = NULL, + numberOfPUTRequests = NULL, + numberOfPOSTRequests = NULL, + numberOfMOVERequests = NULL, + numberOfgetConnectionCalls = NULL, initialize = function(expectedURL = NULL, serverResponse = NULL, @@ -57,6 +58,8 @@ FakeHttpRequest <- R6::R6Class( self$numberOfPOSTRequests <- 0 self$numberOfMOVERequests <- 0 + self$numberOfgetConnectionCalls <- 0 + self$serverMaxElementsPerRequest <- 5 }, @@ -87,18 +90,24 @@ FakeHttpRequest <- R6::R6Class( return(private$getElements(offset, limit)) else return(self$content) + }, + + getConnection = function(url, headers, openMode) + { + self$numberOfgetConnectionCalls <- self$numberOfgetConnectionCalls + 1 + c(url, headers, openMode) } ), private = list( - validateURL = function(url) + validateURL = function(url) { if(!is.null(self$expectedURL) && url == self$expectedURL) self$URLIsProperlyConfigured <- TRUE }, - validateHeaders = function(headers) + validateHeaders = function(headers) { if(!is.null(headers$Authorization)) self$requestHeaderContainsAuthorizationField <- TRUE @@ -115,11 +124,11 @@ FakeHttpRequest <- R6::R6Class( validateBody = function(body) { - if(!is.null(body)) + if(!is.null(body)) { self$requestBodyIsProvided <- TRUE - if(class(body) == "json") + if(class(body) == "json") self$JSONEncodedBodyIsProvided <- TRUE } }, @@ -143,7 +152,7 @@ FakeHttpRequest <- R6::R6Class( { if(offset > self$content$items_available) stop("Invalid offset") - + start <- offset + 1 } diff --git a/sdk/R/tests/testthat/fakes/FakeRESTService.R b/sdk/R/tests/testthat/fakes/FakeRESTService.R index 08e8717de5..048013f566 100644 --- a/sdk/R/tests/testthat/fakes/FakeRESTService.R +++ b/sdk/R/tests/testthat/fakes/FakeRESTService.R @@ -153,14 +153,14 @@ FakeRESTService <- R6::R6Class( self$returnContent }, - write = function(uuid, relativePath, content, contentType) + write = function(relativePath, uuid, content, contentType) { self$writeBuffer <- content self$writeCallCount <- self$writeCallCount + 1 self$returnContent }, - getConnection = function(relativePath, uuid, openMode) + getConnection = function(uuid, relativePath, openMode) { self$getConnectionCallCount <- self$getConnectionCallCount + 1 self$returnContent diff --git a/sdk/R/tests/testthat/test-HttpRequest.R b/sdk/R/tests/testthat/test-HttpRequest.R index 5ad8aa0311..f12463c805 100644 --- a/sdk/R/tests/testthat/test-HttpRequest.R +++ b/sdk/R/tests/testthat/test-HttpRequest.R @@ -5,12 +5,12 @@ context("Http Request") -test_that("execyte raises exception if http verb is not valid", { +test_that("execute raises exception if http verb is not valid", { http <- HttpRequest$new() expect_that(http$exec("FAKE VERB", "url"), throws_error("Http verb is not valid.")) -}) +}) test_that("createQuery generates and encodes query portion of http", { @@ -22,10 +22,87 @@ test_that("createQuery generates and encodes query portion of http", { expect_that(http$createQuery(queryParams), equals(paste0("/?filters=%5B%5B%22color%22%2C%22%3D%22%2C%22red", "%22%5D%5D&limit=20&offset=50"))) -}) +}) test_that("createQuery generates and empty string when queryParams is an empty list", { http <- HttpRequest$new() expect_that(http$createQuery(list()), equals("")) -}) +}) + +test_that("exec calls httr functions correctly", { + httrNamespace <- getNamespace("httr") + + # Monkeypatch httr functions and assert that they are called later + add_headersCalled <- FALSE + unlockBinding("add_headers", httrNamespace) + newAddHeaders <- function(h) + { + add_headersCalled <<- TRUE + list() + } + httrNamespace$add_headers <- newAddHeaders + lockBinding("add_headers", httrNamespace) + + expectedConfig <- list() + retryCalled <- FALSE + unlockBinding("RETRY", httrNamespace) + newRETRY <- function(verb, url, body, config, times) + { + retryCalled <<- TRUE + expectedConfig <<- config + } + httrNamespace$RETRY <- newRETRY + lockBinding("RETRY", httrNamespace) + + Sys.setenv("ARVADOS_API_HOST_INSECURE" = TRUE) + http <- HttpRequest$new() + http$exec("GET", "url") + + expect_that(add_headersCalled, is_true()) + expect_that(retryCalled, is_true()) + expect_that(expectedConfig$options, equals(list(ssl_verifypeer = 0L))) +}) + +test_that("getConnection calls curl functions correctly", { + curlNamespace <- getNamespace("curl") + + # Monkeypatch curl functions and assert that they are called later + curlCalled <- FALSE + unlockBinding("curl", curlNamespace) + newCurl <- function(url, open, handle) curlCalled <<- TRUE + curlNamespace$curl <- newCurl + lockBinding("curl", curlNamespace) + + new_handleCalled <- FALSE + unlockBinding("new_handle", curlNamespace) + newHandleFun <- function() + { + new_handleCalled <<- TRUE + list() + } + curlNamespace$new_handle <- newHandleFun + lockBinding("new_handle", curlNamespace) + + handle_setheadersCalled <- FALSE + unlockBinding("handle_setheaders", curlNamespace) + newHandleSetHeaders <- function(h, .list) handle_setheadersCalled <<- TRUE + curlNamespace$handle_setheaders <- newHandleSetHeaders + lockBinding("handle_setheaders", curlNamespace) + + handle_setoptCalled <- FALSE + unlockBinding("handle_setopt", curlNamespace) + newHandleSetOpt <- function(h, ssl_verifypeer) handle_setoptCalled <<- TRUE + curlNamespace$handle_setopt <- newHandleSetOpt + lockBinding("handle_setopt", curlNamespace) + + + Sys.setenv("ARVADOS_API_HOST_INSECURE" = TRUE) + http <- HttpRequest$new() + http$getConnection("location", list(), "r") + + expect_that(new_handleCalled, is_true()) + expect_that(handle_setheadersCalled, is_true()) + expect_that(handle_setoptCalled, is_true()) + expect_that(curlCalled, is_true()) +}) diff --git a/sdk/R/tests/testthat/test-RESTService.R b/sdk/R/tests/testthat/test-RESTService.R index 859b6180f3..26f459b173 100644 --- a/sdk/R/tests/testthat/test-RESTService.R +++ b/sdk/R/tests/testthat/test-RESTService.R @@ -22,7 +22,7 @@ test_that("getWebDavHostName calls REST service properly", { expect_that(httpRequest$URLIsProperlyConfigured, is_true()) expect_that(httpRequest$requestHeaderContainsAuthorizationField, is_true()) expect_that(httpRequest$numberOfGETRequests, equals(1)) -}) +}) test_that("getWebDavHostName returns webDAV host name properly", { @@ -32,8 +32,8 @@ test_that("getWebDavHostName returns webDAV host name properly", { REST <- RESTService$new("token", "host", httpRequest, FakeHttpParser$new()) - expect_that("https://myWebDavServer.com", equals(REST$getWebDavHostName())) -}) + expect_that("https://myWebDavServer.com", equals(REST$getWebDavHostName())) +}) test_that("create calls REST service properly", { @@ -51,7 +51,7 @@ test_that("create calls REST service properly", { expect_that(fakeHttp$URLIsProperlyConfigured, is_true()) expect_that(fakeHttp$requestHeaderContainsAuthorizationField, is_true()) expect_that(fakeHttp$numberOfPUTRequests, equals(1)) -}) +}) test_that("create raises exception if server response code is not between 200 and 300", { @@ -60,13 +60,13 @@ test_that("create raises exception if server response code is not between 200 an response$status_code <- 404 fakeHttp <- FakeHttpRequest$new(serverResponse = response) - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", fakeHttp, HttpParser$new(), 0, "https://webDavHost/") expect_that(REST$create("file", uuid), throws_error("Server code: 404")) -}) +}) test_that("delete calls REST service properly", { @@ -75,7 +75,7 @@ test_that("delete calls REST service properly", { fakeHttp <- FakeHttpRequest$new(expectedURL) fakeHttpParser <- FakeHttpParser$new() - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", fakeHttp, fakeHttpParser, 0, "https://webDavHost/") @@ -84,7 +84,7 @@ test_that("delete calls REST service properly", { expect_that(fakeHttp$URLIsProperlyConfigured, is_true()) expect_that(fakeHttp$requestHeaderContainsAuthorizationField, is_true()) expect_that(fakeHttp$numberOfDELETERequests, equals(1)) -}) +}) test_that("delete raises exception if server response code is not between 200 and 300", { @@ -99,7 +99,7 @@ test_that("delete raises exception if server response code is not between 200 an expect_that(REST$delete("file", uuid), throws_error("Server code: 404")) -}) +}) test_that("move calls REST service properly", { @@ -108,7 +108,7 @@ test_that("move calls REST service properly", { fakeHttp <- FakeHttpRequest$new(expectedURL) fakeHttpParser <- FakeHttpParser$new() - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", fakeHttp, fakeHttpParser, 0, "https://webDavHost/") @@ -118,7 +118,7 @@ test_that("move calls REST service properly", { expect_that(fakeHttp$requestHeaderContainsAuthorizationField, is_true()) expect_that(fakeHttp$requestHeaderContainsDestinationField, is_true()) expect_that(fakeHttp$numberOfMOVERequests, equals(1)) -}) +}) test_that("move raises exception if server response code is not between 200 and 300", { @@ -127,13 +127,13 @@ test_that("move raises exception if server response code is not between 200 and response$status_code <- 404 fakeHttp <- FakeHttpRequest$new(serverResponse = response) - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", fakeHttp, HttpParser$new(), 0, "https://webDavHost/") expect_that(REST$move("file", "newDestination/file", uuid), throws_error("Server code: 404")) -}) +}) test_that("getCollectionContent retreives correct content from WebDAV server", { @@ -145,7 +145,7 @@ test_that("getCollectionContent retreives correct content from WebDAV server", { fakeHttp <- FakeHttpRequest$new(expectedURL, returnContent) - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", fakeHttp, FakeHttpParser$new(), 0, "https://webDavHost/") @@ -155,7 +155,7 @@ test_that("getCollectionContent retreives correct content from WebDAV server", { expect_that(returnedContentMatchExpected, is_true()) expect_that(fakeHttp$requestHeaderContainsAuthorizationField, is_true()) -}) +}) test_that("getCollectionContent raises exception if server returns empty response", { @@ -163,26 +163,26 @@ test_that("getCollectionContent raises exception if server returns empty respons response <- "" fakeHttp <- FakeHttpRequest$new(serverResponse = response) - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", fakeHttp, FakeHttpParser$new(), 0, "https://webDavHost/") expect_that(REST$getCollectionContent(uuid), throws_error("Response is empty, request may be misconfigured")) -}) +}) test_that("getCollectionContent parses server response", { uuid <- "aaaaa-j7d0g-ccccccccccccccc" fakeHttpParser <- FakeHttpParser$new() - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", FakeHttpRequest$new(), fakeHttpParser, 0, "https://webDavHost/") REST$getCollectionContent(uuid) expect_that(fakeHttpParser$parserCallCount, equals(1)) -}) +}) test_that("getCollectionContent raises exception if server returns empty response", { @@ -190,13 +190,13 @@ test_that("getCollectionContent raises exception if server returns empty respons response <- "" fakeHttp <- FakeHttpRequest$new(serverResponse = response) - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", fakeHttp, FakeHttpParser$new(), 0, "https://webDavHost/") expect_that(REST$getCollectionContent(uuid), throws_error("Response is empty, request may be misconfigured")) -}) +}) test_that(paste("getCollectionContent raises exception if server", "response code is not between 200 and 300"), { @@ -206,13 +206,13 @@ test_that(paste("getCollectionContent raises exception if server", response$status_code <- 404 fakeHttp <- FakeHttpRequest$new(serverResponse = response) - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", fakeHttp, HttpParser$new(), 0, "https://webDavHost/") expect_that(REST$getCollectionContent(uuid), throws_error("Server code: 404")) -}) +}) test_that("getResourceSize calls REST service properly", { @@ -235,7 +235,7 @@ test_that("getResourceSize calls REST service properly", { expect_that(fakeHttp$URLIsProperlyConfigured, is_true()) expect_that(fakeHttp$requestHeaderContainsAuthorizationField, is_true()) expect_that(returnedContentMatchExpected, is_true()) -}) +}) test_that("getResourceSize raises exception if server returns empty response", { @@ -243,13 +243,13 @@ test_that("getResourceSize raises exception if server returns empty response", { response <- "" fakeHttp <- FakeHttpRequest$new(serverResponse = response) - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", fakeHttp, FakeHttpParser$new(), 0, "https://webDavHost/") expect_that(REST$getResourceSize("file", uuid), throws_error("Response is empty, request may be misconfigured")) -}) +}) test_that(paste("getResourceSize raises exception if server", "response code is not between 200 and 300"), { @@ -259,26 +259,26 @@ test_that(paste("getResourceSize raises exception if server", response$status_code <- 404 fakeHttp <- FakeHttpRequest$new(serverResponse = response) - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", fakeHttp, HttpParser$new(), 0, "https://webDavHost/") expect_that(REST$getResourceSize("file", uuid), throws_error("Server code: 404")) -}) +}) test_that("getResourceSize parses server response", { uuid <- "aaaaa-j7d0g-ccccccccccccccc" fakeHttpParser <- FakeHttpParser$new() - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", FakeHttpRequest$new(), fakeHttpParser, 0, "https://webDavHost/") REST$getResourceSize("file", uuid) expect_that(fakeHttpParser$parserCallCount, equals(1)) -}) +}) test_that("read calls REST service properly", { @@ -290,7 +290,7 @@ test_that("read calls REST service properly", { fakeHttp <- FakeHttpRequest$new(expectedURL, serverResponse) - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", fakeHttp, FakeHttpParser$new(), 0, "https://webDavHost/") @@ -300,7 +300,7 @@ test_that("read calls REST service properly", { expect_that(fakeHttp$requestHeaderContainsAuthorizationField, is_true()) expect_that(fakeHttp$requestHeaderContainsRangeField, is_true()) expect_that(returnResult, equals("file content")) -}) +}) test_that("read raises exception if server response code is not between 200 and 300", { @@ -309,48 +309,48 @@ test_that("read raises exception if server response code is not between 200 and response$status_code <- 404 fakeHttp <- FakeHttpRequest$new(serverResponse = response) - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", fakeHttp, HttpParser$new(), 0, "https://webDavHost/") expect_that(REST$read("file", uuid), throws_error("Server code: 404")) -}) +}) test_that("read raises exception if contentType is not valid", { uuid <- "aaaaa-j7d0g-ccccccccccccccc" fakeHttp <- FakeHttpRequest$new() - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", fakeHttp, HttpParser$new(), 0, "https://webDavHost/") expect_that(REST$read("file", uuid, "some invalid content type"), throws_error("Invalid contentType. Please use text or raw.")) -}) +}) test_that("read parses server response", { uuid <- "aaaaa-j7d0g-ccccccccccccccc" fakeHttpParser <- FakeHttpParser$new() - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", FakeHttpRequest$new(), fakeHttpParser, 0, "https://webDavHost/") REST$read("file", uuid, "text", 1024, 512) expect_that(fakeHttpParser$parserCallCount, equals(1)) -}) +}) test_that("write calls REST service properly", { - fileContent <- "new file content" + fileContent <- "new file content" uuid <- "aaaaa-j7d0g-ccccccccccccccc" expectedURL <- "https://webDavHost/c=aaaaa-j7d0g-ccccccccccccccc/file" fakeHttp <- FakeHttpRequest$new(expectedURL) - REST <- RESTService$new("token", "https://host/", + REST <- RESTService$new("token", "https://host/", fakeHttp, FakeHttpParser$new(), 0, "https://webDavHost/") @@ -360,12 +360,12 @@ test_that("write calls REST service properly", { expect_that(fakeHttp$requestBodyIsProvided, is_true()) expect_that(fakeHttp$requestHeaderContainsAuthorizationField, is_true()) expect_that(fakeHttp$requestHeaderContainsContentTypeField, is_true()) -}) +}) test_that("write raises exception if server response code is not between 200 and 300", { uuid <- "aaaaa-j7d0g-ccccccccccccccc" - fileContent <- "new file content" + fileContent <- "new file content" response <- list() response$status_code <- 404 fakeHttp <- FakeHttpRequest$new(serverResponse = response) @@ -376,4 +376,17 @@ test_that("write raises exception if server response code is not between 200 and expect_that(REST$write("file", uuid, fileContent, "text/html"), throws_error("Server code: 404")) -}) +}) + +test_that("getConnection calls REST service properly", { + uuid <- "aaaaa-j7d0g-ccccccccccccccc" + fakeHttp <- FakeHttpRequest$new() + + REST <- RESTService$new("token", "https://host/", + fakeHttp, FakeHttpParser$new(), + 0, "https://webDavHost/") + + REST$getConnection("file", uuid, "r") + + expect_that(fakeHttp$numberOfgetConnectionCalls, equals(1)) +}) -- 2.30.2