add tests for exec and getConnection methods in HttpRequest class
authorFuad Muhic <fmuhic@capeannenterprises.com>
Wed, 18 Jul 2018 10:36:41 +0000 (12:36 +0200)
committerFuad Muhic <fmuhic@capeannenterprises.com>
Wed, 18 Jul 2018 10:36:41 +0000 (12:36 +0200)
Arvados-DCO-1.1-Signed-off-by: Fuad Muhic <fmuhic@capeannenterprises.com>

sdk/R/R/ArvadosFile.R
sdk/R/R/HttpRequest.R
sdk/R/R/RESTService.R
sdk/R/tests/testthat/fakes/FakeHttpRequest.R
sdk/R/tests/testthat/fakes/FakeRESTService.R
sdk/R/tests/testthat/test-HttpRequest.R
sdk/R/tests/testthat/test-RESTService.R

index 8f737831c4634cc09a3121a86e04dcbf0361946b..df323fbc48b2481a97f08160f34d9a8830de1ece 100644 (file)
@@ -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") 
index abbe5b7b44a9c0ff10594bb44f7847f2475809e5..d1100a2e5fe99ee5971d0c152a7103fe2b2b3391 100644 (file)
@@ -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)
         }
     ),
 
index 7048b159cc8099180c6f5c689cc8b51a5327c5b3..108aa1969f3b8754893ba0c565e17491ddd5b546 100644 (file)
@@ -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)
         }
     ),
 
index 2633abdf2c745bf0e4c9afcee1b73b7c5751fbeb..2ebcda2e4d671dc91cef9ca6ca0cdcb6a2707e18 100644 (file)
@@ -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
             }
 
index 08e8717de5e4b97b5776c2c6cc8893c523f4c133..048013f566a3c737188dc04f876bee6d9ae8dd90 100644 (file)
@@ -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
index 5ad8aa03115207035ee7f369ded5fbcd597e0ba7..f12463c805dda10e67325adb2a892d5223600932 100644 (file)
@@ -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())
+})
index 859b6180f3380c2d834b99e126aa0c7761155368..26f459b17355903640676b7d4a717bd2c9052890 100644 (file)
@@ -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))
+})