source("./R/HttpRequest.R")
source("./R/HttpParser.R")
+source("./R/RESTService.R")
#' Arvados SDK Object
#'
private$http <- HttpRequest$new()
private$httpParser <- HttpParser$new()
+ private$REST <- RESTService$new(self)
private$token <- token
private$host <- host
private$rawHost <- host_name
getHttpParser = function() private$httpParser,
setHttpParser = function(newParser) private$httpParser <- newParser,
+ getRESTService = function() private$REST,
+ setRESTService = function(newRESTService) private$REST <- newRESTService,
+
getWebDavHostName = function()
{
if(is.null(private$webDavHostName))
webDavHostName = NULL,
http = NULL,
httpParser = NULL,
+ REST = NULL,
fetchAllItems = function(resourceURL, filters)
{
if(!is.null(childWithSameName))
stop("Destination already contains file with same name.")
- status <- private$collection$moveOnREST(self$getRelativePath(),
- paste0(newParent$getRelativePath(),
- "/", self$getName()))
+ REST <- private$collection$getRESTService()
+ status <- REST$move(self$getRelativePath(),
+ paste0(newParent$getRelativePath(),
+ "/", self$getName()),
+ private$collection$uuid)
#Note: We temporary set parents collection to NULL. This will ensure that
# add method doesn't post file on REST server.
source("./R/ArvadosFile.R")
source("./R/HttpRequest.R")
source("./R/HttpParser.R")
+source("./R/RESTService.R")
+source("./R/util.R")
#' Arvados Collection Object
#'
initialize = function(api, uuid)
{
self$api <- api
- private$http <- HttpRequest$new()
- private$httpParser <- HttpParser$new()
+ private$http <- api$getHttpClient()
+ private$httpParser <- api$getHttpParser()
+ private$REST <- api$getRESTService()
self$uuid <- uuid
collection <- self$api$getCollection(uuid)
- private$fileContent <- private$getCollectionContent()
+ private$fileContent <- private$REST$getCollectionContent(uuid)
private$tree <- CollectionTree$new(private$fileContent, self)
},
add = function(content, relativePath = "")
{
- if(relativePath == "" ||
+ if(relativePath == "" ||
relativePath == "." ||
relativePath == "./")
{
}
else
{
- if(endsWith(relativePath, "/") && nchar(relativePath) > 0)
- relativePath <- substr(relativePath, 1, nchar(relativePath) - 1)
-
+ relativePath <- trimFromEnd(relativePath, "/")
subcollection <- self$get(relativePath)
}
- if(is.null(subcollection))
+ if(is.null(subcollection) || !("Subcollection" %in% class(Subcollection)))
stop(paste("Subcollection", relativePath, "doesn't exist."))
if("ArvadosFile" %in% class(content) ||
}
},
+ #todo collapse 2 parameters in one
create = function(fileNames, relativePath = "")
{
if(relativePath == "" ||
move = function(content, newLocation)
{
- if(endsWith(content, "/"))
- content <- substr(content, 0, nchar(content) - 1)
+ content <- trimFromEnd(content, "/")
elementToMove <- self$get(content)
elementToMove$move(newLocation)
},
- getFileListing = function() private$getCollectionContent(),
+ getFileListing = function() private$REST$getCollectionContent(self$uuid),
get = function(relativePath)
{
private$tree$getElement(relativePath)
},
-
- #Todo: Move these methods to another class.
- createFilesOnREST = function(files)
- {
- sapply(files, function(filePath)
- {
- self$createNewFile(filePath, NULL, "text/html")
- })
- },
-
- createNewFile = function(relativePath, content, contentType)
- {
- fileURL <- paste0(self$api$getWebDavHostName(), "c=", self$uuid, "/", relativePath);
- headers <- list(Authorization = paste("OAuth2", self$api$getToken()),
- "Content-Type" = contentType)
- body <- content
-
- serverResponse <- private$http$PUT(fileURL, headers, body)
-
- if(serverResponse$status_code < 200 || serverResponse$status_code >= 300)
- stop(paste("Server code:", serverResponse$status_code))
-
- print(paste("File created:", relativePath))
- },
-
- deleteFromREST = function(relativePath)
- {
- fileURL <- paste0(self$api$getWebDavHostName(), "c=", self$uuid, "/", relativePath);
- headers <- list(Authorization = paste("OAuth2", self$api$getToken()))
- serverResponse <- private$http$DELETE(fileURL, headers)
-
- if(serverResponse$status_code < 200 || serverResponse$status_code >= 300)
- stop(paste("Server code:", serverResponse$status_code))
-
- print(paste("File deleted:", relativePath))
- },
-
- moveOnREST = function(from, to)
- {
- collectionURL <- URLencode(paste0(self$api$getWebDavHostName(), "c=", self$uuid, "/"))
- fromURL <- paste0(collectionURL, from)
- toURL <- paste0(collectionURL, to)
-
- headers = list("Authorization" = paste("OAuth2", self$api$getToken()),
- "Destination" = toURL)
-
- serverResponse <- private$http$MOVE(fromURL, headers)
-
- if(serverResponse$status_code < 200 || serverResponse$status_code >= 300)
- stop(paste("Server code:", serverResponse$status_code))
-
- serverResponse
- }
+ getRESTService = function() private$REST,
+ setRESTService = function(newRESTService) private$REST <- newRESTService
),
private = list(
http = NULL,
httpParser = NULL,
+ REST = NULL,
tree = NULL,
fileContent = NULL,
- getCollectionContent = function()
- {
- collectionURL <- URLencode(paste0(self$api$getWebDavHostName(), "c=", self$uuid))
-
- headers = list("Authorization" = paste("OAuth2", self$api$getToken()))
-
- response <- private$http$PROPFIND(collectionURL, headers)
-
- parsedResponse <- private$httpParser$parseWebDAVResponse(response, collectionURL)
- parsedResponse[-1]
- },
-
generateTree = function(content)
{
treeBranches <- sapply(collectionContent, function(filePath)
headers <- httr::add_headers(unlist(headers))
query <- private$createQuery(queryFilters, limit, offset)
url <- paste0(url, query)
- print(url)
serverResponse <- httr::PUT(url = url, config = headers, body = body)
},
h <- curl::new_handle()
curl::handle_setopt(h, customrequest = "MOVE")
curl::handle_setheaders(h, .list = headers)
+ print(url)
propfindResponse <- curl::curl_fetch_memory(url, h)
}
--- /dev/null
+RESTService <- R6::R6Class(
+
+ "RESTService",
+
+ public = list(
+
+ initialize = function(api)
+ {
+ private$api <- api
+ private$http <- api$getHttpClient()
+ private$httpParser <- api$getHttpParser()
+ },
+
+ create = function(files, uuid)
+ {
+ sapply(files, function(filePath)
+ {
+ private$createNewFile(filePath, uuid, "text/html")
+ })
+ },
+
+ delete = function(relativePath, uuid)
+ {
+ fileURL <- paste0(private$api$getWebDavHostName(), "c=",
+ uuid, "/", relativePath);
+ headers <- list(Authorization = paste("OAuth2", private$api$getToken()))
+
+ serverResponse <- private$http$DELETE(fileURL, headers)
+
+ if(serverResponse$status_code < 200 || serverResponse$status_code >= 300)
+ stop(paste("Server code:", serverResponse$status_code))
+
+ print(paste("File deleted:", relativePath))
+ },
+
+ move = function(from, to, uuid)
+ {
+ #Todo Do we need this URLencode?
+ collectionURL <- URLencode(paste0(private$api$getWebDavHostName(), "c=",
+ uuid, "/"))
+ fromURL <- paste0(collectionURL, from)
+ toURL <- paste0(collectionURL, to)
+
+ headers <- list("Authorization" = paste("OAuth2", private$api$getToken()),
+ "Destination" = toURL)
+
+ serverResponse <- private$http$MOVE(fromURL, headers)
+
+ if(serverResponse$status_code < 200 || serverResponse$status_code >= 300)
+ stop(paste("Server code:", serverResponse$status_code))
+
+ serverResponse
+ },
+
+ getCollectionContent = function(uuid)
+ {
+ collectionURL <- URLencode(paste0(private$api$getWebDavHostName(), "c=", uuid))
+
+ headers = list("Authorization" = paste("OAuth2", private$api$getToken()))
+
+ response <- private$http$PROPFIND(collectionURL, headers)
+
+ parsedResponse <- private$httpParser$parseWebDAVResponse(response, collectionURL)
+ parsedResponse[-1]
+ },
+
+ getResourceSize = function(uuid, relativePathToResource)
+ {
+ collectionURL <- URLencode(paste0(private$api$getWebDavHostName(),
+ "c=", uuid))
+ subcollectionURL <- paste0(collectionURL, "/",
+ relativePathToResource, "/");
+
+ headers = list("Authorization" = paste("OAuth2",
+ private$api$getToken()))
+
+ propfindResponse <- private$http$PROPFIND(subcollectionURL, headers)
+
+ sizes <- private$httpParser$extractFileSizeFromWebDAVResponse(propfindResponse,
+ collectionURL)
+ sizes <- as.numeric(sizes[-1])
+
+ return(sum(sizes))
+ }
+ ),
+
+ private = list(
+
+ api = NULL,
+ http = NULL,
+ httpParser = NULL,
+
+
+ createNewFile = function(relativePath, uuid, contentType)
+ {
+ fileURL <- paste0(private$api$getWebDavHostName(), "c=",
+ uuid, "/", relativePath);
+ headers <- list(Authorization = paste("OAuth2", private$api$getToken()),
+ "Content-Type" = contentType)
+ body <- NULL
+
+ serverResponse <- private$http$PUT(fileURL, headers, body)
+
+ if(serverResponse$status_code < 200 || serverResponse$status_code >= 300)
+ stop(paste("Server code:", serverResponse$status_code))
+
+ print(paste("File created:", relativePath))
+ }
+ ),
+
+ cloneable = FALSE
+)
initialize = function(name)
{
private$name <- name
- private$http <- HttpRequest$new()
- private$httpParser <- HttpParser$new()
},
getName = function() private$name,
{
childWithSameName <- self$get(content$getName())
if(!is.null(childWithSameName))
- stop("Subcollection already contains ArvadosFile
- or Subcollection with same name.")
+ stop(paste("Subcollection already contains ArvadosFile",
+ "or Subcollection with same name."))
if(!is.null(private$collection))
{
else
contentPath <- content$getFileListing()
- private$collection$createFilesOnREST(contentPath)
+ REST <- private$collection$getRESTService()
+ REST$create(contentPath, private$collection$uuid)
content$setCollection(private$collection)
}
}
else
{
- stop(paste("Expected AravodsFile or Subcollection object, got",
- paste0("(", paste0(class(content), collapse = ", "), ")"),
- "."))
+ stop(paste0("Expected AravodsFile or Subcollection object, got ",
+ paste0("(", paste0(class(content), collapse = ", "), ")"),
+ "."))
}
},
child <- self$get(name)
if(is.null(child))
- stop("Subcollection doesn't contains ArvadosFile
- or Subcollection with same name.")
+ stop(paste("Subcollection doesn't contains ArvadosFile",
+ "or Subcollection with specified name."))
if(!is.null(private$collection))
{
- private$collection$deleteFromREST(child$getRelativePath())
+ REST <- private$collection$getRESTService()
+ REST$delete(child$getRelativePath(), private$collection$uuid)
child$setCollection(NULL)
}
}
else
{
- stop(paste("Expected character, got",
- paste0("(", paste0(class(name), collapse = ", "), ")"),
- "."))
+ stop(paste0("Expected character, got ",
+ paste0("(", paste0(class(name), collapse = ", "), ")"),
+ "."))
}
},
- getFileListing = function(fullpath = TRUE)
+ getFileListing = function(fullPath = TRUE)
{
content <- NULL
- if(fullpath)
+ if(fullPath)
{
for(child in private$children)
content <- c(content, child$getFileListing())
getSizeInBytes = function()
{
- collectionURL <- URLencode(paste0(private$collection$api$getWebDavHostName(),
- "c=", private$collection$uuid))
- subcollectionURL <- paste0(collectionURL, "/", self$getRelativePath(), "/");
-
- headers = list("Authorization" = paste("OAuth2", private$collection$api$getToken()))
-
- propfindResponse <- private$http$PROPFIND(subcollectionURL, headers)
-
- sizes <- private$httpParser$extractFileSizeFromWebDAVResponse(propfindResponse, collectionURL)
- sizes <- as.numeric(sizes[-1])
-
- sum(sizes)
- },
-
- move = function(newLocation)
- {
- if(is.null(private$collection))
- stop("Subcollection doesn't belong to any collection.")
-
- if(endsWith(newLocation, paste0(private$name, "/")))
- {
- newLocation <- substr(newLocation, 0,
- nchar(newLocation) - nchar(paste0(private$name, "/")))
- }
- else if(endsWith(newLocation, private$name))
+ if(!is.null(private$collection))
{
- newLocation <- substr(newLocation, 0,
- nchar(newLocation) - nchar(private$name))
+ REST <- private$collection$getRESTService()
+ subcollectionSize <- REST$getResourceSize(private$collection$uuid,
+ self$getRelativePath())
+ return(subcollectionSize)
}
else
{
- stop("Destination path is not valid.")
+ return(0)
}
+ },
+
+ move = function(newLocationInCollection)
+ {
+ if(is.null(private$collection))
+ stop("Subcollection doesn't belong to any collection")
+
+ newLocationInCollection <- trimFromEnd(newLocationInCollection, "/")
+ newParentLocation <- trimFromEnd(newLocationInCollection, private$name)
- newParent <- private$collection$get(newLocation)
+ newParent <- private$collection$get(newParentLocation)
if(is.null(newParent))
{
- stop("Unable to get destination subcollection.")
+ stop("Unable to get destination subcollection")
}
- status <- private$collection$moveOnREST(self$getRelativePath(),
- paste0(newParent$getRelativePath(),
- "/", self$getName()))
-
- #Note: We temporary set parents collection to NULL. This will ensure that
- # add method doesn't post file on REST server.
- parentsCollection <- newParent$getCollection()
- newParent$setCollection(NULL, setRecursively = FALSE)
-
- newParent$add(self)
-
- newParent$setCollection(parentsCollection, setRecursively = FALSE)
+ REST <- private$collection$getRESTService()
+ REST$move(self$getRelativePath(),
+ paste0(newParent$getRelativePath(), "/", self$getName()),
+ private$collection$uuid)
- private$parent <- newParent
+ private$dettachFromCurrentParent()
+ private$attachToNewParent(newParent)
- "Content moved successfully."
+ "Content moved successfully"
},
get = function(name)
children = NULL,
parent = NULL,
collection = NULL,
- http = NULL,
- httpParser = NULL,
removeChild = function(name)
{
}
}
}
+ },
+
+ attachToNewParent = function(newParent)
+ {
+ #Note: We temporary set parents collection to NULL. This will ensure that
+ # add method doesn't post file on REST.
+ parentsCollection <- newParent$getCollection()
+ newParent$setCollection(NULL, setRecursively = FALSE)
+
+ newParent$add(self)
+
+ newParent$setCollection(parentsCollection, setRecursively = FALSE)
+
+ private$parent <- newParent
+ },
+
+ dettachFromCurrentParent = function()
+ {
+ #Note: We temporary set parents collection to NULL. This will ensure that
+ # remove method doesn't remove this subcollection from REST.
+ parent <- private$parent
+ parentsCollection <- parent$getCollection()
+ parent$setCollection(NULL, setRecursively = FALSE)
+
+ parent$remove(private$name)
+
+ parent$setCollection(parentsCollection, setRecursively = FALSE)
}
),
--- /dev/null
+FakeRESTService <- R6::R6Class(
+
+ "FakeRESTService",
+
+ public = list(
+
+ createCallCount = NULL,
+ deleteCallCount = NULL,
+ moveCallCount = NULL,
+ getResourceSizeCallCount = NULL,
+
+ collectionContent = NULL,
+ returnContent = NULL,
+
+ initialize = function(collectionContent = NULL, returnContent = NULL)
+ {
+ self$createCallCount <- 0
+ self$deleteCallCount <- 0
+ self$moveCallCount <- 0
+ self$getResourceSizeCallCount <- 0
+
+ self$collectionContent <- collectionContent
+ self$returnContent <- returnContent
+ },
+
+ create = function(files, uuid)
+ {
+ self$createCallCount <- self$createCallCount + 1
+
+ self$returnContent
+ },
+
+ delete = function(relativePath, uuid)
+ {
+ self$deleteCallCount <- self$deleteCallCount + 1
+ self$returnContent
+ },
+
+ move = function(from, to, uuid)
+ {
+ self$moveCallCount <- self$moveCallCount + 1
+ self$returnContent
+ },
+
+ getCollectionContent = function(uuid)
+ {
+ self$collectionContent
+ },
+
+ getResourceSize = function(uuid, relativePathToResource)
+ {
+ self$getResourceSizeCallCount <- self$getResourceSizeCallCount + 1
+ self$returnContent
+ }
+ ),
+
+ cloneable = FALSE
+)
+source("fakes/FakeRESTService.R")
+
+context("Subcollection")
+
+test_that("getRelativePath returns relative path properly", {
+
+ animal <- Subcollection$new("animal")
+
+ fish <- Subcollection$new("fish")
+ animal$add(fish)
+
+ expect_that(animal$getRelativePath(), equals("animal"))
+ expect_that(fish$getRelativePath(), equals("animal/fish"))
+})
+
+test_that(paste("getFileListing by default returns path of all files",
+ "relative to the current subcollection"), {
+
+ animal <- Subcollection$new("animal")
+ fish <- Subcollection$new("fish")
+ shark <- ArvadosFile$new("shark")
+ blueFish <- ArvadosFile$new("blueFish")
+
+ animal$add(fish)
+ fish$add(shark)
+ fish$add(blueFish)
+
+ result <- animal$getFileListing()
+ expectedResult <- c("animal/fish/shark", "animal/fish/blueFish")
+
+ resultsMatch <- length(expectedResult) == length(result) &&
+ all(expectedResult == result)
+
+ expect_that(resultsMatch, is_true())
+})
+
+test_that(paste("getFileListing returns names of all direct children",
+ "if fullPath is set to FALSE"), {
+
+ animal <- Subcollection$new("animal")
+ fish <- Subcollection$new("fish")
+ shark <- ArvadosFile$new("shark")
+ dog <- ArvadosFile$new("dog")
+
+ animal$add(fish)
+ animal$add(dog)
+ fish$add(shark)
+
+ result <- animal$getFileListing(fullPath = FALSE)
+ expectedResult <- c("fish", "dog")
+
+ resultsMatch <- length(expectedResult) == length(result) &&
+ all(expectedResult == result)
+
+ expect_that(resultsMatch, is_true())
+})
+
+test_that("add adds content to inside collection tree", {
+
+ animal <- Subcollection$new("animal")
+ fish <- Subcollection$new("fish")
+ dog <- ArvadosFile$new("dog")
+
+ animal$add(fish)
+ animal$add(dog)
+
+ animalContainsFish <- animal$get("fish")$getName() == fish$getName()
+ animalContainsDog <- animal$get("dog")$getName() == dog$getName()
+
+ expect_that(animalContainsFish, is_true())
+ expect_that(animalContainsDog, is_true())
+})
+
+test_that(paste("add raises exception if ArvadosFile/Subcollection",
+ "with same name already exists in the subcollection"), {
+
+ animal <- Subcollection$new("animal")
+ fish <- Subcollection$new("fish")
+ secondFish <- Subcollection$new("fish")
+ thirdFish <- ArvadosFile$new("fish")
+
+ animal$add(fish)
+
+ expect_that(animal$add(secondFish),
+ throws_error(paste("Subcollection already contains ArvadosFile or",
+ "Subcollection with same name."), fixed = TRUE))
+ expect_that(animal$add(thirdFish),
+ throws_error(paste("Subcollection already contains ArvadosFile or",
+ "Subcollection with same name."), fixed = TRUE))
+})
+
+test_that(paste("add raises exception if passed argument is",
+ "not ArvadosFile or Subcollection"), {
+
+ animal <- Subcollection$new("animal")
+ number <- 10
+
+ expect_that(animal$add(number),
+ throws_error(paste("Expected AravodsFile or Subcollection object,",
+ "got (numeric)."), fixed = TRUE))
+})
+
+test_that(paste("add post content to a REST service",
+ "if subcollection belongs to a collection"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal", "animal/fish")
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+
+ collection <- Collection$new(api, "myUUID")
+ animal <- collection$get("animal")
+ dog <- ArvadosFile$new("dog")
+
+ animal$add(dog)
+
+ expect_that(fakeREST$createCallCount, equals(1))
+})
+
+test_that("remove removes content from subcollection", {
+
+ animal <- Subcollection$new("animal")
+ fish <- Subcollection$new("fish")
+
+ animal$add(fish)
+ animal$remove("fish")
+
+ returnValueAfterRemovalIsNull <- is.null(animal$get("fish"))
+
+ expect_that(returnValueAfterRemovalIsNull, is_true())
+})
+
+test_that(paste("remove raises exception",
+ "if content to remove doesn't exist in the subcollection"), {
+
+ animal <- Subcollection$new("animal")
+
+ expect_that(animal$remove("fish"),
+ throws_error(paste("Subcollection doesn't contains ArvadosFile",
+ "or Subcollection with specified name.")))
+})
+
+test_that("remove raises exception if passed argument is not character vector", {
+
+ animal <- Subcollection$new("animal")
+ number <- 10
+
+ expect_that(animal$remove(number),
+ throws_error(paste("Expected character,",
+ "got (numeric)."), fixed = TRUE))
+})
+
+test_that(paste("remove removes content from REST service",
+ "if subcollection belongs to a collection"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal", "animal/fish", "animal/dog")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ animal <- collection$get("animal")
+
+ animal$remove("fish")
+
+ expect_that(fakeREST$deleteCallCount, equals(1))
+})
+
+test_that(paste("get returns ArvadosFile or Subcollection",
+ "if file or folder with given name exists"), {
+
+ animal <- Subcollection$new("animal")
+ fish <- Subcollection$new("fish")
+ dog <- ArvadosFile$new("dog")
+
+ animal$add(fish)
+ animal$add(dog)
+
+ returnedFish <- animal$get("fish")
+ returnedDog <- animal$get("dog")
+
+ returnedFishIsSubcollection <- "Subcollection" %in% class(returnedFish)
+ returnedDogIsArvadosFile <- "ArvadosFile" %in% class(returnedDog)
+
+ expect_that(returnedFishIsSubcollection, is_true())
+ expect_that(returnedFish$getName(), equals("fish"))
+
+ expect_that(returnedDogIsArvadosFile, is_true())
+ expect_that(returnedDog$getName(), equals("dog"))
+})
+
+test_that(paste("get returns NULL if file or folder",
+ "with given name doesn't exists"), {
+
+ animal <- Subcollection$new("animal")
+ fish <- Subcollection$new("fish")
+
+ animal$add(fish)
+
+ returnedDogIsNull <- is.null(animal$get("dog"))
+
+ expect_that(returnedDogIsNull, is_true())
+})
+
+test_that("getFirst returns first child in the subcollection", {
+
+ animal <- Subcollection$new("animal")
+ fish <- Subcollection$new("fish")
+
+ animal$add(fish)
+
+ expect_that(animal$getFirst()$getName(), equals("fish"))
+})
+
+test_that("getFirst returns NULL if subcollection contains no children", {
+
+ animal <- Subcollection$new("animal")
+
+ returnedElementIsNull <- is.null(animal$getFirst())
+
+ expect_that(returnedElementIsNull, is_true())
+})
+
+test_that(paste("setCollection by default sets collection",
+ "filed of subcollection and all its children"), {
+
+ animal <- Subcollection$new("animal")
+ fish <- Subcollection$new("fish")
+ animal$add(fish)
+
+ animal$setCollection("myCollection")
+
+ expect_that(animal$getCollection(), equals("myCollection"))
+ expect_that(fish$getCollection(), equals("myCollection"))
+})
+
+test_that(paste("setCollection sets collection filed of subcollection only",
+ "if parameter setRecursively is set to FALSE"), {
+
+ animal <- Subcollection$new("animal")
+ fish <- Subcollection$new("fish")
+ animal$add(fish)
+
+ animal$setCollection("myCollection", setRecursively = FALSE)
+ fishCollectionIsNull <- is.null(fish$getCollection())
+
+ expect_that(animal$getCollection(), equals("myCollection"))
+ expect_that(fishCollectionIsNull, is_true())
+})
+
+test_that(paste("move raises exception if subcollection",
+ "doesn't belong to any collection"), {
+
+ animal <- Subcollection$new("animal")
+
+ expect_that(animal$move("new/location"),
+ throws_error("Subcollection doesn't belong to any collection"))
+})
+
+test_that(paste("move raises exception if newLocationInCollection",
+ "parameter is invalid"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "animal/dog",
+ "animal/fish/shark",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+
+ collection <- Collection$new(api, "myUUID")
+ dog <- collection$get("animal/dog")
+
+ expect_that(dog$move("objects/dog"),
+ throws_error("Unable to get destination subcollection"))
+})
+
+test_that("move moves subcollection inside collection tree", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "animal/dog",
+ "animal/fish/shark",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ fish <- collection$get("animal/fish")
+
+ fish$move("fish")
+ fishIsNullOnOldLocation <- is.null(collection$get("animal/fish"))
+ fishExistsOnNewLocation <- !is.null(collection$get("fish"))
+
+ expect_that(fishIsNullOnOldLocation, is_true())
+ expect_that(fishExistsOnNewLocation, is_true())
+})
+
+test_that(paste("getSizeInBytes returns zero if subcollection",
+ "is not part of a collection"), {
+
+ animal <- Subcollection$new("animal")
+
+ expect_that(animal$getSizeInBytes(), equals(0))
+})
+
+test_that(paste("getSizeInBytes delegates size calculation",
+ "to REST service class"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal", "animal/fish")
+ returnSize <- 100
+
+ fakeREST <- FakeRESTService$new(collectionContent, returnSize)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ animal <- collection$get("animal")
+
+ resourceSize <- animal$getSizeInBytes()
+
+ expect_that(resourceSize, equals(100))
+})
projects / arvados.git / commitdiff