REST <- private$collection$getRESTService()
- REST$read(private$collection$uuid,
- self$getRelativePath(),
- contentType, offset, length)
+ fileContent <- REST$read(self$getRelativePath(),
+ private$collection$uuid,
+ contentType, offset, length)
+ fileContent
},
connection = function(rw)
REST <- private$collection$getRESTService()
- result <- REST$write(private$collection$uuid,
- self$getRelativePath(),
- content, contentType)
+ writeResult <- REST$write(self$getRelativePath(),
+ private$collection$uuid,
+ content, contentType)
+ writeResult
},
move = function(newLocationInCollection)
"HttrParser",
public = list(
+
+ validContentTypes = NULL,
+
initialize = function()
{
+ self$validContentTypes <- c("text", "raw")
},
parseJSONResponse = function(serverResponse)
type = "application/json")
},
- parseWebDAVResponse = function(response, uri)
+ parseResponse = function(serverResponse, outputType)
+ {
+ parsed_response <- httr::content(serverResponse, as = outputType)
+ },
+
+ getFileNamesFromResponse = function(response, uri)
{
text <- rawToChar(response$content)
doc <- XML::xmlParse(text, asText=TRUE)
})
)
result <- result[result != ""]
- result
+ result[-1]
},
- extractFileSizeFromWebDAVResponse = function(response, uri)
+ getFileSizesFromResponse = function(response, uri)
{
text <- rawToChar(response$content)
doc <- XML::xmlParse(text, asText=TRUE)
getCollectionContent = function(uuid)
{
- collectionURL <- URLencode(paste0(private$api$getWebDavHostName(), "c=", uuid))
+ collectionURL <- URLencode(paste0(private$api$getWebDavHostName(),
+ "c=", uuid))
headers <- list("Authorization" = paste("OAuth2", private$api$getToken()))
response <- private$http$PROPFIND(collectionURL, headers)
if(all(response == ""))
- stop("Response is empty, reques may be misconfigured")
+ stop("Response is empty, request may be misconfigured")
- parsedResponse <- private$httpParser$parseWebDAVResponse(response, collectionURL)
- parsedResponse[-1]
+ private$httpParser$getFileNamesFromResponse(response, collectionURL)
},
getResourceSize = function(relativePath, uuid)
headers <- list("Authorization" = paste("OAuth2",
private$api$getToken()))
- propfindResponse <- private$http$PROPFIND(subcollectionURL, headers)
+ response <- private$http$PROPFIND(subcollectionURL, headers)
+
+ if(all(response == ""))
+ stop("Response is empty, request may be misconfigured")
- sizes <- private$httpParser$extractFileSizeFromWebDAVResponse(propfindResponse,
- collectionURL)
+ sizes <- private$httpParser$getFileSizesFromResponse(response,
+ collectionURL)
as.numeric(sizes)
},
- read = function(uuid, relativePath, contentType = "raw", offset = 0, length = 0)
+ read = function(relativePath, uuid, contentType = "raw", offset = 0, length = 0)
{
fileURL <- paste0(private$api$getWebDavHostName(),
"c=", uuid, "/", relativePath);
Range = range)
}
- if(!(contentType %in% private$http$validContentTypes))
+ if(!(contentType %in% private$httpParser$validContentTypes))
stop("Invalid contentType. Please use text or raw.")
serverResponse <- private$http$GET(fileURL, headers)
if(serverResponse$status_code < 200 || serverResponse$status_code >= 300)
stop(paste("Server code:", serverResponse$status_code))
- #todo remove all references to httr from here
- parsedServerResponse <- httr::content(serverResponse, contentType)
- parsedServerResponse
+ private$httpParser$parseResponse(serverResponse, contentType)
},
- write = function(uuid, relativePath, content, contentType)
+ write = function(relativePath, uuid, content, contentType)
{
fileURL <- paste0(private$api$getWebDavHostName(),
"c=", uuid, "/", relativePath);
if(serverResponse$status_code < 200 || serverResponse$status_code >= 300)
stop(paste("Server code:", serverResponse$status_code))
- parsedServerResponse <- httr::content(serverResponse, "text")
- parsedServerResponse
+ private$httpParser$parseResponse(serverResponse, "text")
}
),
#Delete file from a collection
-file <- collection$get("location/to/my/file.cpp")
-
-collection$remove(file)
-
-#Or
-
collection$remove("location/to/my/file.cpp")
-#Both examples will remove file "file.cpp" from a collection
#You can remove both Subcollection and ArvadosFile
#If subcollection contains more files or folders they will be removed recursively.
FakeHttpParser <- R6::R6Class(
- "HttrParser",
+ "FakeHttrParser",
public = list(
+ validContentTypes = NULL,
parserCallCount = NULL,
initialize = function()
{
self$parserCallCount <- 0
+ self$validContentTypes <- c("text", "raw")
},
parseJSONResponse = function(serverResponse)
{
self$parserCallCount <- self$parserCallCount + 1
+
+ if(!is.null(serverResponse$content))
+ return(serverResponse$content)
+
serverResponse
},
- parseWebDAVResponse = function(response, uri)
+ parseResponse = function(serverResponse, outputType)
{
self$parserCallCount <- self$parserCallCount + 1
- response
+
+ if(!is.null(serverResponse$content))
+ return(serverResponse$content)
+
+ serverResponse
},
- extractFileSizeFromWebDAVResponse = function(response, uri)
+ getFileNamesFromResponse = function(serverResponse, uri)
{
self$parserCallCount <- self$parserCallCount + 1
- response
+ serverResponse
+ },
+
+ getFileSizesFromResponse = function(serverResponse, uri)
+ {
+ self$parserCallCount <- self$parserCallCount + 1
+ serverResponse
}
)
)
queryFiltersAreCorrect = NULL,
requestHeaderContainsAuthorizationField = NULL,
requestHeaderContainsDestinationField = NULL,
+ requestHeaderContainsRangeField = NULL,
+ requestHeaderContainsContentTypeField = NULL,
JSONEncodedBodyIsProvided = NULL,
+ requestBodyIsProvided = NULL,
numberOfGETRequests = NULL,
numberOfDELETERequests = NULL,
self$queryFiltersAreCorrect <- FALSE
self$requestHeaderContainsAuthorizationField <- FALSE
self$requestHeaderContainsDestinationField <- FALSE
+ self$requestHeaderContainsRangeField <- FALSE
+ self$requestHeaderContainsContentTypeField <- FALSE
self$JSONEncodedBodyIsProvided <- FALSE
+ self$requestBodyIsProvided <- FALSE
self$numberOfGETRequests <- 0
self$numberOfDELETERequests <- 0
if(!is.null(headers$Destination))
self$requestHeaderContainsDestinationField <- TRUE
+
+ if(!is.null(headers$Range))
+ self$requestHeaderContainsRangeField <- TRUE
+
+ if(!is.null(headers[["Content-Type"]]))
+ self$requestHeaderContainsContentTypeField <- TRUE
},
validateBody = function(body)
{
if(!is.null(body) && class(body) == "json")
self$JSONEncodedBodyIsProvided <- TRUE
+
+ if(!is.null(body))
+ {
+ self$requestBodyIsProvided <- TRUE
+
+ if(class(body) == "json")
+ self$JSONEncodedBodyIsProvided <- TRUE
+ }
},
validateFilters = function(filters)
self$returnContent
},
- read = function(uuid, relativePath, contentType = "text", offset = 0, length = 0)
+ read = function(relativePath, uuid, contentType = "text", offset = 0, length = 0)
{
self$readCallCount <- self$readCallCount + 1
self$returnContent
--- /dev/null
+context("Http Parser")
+
+
+test_that("parseJSONResponse generates and returns JSON object from server response", {
+
+ JSONContent <- "{\"bar\":{\"foo\":[10]}}"
+ serverResponse <- list()
+ serverResponse$content <- charToRaw(JSONContent)
+ serverResponse$headers[["Content-Type"]] <- "application/json; charset=utf-8"
+ class(serverResponse) <- c("response")
+
+ parser <- HttpParser$new()
+
+ result <- parser$parseJSONResponse(serverResponse)
+ barExists <- !is.null(result$bar)
+
+ expect_that(barExists, is_true())
+ expect_that(unlist(result$bar$foo), equals(10))
+})
+
+test_that(paste("parseResponse generates and returns character vector",
+ "from server response if outputType is text"), {
+
+ content <- "random text"
+ serverResponse <- list()
+ serverResponse$content <- charToRaw(content)
+ serverResponse$headers[["Content-Type"]] <- "text/plain; charset=utf-8"
+ class(serverResponse) <- c("response")
+
+ parser <- HttpParser$new()
+ parsedResponse <- parser$parseResponse(serverResponse, "text")
+
+ expect_that(parsedResponse, equals("random text"))
+})
+
+
+webDAVResponseSample =
+ paste0("<?xml version=\"1.0\" encoding=\"UTF-8\"?><D:multistatus xmlns:",
+ "D=\"DAV:\"><D:response><D:href>/c=aaaaa-bbbbb-ccccccccccccccc</D",
+ ":href><D:propstat><D:prop><D:resourcetype><D:collection xmlns:D=",
+ "\"DAV:\"/></D:resourcetype><D:getlastmodified>Fri, 11 Jan 2018 1",
+ "1:11:11 GMT</D:getlastmodified><D:displayname></D:displayname><D",
+ ":supportedlock><D:lockentry xmlns:D=\"DAV:\"><D:lockscope><D:exc",
+ "lusive/></D:lockscope><D:locktype><D:write/></D:locktype></D:loc",
+ "kentry></D:supportedlock></D:prop><D:status>HTTP/1.1 200 OK</D:s",
+ "tatus></D:propstat></D:response><D:response><D:href>/c=aaaaa-bbb",
+ "bb-ccccccccccccccc/myFile.exe</D:href><D:propstat><D:prop><D:r",
+ "esourcetype></D:resourcetype><D:getlastmodified>Fri, 12 Jan 2018",
+ " 22:22:22 GMT</D:getlastmodified><D:getcontenttype>text/x-c++src",
+ "; charset=utf-8</D:getcontenttype><D:displayname>myFile.exe</D",
+ ":displayname><D:getcontentlength>25</D:getcontentlength><D:getet",
+ "ag>\"123b12dd1234567890\"</D:getetag><D:supportedlock><D:lockent",
+ "ry xmlns:D=\"DAV:\"><D:lockscope><D:exclusive/></D:lockscope><D:",
+ "locktype><D:write/></D:locktype></D:lockentry></D:supportedlock>",
+ "</D:prop><D:status>HTTP/1.1 200 OK</D:status></D:propstat></D:re",
+ "sponse></D:multistatus>")
+
+
+
+test_that(paste("getFileNamesFromResponse returns file names belonging to specific",
+ "collection parsed from webDAV server response"), {
+
+ serverResponse <- list()
+ serverResponse$content <- charToRaw(webDAVResponseSample)
+ serverResponse$headers[["Content-Type"]] <- "text/xml; charset=utf-8"
+ class(serverResponse) <- c("response")
+ url <- URLencode("https://webdav/c=aaaaa-bbbbb-ccccccccccccccc")
+
+ parser <- HttpParser$new()
+ result <- parser$getFileNamesFromResponse(serverResponse, url)
+ expectedResult <- "myFile.exe"
+ resultMatchExpected <- all.equal(result, expectedResult)
+
+ expect_that(resultMatchExpected, is_true())
+})
+
+test_that(paste("getFileSizesFromResponse returns file sizes",
+ "parsed from webDAV server response"), {
+
+ serverResponse <- list()
+ serverResponse$content <- charToRaw(webDAVResponseSample)
+ serverResponse$headers[["Content-Type"]] <- "text/xml; charset=utf-8"
+ class(serverResponse) <- c("response")
+ url <- URLencode("https://webdav/c=aaaaa-bbbbb-ccccccccccccccc")
+
+ parser <- HttpParser$new()
+ expectedResult <- "25"
+ result <- parser$getFileSizesFromResponse(serverResponse, url)
+ resultMatchExpected <- result == expectedResult
+
+ expect_that(resultMatchExpected, is_true())
+})
test_that("create calls REST service properly", {
- expectedURL <- "https:/webdavHost/c=aaaaa-j7d0g-ccccccccccccccc/file"
+ expectedURL <- "https://webdavHost/c=aaaaa-j7d0g-ccccccccccccccc/file"
fakeHttp <- FakeHttpRequest$new(expectedURL)
fakeHttpParser <- FakeHttpParser$new()
arv <- FakeArvados$new("token",
- "https:/host/",
- "https:/webdavHost/",
+ "https://host/",
+ "https://webdavHost/",
fakeHttp,
fakeHttpParser)
expect_that(fakeHttp$numberOfPUTRequests, equals(1))
})
-test_that("create raises exception if error code is not between 200 and 300", {
+test_that("create raises exception if server response code is not between 200 and 300", {
response <- list()
response$status_code <- 404
fakeHttp <- FakeHttpRequest$new(serverResponse = response)
arv <- FakeArvados$new("token",
- "https:/host/",
- "https:/webdavHost/",
+ "https://host/",
+ "https://webdavHost/",
fakeHttp,
FakeHttpParser$new())
test_that("delete calls REST service properly", {
- expectedURL <- "https:/webdavHost/c=aaaaa-j7d0g-ccccccccccccccc/file"
+ expectedURL <- "https://webdavHost/c=aaaaa-j7d0g-ccccccccccccccc/file"
fakeHttp <- FakeHttpRequest$new(expectedURL)
fakeHttpParser <- FakeHttpParser$new()
arv <- FakeArvados$new("token",
- "https:/host/",
- "https:/webdavHost/",
+ "https://host/",
+ "https://webdavHost/",
fakeHttp,
fakeHttpParser)
expect_that(fakeHttp$numberOfDELETERequests, equals(1))
})
-test_that("delete raises exception if error code is not between 200 and 300", {
+test_that("delete raises exception if server response code is not between 200 and 300", {
response <- list()
response$status_code <- 404
fakeHttp <- FakeHttpRequest$new(serverResponse = response)
arv <- FakeArvados$new("token",
- "https:/host/",
- "https:/webdavHost/",
+ "https://host/",
+ "https://webdavHost/",
fakeHttp,
FakeHttpParser$new())
test_that("move calls REST service properly", {
- expectedURL <- "https:/webdavHost/c=aaaaa-j7d0g-ccccccccccccccc/file"
+ expectedURL <- "https://webdavHost/c=aaaaa-j7d0g-ccccccccccccccc/file"
fakeHttp <- FakeHttpRequest$new(expectedURL)
fakeHttpParser <- FakeHttpParser$new()
arv <- FakeArvados$new("token",
- "https:/host/",
- "https:/webdavHost/",
+ "https://host/",
+ "https://webdavHost/",
fakeHttp,
fakeHttpParser)
expect_that(fakeHttp$numberOfMOVERequests, equals(1))
})
-test_that("move raises exception if error code is not between 200 and 300", {
+test_that("move raises exception if server response code is not between 200 and 300", {
response <- list()
response$status_code <- 404
fakeHttp <- FakeHttpRequest$new(serverResponse = response)
arv <- FakeArvados$new("token",
- "https:/host/",
- "https:/webdavHost/",
+ "https://host/",
+ "https://webdavHost/",
fakeHttp,
FakeHttpParser$new())
test_that("getCollectionContent retreives correct content from WebDAV server", {
- expectedURL <- "https:/webdavHost/c=aaaaa-j7d0g-ccccccccccccccc"
-
- # WevDAV server always return collection name as first entry in result array,
- # so getCollectionContern need to filter it
- returnContent <- c("aaaaa-j7d0g-ccccccccccccccc",
- "animal", "animal/dog", "ball")
- expectedContent <- c("animal", "animal/dog", "ball")
+ expectedURL <- "https://webdavHost/c=aaaaa-j7d0g-ccccccccccccccc"
+ returnContent <- c("animal", "animal/dog", "ball")
fakeHttp <- FakeHttpRequest$new(expectedURL, returnContent)
fakeHttpParser <- FakeHttpParser$new()
arv <- FakeArvados$new("token",
- "https:/host/",
- "https:/webdavHost/",
+ "https://host/",
+ "https://webdavHost/",
fakeHttp,
fakeHttpParser)
uuid <- "aaaaa-j7d0g-ccccccccccccccc"
returnResult <- REST$getCollectionContent(uuid)
- returnedContentMatchExpected <- all.equal(returnResult, expectedContent)
+ returnedContentMatchExpected <- all.equal(returnResult,
+ c("animal", "animal/dog", "ball"))
expect_that(returnedContentMatchExpected, is_true())
expect_that(fakeHttp$requestHeaderContainsAuthorizationField, is_true())
fakeHttp <- FakeHttpRequest$new(serverResponse = response)
arv <- FakeArvados$new("token",
- "https:/host/",
- "https:/webdavHost/",
+ "https://host/",
+ "https://webdavHost/",
fakeHttp,
FakeHttpParser$new())
REST <- RESTService$new(arv)
expect_that(REST$getCollectionContent(uuid),
- throws_error("Response is empty, reques may be misconfigured"))
+ throws_error("Response is empty, request may be misconfigured"))
})
test_that("getCollectionContent parses server response", {
fakeHttpParser <- FakeHttpParser$new()
arv <- FakeArvados$new("token",
- "https:/host/",
- "https:/webdavHost/",
+ "https://host/",
+ "https://webdavHost/",
fakeHttp,
fakeHttpParser)
test_that("getResourceSize calls REST service properly", {
- expectedURL <- "https:/webdavHost/c=aaaaa-j7d0g-ccccccccccccccc/file"
+ expectedURL <- "https://webdavHost/c=aaaaa-j7d0g-ccccccccccccccc/file"
expectedContent <- c("6", "2", "931", "12003")
fakeHttp <- FakeHttpRequest$new(expectedURL, expectedContent)
fakeHttpParser <- FakeHttpParser$new()
arv <- FakeArvados$new("token",
- "https:/host/",
- "https:/webdavHost/",
+ "https://host/",
+ "https://webdavHost/",
fakeHttp,
fakeHttpParser)
expect_that(returnedContentMatchExpected, is_true())
})
+test_that("getResourceSize raises exception if server returns empty response", {
+
+ response <- ""
+ fakeHttp <- FakeHttpRequest$new(serverResponse = response)
+
+ arv <- FakeArvados$new("token",
+ "https://host/",
+ "https://webdavHost/",
+ fakeHttp,
+ FakeHttpParser$new())
+
+ uuid <- "aaaaa-j7d0g-ccccccccccccccc"
+ REST <- RESTService$new(arv)
+
+ expect_that(REST$getResourceSize("file", uuid),
+ throws_error("Response is empty, request may be misconfigured"))
+})
+
test_that("getResourceSize parses server response", {
fakeHttp <- FakeHttpRequest$new()
fakeHttpParser <- FakeHttpParser$new()
arv <- FakeArvados$new("token",
- "https:/host/",
- "https:/webdavHost/",
+ "https://host/",
+ "https://webdavHost/",
fakeHttp,
fakeHttpParser)
expect_that(fakeHttpParser$parserCallCount, equals(1))
})
+
+test_that("read calls REST service properly", {
+
+ expectedURL <- "https://webdavHost/c=aaaaa-j7d0g-ccccccccccccccc/file"
+ serverResponse <- list()
+ serverResponse$status_code <- 200
+ serverResponse$content <- "file content"
+
+ fakeHttp <- FakeHttpRequest$new(expectedURL, serverResponse)
+ fakeHttpParser <- FakeHttpParser$new()
+
+ arv <- FakeArvados$new("token",
+ "https://host/",
+ "https://webdavHost/",
+ fakeHttp,
+ fakeHttpParser)
+
+ REST <- RESTService$new(arv)
+
+ uuid <- "aaaaa-j7d0g-ccccccccccccccc"
+ returnResult <- REST$read("file", uuid, "text", 1024, 512)
+
+ expect_that(fakeHttp$URLIsProperlyConfigured, is_true())
+ 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", {
+
+ response <- list()
+ response$status_code <- 404
+ fakeHttp <- FakeHttpRequest$new(serverResponse = response)
+
+ arv <- FakeArvados$new("token",
+ "https://host/",
+ "https://webdavHost/",
+ fakeHttp,
+ FakeHttpParser$new())
+
+ uuid <- "aaaaa-j7d0g-ccccccccccccccc"
+ REST <- RESTService$new(arv)
+
+ expect_that(REST$read("file", uuid),
+ throws_error("Server code: 404"))
+})
+
+test_that("read raises exception if contentType is not valid", {
+
+ fakeHttp <- FakeHttpRequest$new()
+
+ arv <- FakeArvados$new("token",
+ "https://host/",
+ "https://webdavHost/",
+ fakeHttp,
+ FakeHttpParser$new())
+
+ uuid <- "aaaaa-j7d0g-ccccccccccccccc"
+ REST <- RESTService$new(arv)
+
+ 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", {
+
+ fakeHttp <- FakeHttpRequest$new()
+ fakeHttpParser <- FakeHttpParser$new()
+
+ arv <- FakeArvados$new("token",
+ "https://host/",
+ "https://webdavHost/",
+ fakeHttp,
+ fakeHttpParser)
+
+ REST <- RESTService$new(arv)
+
+ uuid <- "aaaaa-j7d0g-ccccccccccccccc"
+ REST$getCollectionContent(uuid)
+
+ expect_that(fakeHttpParser$parserCallCount, equals(1))
+})
+
+test_that("write calls REST service properly", {
+
+ expectedURL <- "https://webdavHost/c=aaaaa-j7d0g-ccccccccccccccc/file"
+ fakeHttp <- FakeHttpRequest$new(expectedURL)
+ fakeHttpParser <- FakeHttpParser$new()
+
+ arv <- FakeArvados$new("token",
+ "https://host/",
+ "https://webdavHost/",
+ fakeHttp,
+ fakeHttpParser)
+
+ REST <- RESTService$new(arv)
+
+ fileContent <- "new file content"
+ uuid <- "aaaaa-j7d0g-ccccccccccccccc"
+ REST$write("file", uuid, fileContent, "text/html")
+
+ expect_that(fakeHttp$URLIsProperlyConfigured, is_true())
+ 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", {
+
+ response <- list()
+ response$status_code <- 404
+ fakeHttp <- FakeHttpRequest$new(serverResponse = response)
+
+ arv <- FakeArvados$new("token",
+ "https://host/",
+ "https://webdavHost/",
+ fakeHttp,
+ FakeHttpParser$new())
+
+ uuid <- "aaaaa-j7d0g-ccccccccccccccc"
+ fileContent <- "new file content"
+ REST <- RESTService$new(arv)
+
+ expect_that(REST$write("file", uuid, fileContent, "text/html"),
+ throws_error("Server code: 404"))
+})