[ARVADOS] updated: 1.1.2-183-gaf17604
Git user
git at public.curoverse.com
Wed Jan 17 11:23:12 EST 2018
Summary of changes:
.../app/assets/javascripts/application.js | 1 +
.../app/assets/javascripts/components/edit_tags.js | 265 +++++++++++++++
.../app/assets/javascripts/edit_collection_tags.js | 72 ----
.../app/assets/javascripts/mithril_mount.js | 3 +-
.../app/assets/javascripts/models/session_db.js | 16 +-
.../app/assets/stylesheets/application.css.scss | 11 +
.../app/controllers/collections_controller.rb | 24 --
.../app/views/collections/_show_tag_rows.html.erb | 35 --
.../app/views/collections/_show_tags.html.erb | 50 +--
.../app/views/collections/save_tags.js.erb | 7 -
apps/workbench/app/views/collections/tags.js.erb | 5 -
apps/workbench/npm_packages | 2 +
apps/workbench/public/vocabulary-example.json | 32 ++
.../controllers/collections_controller_test.rb | 60 ----
.../workbench/test/integration/collections_test.rb | 84 -----
build/build-dev-docker-jobs-image.sh | 13 +-
doc/_config.yml | 3 +
doc/admin/change-account-owner.html.textile.liquid | 41 +++
doc/admin/merge-remote-account.html.textile.liquid | 47 +++
doc/api/methods/users.html.textile.liquid | 2 +-
sdk/R/R/Arvados.R | 6 +
sdk/R/R/ArvadosFile.R | 165 ++++------
sdk/R/R/Collection.R | 129 ++------
sdk/R/R/HttpRequest.R | 2 +-
sdk/R/R/RESTService.R | 160 +++++++++
sdk/R/R/Subcollection.R | 125 +++----
sdk/R/README | 8 +-
sdk/R/tests/testthat/fakes/FakeRESTService.R | 79 +++++
sdk/R/tests/testthat/test-ArvadosFile.R | 287 ++++++++++++++++
sdk/R/tests/testthat/test-Collection.R | 296 +++++++++++++++++
sdk/R/tests/testthat/test-CollectionTree.R | 2 +-
sdk/R/tests/testthat/test-Subcollection.R | 362 +++++++++++++++++++++
sdk/cwl/arvados_cwl/__init__.py | 24 +-
sdk/cwl/arvados_cwl/arvcontainer.py | 3 +-
sdk/cwl/arvados_cwl/arvjob.py | 7 +-
sdk/cwl/arvados_cwl/arvworkflow.py | 7 +-
sdk/cwl/arvados_cwl/fsaccess.py | 9 +-
sdk/cwl/arvados_cwl/runner.py | 42 ++-
sdk/cwl/setup.py | 4 +-
sdk/cwl/tests/test_container.py | 15 +-
sdk/cwl/tests/test_job.py | 6 +-
sdk/cwl/tests/test_submit.py | 4 +
sdk/go/arvados/node.go | 44 +++
.../controllers/arvados/v1/schema_controller.rb | 1 +
.../api/app/models/api_client_authorization.rb | 11 +-
.../arvados/v1/schema_controller_test.rb | 1 +
services/api/test/integration/remote_user_test.rb | 7 +
services/crunch-run/crunchrun.go | 120 +++++--
services/crunch-run/crunchrun_test.go | 37 ++-
49 files changed, 2056 insertions(+), 680 deletions(-)
create mode 100644 apps/workbench/app/assets/javascripts/components/edit_tags.js
delete mode 100644 apps/workbench/app/assets/javascripts/edit_collection_tags.js
delete mode 100644 apps/workbench/app/views/collections/_show_tag_rows.html.erb
delete mode 100644 apps/workbench/app/views/collections/save_tags.js.erb
delete mode 100644 apps/workbench/app/views/collections/tags.js.erb
create mode 100644 apps/workbench/public/vocabulary-example.json
create mode 100644 doc/admin/change-account-owner.html.textile.liquid
create mode 100644 doc/admin/merge-remote-account.html.textile.liquid
create mode 100644 sdk/R/R/RESTService.R
create mode 100644 sdk/R/tests/testthat/fakes/FakeRESTService.R
create mode 100644 sdk/R/tests/testthat/test-ArvadosFile.R
create mode 100644 sdk/R/tests/testthat/test-Collection.R
create mode 100644 sdk/go/arvados/node.go
via af17604c5a93830380fb50db93ce543926c116cf (commit)
via 539f2b151c57a76c9a8c0d49ef7ee5c0bac39de7 (commit)
via d25be127db660e0c3c97bf53f8488d73e28b86d3 (commit)
via 3a3fc5ac54a80b62b05f78cf2da0a7b43f4a4380 (commit)
via 6b3cfe60beb46ba087de5093926363d8b03ab889 (commit)
via db0e7f5c4848c5c79d9fe43d4c9317c4d5ce482a (commit)
via ba15fa5da21f4bafd3f90a8d259ea2aae764c77e (commit)
via 0cae6411490ad7a4a6d611605fb04de6db2f1190 (commit)
via 8a798254e07ef391c535c919cba448da8ed6db8a (commit)
via d179241c734c2c533f4453beaecd53d27ced9a98 (commit)
via 0fd0dbc7b828503258fa071d4cd712da01dfe11e (commit)
via f1e1a1ae570c8f09130e5de2a9fc15c0a6067542 (commit)
via 8f982486f5ed7b49d250fafdf3840a929a824ef7 (commit)
via 37860134053cda88c7ee3a3f4300e949cad016f5 (commit)
via b017ae29973838673d66d9f9da4a07f9852d9476 (commit)
via 18cf19a3131b19ffcf2181ad31005fa641d46f6d (commit)
via 824680f81d5c5d243f49096be975568b786fac2a (commit)
via d8a7800b5ca3d50bcd62545711585681e2b9154b (commit)
via 38ceac30a22ac3c506ca69263ff9e2640e5bd71e (commit)
via 2702b79d8981e562aa9848f41d96bd0a37a278c6 (commit)
via 7ec6b571c54af1ddd404488b2922c41dfdffdde1 (commit)
via 87b24df10b354794904d6c3dea6258dd0f45adc3 (commit)
via f44a15adce692614ecb816dbe2d0205704d9a4ab (commit)
via 5a82b37499c717e62d899a633f548713c872307b (commit)
via 3fc4aaee466529bd8ed7fad664d2eb61b37d6864 (commit)
via 75cb3149396f6385d6af30deaed74ee87ace696d (commit)
via ce7505914ba4c53a7aa1d987aaf92de81af1fb49 (commit)
via aa04aa117da273ac363453d2297e3474407ac573 (commit)
via 707e31dad5efed2bb4af7e624f90cff80b6e4052 (commit)
via 790688e4bcd6f1a92ac409c0c354acba752aaa9c (commit)
via 6fe66955fb53dde27d9677d31fdb137913b2b850 (commit)
via 0dd6cd18de9b20a85c0bbbcd0df4e497743a132d (commit)
via 479aa841b36246aa16e4cf77f78cdb8b93bc8de1 (commit)
via d309809f4f81c4f92b7441a0e4dc1e9e2f27be76 (commit)
via 453f922b16ffa246b32700ce06bf16a1cdffce60 (commit)
via 813f5f4aad5da71c4fcfe6639c9010e1056acf1f (commit)
via cf849fa29c00bf46d7bd5712c00763632f4daecd (commit)
via 5469772c43759b8bde77c3d78450658e266b9cf0 (commit)
via e128fc5885c553c9e9b55f2529d0ea6937e5a6b7 (commit)
via 8cca38ff5e4d05c85dfb137b29c419e5df8299e0 (commit)
via e5b7fb12522636f24d9b23ea587b8d12e13c50c2 (commit)
via 467722fb20db289fa1eb0833e2d87ee56ed91ba7 (commit)
via 7ed41dc0191d366c914850a350c3b30f769365af (commit)
via 90dd1c90fb310834234163711019e2b932c6e396 (commit)
via f61d8bca07c8792dfd6216119ee63c573810963a (commit)
via 7c7dae7f8f4ec4e33acf9302152907547200023d (commit)
via 7d0d61f43be20aec7ff643001fcf940e485d465b (commit)
via 2ada2ce8390db1e22c5f4fc236518640339e9ce5 (commit)
via 3416d60e2b1a51a6a02498e15ec9a9c225e1b4c2 (commit)
via 5cd85a21e20d191f7fb67dd20023196001930928 (commit)
via 5dc1784a06a53777891df5fdea5f1c29da92939b (commit)
via 8abda7cdf322d6b023b15894509ccfd057819c4f (commit)
via 4070335144818d3b797c5ba0e8bfa4fb2f6cffe3 (commit)
via 47e59a35d5ed9b2cdb052894d741972324058505 (commit)
via b18af1fdb7474f525938f66650d2d267b2784ec2 (commit)
via 4f83103fc5cb227d23b40c8a28c497855b2d5f61 (commit)
via 11f2d977836ec3737b23abb1d716cef58b1314f2 (commit)
via 01cea11ce0cb0e8df2907e66c71540658ed02d45 (commit)
via 4fed183482e37ad80e97e841d2f0b825ef0d2570 (commit)
via 4c6b92aa9648eb091a8ed229bcdbeb3f2d75feeb (commit)
via e54da634282d90d4def79ea95802fbf3da68072a (commit)
via 36da431dd8b1f360f60d06165ab640e10d695d18 (commit)
via 57cbcbe7f4403ec4b17450441c74a3a0f23a1380 (commit)
via 71023ae5387402ed6c76948b4886d8d4a606f095 (commit)
via 97b13b759d46c5e8f74150add53b76daa5861120 (commit)
via b8dccb1fa84d699e1220e1a3d57b13085349b5ce (commit)
from 29df5af6f77c1f24593ecda397a56f0632876ce2 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
commit af17604c5a93830380fb50db93ce543926c116cf
Merge: 539f2b1 3a3fc5a
Author: Fuad Muhic <fmuhic at capeannenterprises.com>
Date: Wed Jan 17 17:22:31 2018 +0100
Merge branch 'master' of git.curoverse.com:arvados into 11876-r-sdk
Arvados-DCO-1.1-Signed-off-by: Fuad Muhic <fmuhic at capeannenterprises.com>
commit 539f2b151c57a76c9a8c0d49ef7ee5c0bac39de7
Author: Fuad Muhic <fmuhic at capeannenterprises.com>
Date: Wed Jan 17 17:21:49 2018 +0100
Added unit test for ArvadosFile and Collection classes
Arvados-DCO-1.1-Signed-off-by: Fuad Muhic <fmuhic at capeannenterprises.com>
diff --git a/sdk/R/R/ArvadosFile.R b/sdk/R/R/ArvadosFile.R
index ed642a5..bacbb74 100644
--- a/sdk/R/R/ArvadosFile.R
+++ b/sdk/R/R/ArvadosFile.R
@@ -1,3 +1,5 @@
+source("./R/util.R")
+
#' ArvadosFile Object
#'
#' Update description
@@ -25,16 +27,15 @@ ArvadosFile <- R6::R6Class(
getSizeInBytes = function()
{
- collectionURL <- URLencode(paste0(private$collection$api$getWebDavHostName(),
- "c=", private$collection$uuid))
- fileURL <- paste0(collectionURL, "/", self$getRelativePath());
+ if(is.null(private$collection))
+ return(0)
- headers = list("Authorization" = paste("OAuth2", private$collection$api$getToken()))
+ REST <- private$collection$getRESTService()
- propfindResponse <- private$http$PROPFIND(fileURL, headers)
+ fileSize <- REST$getResourceSize(private$collection$uuid,
+ self$getRelativePath())
- sizes <- private$httpParser$extractFileSizeFromWebDAVResponse(propfindResponse, collectionURL)
- as.numeric(sizes)
+ fileSize
},
get = function(fileLikeObjectName)
@@ -81,124 +82,73 @@ ArvadosFile <- R6::R6Class(
if(offset < 0 || length < 0)
stop("Offset and length must be positive values.")
- if(!(contentType %in% private$http$validContentTypes))
- stop("Invalid contentType. Please use text or raw.")
-
- range = paste0("bytes=", offset, "-")
-
- if(length > 0)
- range = paste0(range, offset + length - 1)
+ REST <- private$collection$getRESTService()
- fileURL = paste0(private$collection$api$getWebDavHostName(),
- "c=", private$collection$uuid, "/", self$getRelativePath());
+ REST$read(private$collection$uuid,
+ self$getRelativePath(),
+ contentType, offset, length)
+ },
- if(offset == 0 && length == 0)
+ connection = function(rw)
+ {
+ if (rw == "r")
{
- headers <- list(Authorization = paste("OAuth2",
- private$collection$api$getToken()))
+ return(textConnection(self$read("text")))
}
- else
+ else if (rw == "w")
{
- headers <- list(Authorization = paste("OAuth2", private$collection$api$getToken()),
- Range = range)
- }
-
- serverResponse <- private$http$GET(fileURL, headers)
-
- if(serverResponse$status_code < 200 || serverResponse$status_code >= 300)
- stop(paste("Server code:", serverResponse$status_code))
+ private$buffer <- textConnection(NULL, "w")
- parsedServerResponse <- httr::content(serverResponse, contentType)
- parsedServerResponse
+ return(private$buffer)
+ }
},
- connection = function(rw)
- {
- if (rw == "r") {
- return(textConnection(self$read("text")))
- } else if (rw == "w") {
- private$buffer <- textConnection(NULL, "w")
- return(private$buffer)
- }
- },
-
- flush = function() {
- v <- textConnectionValue(private$buffer)
- close(private$buffer)
- self$write(paste(v, collapse='\n'))
- },
+ flush = function()
+ {
+ v <- textConnectionValue(private$buffer)
+ close(private$buffer)
+ self$write(paste(v, collapse='\n'))
+ },
write = function(content, contentType = "text/html")
{
if(is.null(private$collection))
stop("ArvadosFile doesn't belong to any collection.")
- fileURL = paste0(private$collection$api$getWebDavHostName(),
- "c=", private$collection$uuid, "/", self$getRelativePath());
- headers <- list(Authorization = paste("OAuth2", private$collection$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))
+ REST <- private$collection$getRESTService()
- parsedServerResponse <- httr::content(serverResponse, "text")
- parsedServerResponse
+ result <- REST$write(private$collection$uuid,
+ self$getRelativePath(),
+ content, contentType)
},
- move = function(newLocation)
+ move = function(newLocationInCollection)
{
- #todo test if file can be moved
-
if(is.null(private$collection))
- stop("ArvadosFile doesn't belong to any collection.")
+ stop("ArvadosFile 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))
- {
- newLocation <- substr(newLocation, 0,
- nchar(newLocation) - nchar(private$name))
- }
- else
- {
- stop("Destination path is not valid.")
- }
+ 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")
}
childWithSameName <- newParent$get(private$name)
if(!is.null(childWithSameName))
- stop("Destination already contains file with same name.")
+ stop("Destination already contains content with same name.")
REST <- private$collection$getRESTService()
- status <- REST$move(self$getRelativePath(),
- paste0(newParent$getRelativePath(),
- "/", self$getName()),
- private$collection$uuid)
+ 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.
- parentsCollection <- newParent$getCollection()
- newParent$setCollection(NULL, setRecursively = FALSE)
-
- newParent$add(self)
-
- newParent$setCollection(parentsCollection, setRecursively = FALSE)
-
- private$parent <- newParent
+ private$dettachFromCurrentParent()
+ private$attachToNewParent(newParent)
"Content moved successfully."
}
@@ -212,7 +162,34 @@ ArvadosFile <- R6::R6Class(
collection = NULL,
http = NULL,
httpParser = NULL,
- buffer = NULL
+ buffer = NULL,
+
+ 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)
+ }
),
cloneable = FALSE
diff --git a/sdk/R/R/Collection.R b/sdk/R/R/Collection.R
index a0d719a..eb82617 100644
--- a/sdk/R/R/Collection.R
+++ b/sdk/R/R/Collection.R
@@ -48,7 +48,7 @@ Collection <- R6::R6Class(
subcollection <- self$get(relativePath)
}
- if(is.null(subcollection) || !("Subcollection" %in% class(Subcollection)))
+ if(is.null(subcollection))
stop(paste("Subcollection", relativePath, "doesn't exist."))
if("ArvadosFile" %in% class(content) ||
@@ -60,16 +60,15 @@ Collection <- R6::R6Class(
}
else
{
- contentClass <- paste(class(content), collapse = ", ")
- stop(paste("Expected AravodsFile or Subcollection object, got",
- paste0("(", contentClass, ")"), "."))
+ stop(paste0("Expected AravodsFile or Subcollection object, got ",
+ paste0("(", paste0(class(content), collapse = ", "), ")"),
+ "."))
}
},
- #todo collapse 2 parameters in one
create = function(fileNames, relativePath = "")
{
- if(relativePath == "" ||
+ if(relativePath == "" ||
relativePath == "." ||
relativePath == "./")
{
@@ -77,9 +76,7 @@ Collection <- R6::R6Class(
}
else
{
- if(endsWith(relativePath, "/") && nchar(relativePath) > 0)
- relativePath <- substr(relativePath, 1, nchar(relativePath) - 1)
-
+ relativePath <- trimFromEnd(relativePath, "/")
subcollection <- self$get(relativePath)
}
@@ -108,38 +105,33 @@ Collection <- R6::R6Class(
}
else
{
- contentClass <- paste(class(fileNames), collapse = ", ")
- stop(paste("Expected character vector, got",
- paste0("(", contentClass, ")"), "."))
+ stop(paste0("Expected character vector, got ",
+ paste0("(", paste0(class(fileNames), collapse = ", "), ")"),
+ "."))
}
},
- remove = function(content)
+ remove = function(paths)
{
- if(is.character(content))
+ if(is.character(paths))
{
- sapply(content, function(filePath)
+ sapply(paths, function(filePath)
{
- if(endsWith(filePath, "/") && nchar(filePath) > 0)
- filePath <- substr(filePath, 1, nchar(filePath) - 1)
-
+ filePath <- trimFromEnd(filePath, "/")
file <- self$get(filePath)
if(is.null(file))
stop(paste("File", filePath, "doesn't exist."))
parent <- file$getParent()
- parent$remove(filePath)
+ parent$remove(file$getName())
})
}
- else if("ArvadosFile" %in% class(content) ||
- "Subcollection" %in% class(content))
+ else
{
- if(is.null(content$getCollection()) ||
- content$getCollection()$uuid != self$uuid)
- stop("Subcollection doesn't belong to this collection.")
-
- content$removeFromCollection()
+ stop(paste0("Expected character vector, got ",
+ paste0("(", paste0(class(paths), collapse = ", "), ")"),
+ "."))
}
},
diff --git a/sdk/R/R/RESTService.R b/sdk/R/R/RESTService.R
index d65ef0f..de232ad 100644
--- a/sdk/R/R/RESTService.R
+++ b/sdk/R/R/RESTService.R
@@ -56,7 +56,7 @@ RESTService <- R6::R6Class(
{
collectionURL <- URLencode(paste0(private$api$getWebDavHostName(), "c=", uuid))
- headers = list("Authorization" = paste("OAuth2", private$api$getToken()))
+ headers <- list("Authorization" = paste("OAuth2", private$api$getToken()))
response <- private$http$PROPFIND(collectionURL, headers)
@@ -64,23 +64,71 @@ RESTService <- R6::R6Class(
parsedResponse[-1]
},
- getResourceSize = function(uuid, relativePathToResource)
+ getResourceSize = function(uuid, relativePath)
{
collectionURL <- URLencode(paste0(private$api$getWebDavHostName(),
"c=", uuid))
- subcollectionURL <- paste0(collectionURL, "/",
- relativePathToResource, "/");
- headers = list("Authorization" = paste("OAuth2",
+ subcollectionURL <- paste0(collectionURL, "/", relativePath);
+
+ 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])
+ as.numeric(sizes)
+ },
+
+ read = function(uuid, relativePath, contentType = "raw", offset = 0, length = 0)
+ {
+ fileURL <- paste0(private$api$getWebDavHostName(),
+ "c=", uuid, "/", relativePath);
+
+ range <- paste0("bytes=", offset, "-")
+
+ if(length > 0)
+ range = paste0(range, offset + length - 1)
+
+ if(offset == 0 && length == 0)
+ {
+ headers <- list(Authorization = paste("OAuth2", private$api$getToken()))
+ }
+ else
+ {
+ headers <- list(Authorization = paste("OAuth2", private$api$getToken()),
+ Range = range)
+ }
+
+ if(!(contentType %in% private$http$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
+ },
+
+ write = function(uuid, relativePath, content, contentType)
+ {
+ fileURL <- paste0(private$api$getWebDavHostName(),
+ "c=", uuid, "/", relativePath);
+ headers <- list(Authorization = paste("OAuth2", private$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))
- return(sum(sizes))
+ parsedServerResponse <- httr::content(serverResponse, "text")
+ parsedServerResponse
}
),
diff --git a/sdk/R/R/Subcollection.R b/sdk/R/R/Subcollection.R
index 38c3ad0..5babc66 100644
--- a/sdk/R/R/Subcollection.R
+++ b/sdk/R/R/Subcollection.R
@@ -1,3 +1,5 @@
+source("./R/util.R")
+
#' Arvados SubCollection Object
#'
#' Update description
@@ -120,17 +122,14 @@ Subcollection <- R6::R6Class(
getSizeInBytes = function()
{
- if(!is.null(private$collection))
- {
- REST <- private$collection$getRESTService()
- subcollectionSize <- REST$getResourceSize(private$collection$uuid,
- self$getRelativePath())
- return(subcollectionSize)
- }
- else
- {
+ if(is.null(private$collection))
return(0)
- }
+
+ REST <- private$collection$getRESTService()
+
+ fileSizes <- REST$getResourceSize(private$collection$uuid,
+ paste0(self$getRelativePath(), "/"))
+ return(sum(fileSizes))
},
move = function(newLocationInCollection)
@@ -148,6 +147,11 @@ Subcollection <- R6::R6Class(
stop("Unable to get destination subcollection")
}
+ childWithSameName <- newParent$get(private$name)
+
+ if(!is.null(childWithSameName))
+ stop("Destination already contains content with same name.")
+
REST <- private$collection$getRESTService()
REST$move(self$getRelativePath(),
paste0(newParent$getRelativePath(), "/", self$getName()),
diff --git a/sdk/R/README b/sdk/R/README
index d0e570c..bc02195 100644
--- a/sdk/R/README
+++ b/sdk/R/README
@@ -90,13 +90,13 @@ arvadosSubcollection <- collection$get("location/to/my/directory/")
#Read a table
-arvadosFile <- collection$get("myinput.txt")
+arvadosFile <- collection$get("myinput.txt")
arvConnection <- arvadosFile$connection("r")
-mytable <- read.table(arvConnection)
+mytable <- read.table(arvConnection)
#Write a table
-arvadosFile <- collection$create("myoutput.txt")
+arvadosFile <- collection$create("myoutput.txt")
arvConnection <- arvadosFile$connection("w")
write.table(mytable, arvConnection)
arvadosFile$flush()
@@ -132,7 +132,7 @@ fileList <- collection$create(c("main.cpp", lib.dll), "cpp/src/")
#Add existing ArvadosFile or Subcollection to a collection
folder <- Subcollection$new("src")
-file <- ArvadosFile$new("main.cpp")
+file <- ArvadosFile$new("main.cpp")
folder$add(file)
collection$add(folder, "cpp")
diff --git a/sdk/R/tests/testthat/fakes/FakeRESTService.R b/sdk/R/tests/testthat/fakes/FakeRESTService.R
index b13c71b..3baea0b 100644
--- a/sdk/R/tests/testthat/fakes/FakeRESTService.R
+++ b/sdk/R/tests/testthat/fakes/FakeRESTService.R
@@ -4,20 +4,27 @@ FakeRESTService <- R6::R6Class(
public = list(
- createCallCount = NULL,
- deleteCallCount = NULL,
- moveCallCount = NULL,
- getResourceSizeCallCount = NULL,
+ createCallCount = NULL,
+ deleteCallCount = NULL,
+ moveCallCount = NULL,
+ getCollectionContentCallCount = NULL,
+ getResourceSizeCallCount = NULL,
+ readCallCount = NULL,
+ writeCallCount = NULL,
+ writeBuffer = NULL,
collectionContent = NULL,
returnContent = NULL,
initialize = function(collectionContent = NULL, returnContent = NULL)
{
- self$createCallCount <- 0
- self$deleteCallCount <- 0
- self$moveCallCount <- 0
- self$getResourceSizeCallCount <- 0
+ self$createCallCount <- 0
+ self$deleteCallCount <- 0
+ self$moveCallCount <- 0
+ self$getCollectionContentCallCount <- 0
+ self$getResourceSizeCallCount <- 0
+ self$readCallCount <- 0
+ self$writeCallCount <- 0
self$collectionContent <- collectionContent
self$returnContent <- returnContent
@@ -44,6 +51,7 @@ FakeRESTService <- R6::R6Class(
getCollectionContent = function(uuid)
{
+ self$getCollectionContentCallCount <- self$getCollectionContentCallCount + 1
self$collectionContent
},
@@ -51,6 +59,19 @@ FakeRESTService <- R6::R6Class(
{
self$getResourceSizeCallCount <- self$getResourceSizeCallCount + 1
self$returnContent
+ },
+
+ read = function(uuid, relativePath, contentType = "text", offset = 0, length = 0)
+ {
+ self$readCallCount <- self$readCallCount + 1
+ self$returnContent
+ },
+
+ write = function(uuid, relativePath, content, contentType)
+ {
+ self$writeBuffer <- content
+ self$writeCallCount <- self$writeCallCount + 1
+ self$returnContent
}
),
diff --git a/sdk/R/tests/testthat/test-ArvadosFile.R b/sdk/R/tests/testthat/test-ArvadosFile.R
new file mode 100644
index 0000000..fbf7acb
--- /dev/null
+++ b/sdk/R/tests/testthat/test-ArvadosFile.R
@@ -0,0 +1,287 @@
+source("fakes/FakeRESTService.R")
+
+context("ArvadosFile")
+
+test_that("getFileListing always returns file name", {
+
+ dog <- ArvadosFile$new("dog")
+
+ expect_that(dog$getFileListing(), equals("dog"))
+})
+
+test_that("get always returns NULL", {
+
+ dog <- ArvadosFile$new("dog")
+
+ responseIsNull <- is.null(dog$get("something"))
+ expect_that(responseIsNull, is_true())
+})
+
+test_that("getFirst always returns NULL", {
+
+ dog <- ArvadosFile$new("dog")
+
+ responseIsNull <- is.null(dog$getFirst())
+ expect_that(responseIsNull, is_true())
+})
+
+test_that(paste("getSizeInBytes returns zero if arvadosFile",
+ "is not part of a collection"), {
+
+ dog <- ArvadosFile$new("dog")
+
+ expect_that(dog$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")
+ fish <- collection$get("animal/fish")
+
+ resourceSize <- fish$getSizeInBytes()
+
+ expect_that(resourceSize, equals(100))
+})
+
+test_that("getRelativePath returns path relative to the tree root", {
+
+ animal <- Subcollection$new("animal")
+ fish <- Subcollection$new("fish")
+ shark <- ArvadosFile$new("shark")
+
+ animal$add(fish)
+ fish$add(shark)
+
+ expect_that(shark$getRelativePath(), equals("animal/fish/shark"))
+})
+
+test_that("read raises exception if file doesn't belong to a collection", {
+
+ dog <- ArvadosFile$new("dog")
+
+ expect_that(dog$read(),
+ throws_error("ArvadosFile doesn't belong to any collection."))
+})
+
+test_that("read raises exception offset or length is negative number", {
+
+ 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")
+ fish <- collection$get("animal/fish")
+
+ expect_that(fish$read(contentType = "text", offset = -1),
+ throws_error("Offset and length must be positive values."))
+ expect_that(fish$read(contentType = "text", length = -1),
+ throws_error("Offset and length must be positive values."))
+ expect_that(fish$read(contentType = "text", offset = -1, length = -1),
+ throws_error("Offset and length must be positive values."))
+})
+
+test_that("read delegates reading operation to REST service class", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal", "animal/fish")
+ readContent <- "my file"
+
+ fakeREST <- FakeRESTService$new(collectionContent, readContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ fish <- collection$get("animal/fish")
+
+ fileContent <- fish$read("text")
+
+ expect_that(fileContent, equals("my file"))
+ expect_that(fakeREST$readCallCount, equals(1))
+})
+
+test_that(paste("connect returns textConnection opened",
+ "in read mode when 'r' is passed as argument"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal", "animal/fish")
+ readContent <- "file content"
+
+ fakeREST <- FakeRESTService$new(collectionContent, readContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ fish <- collection$get("animal/fish")
+
+ connection <- fish$connection("r")
+
+ expect_that(readLines(connection), equals("file content"))
+})
+
+test_that(paste("connect returns textConnection opened",
+ "in write mode when 'w' is passed as argument"), {
+
+ 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")
+ fish <- collection$get("animal/fish")
+
+ connection <- fish$connection("w")
+
+ writeLines("file", connection)
+ writeLines("content", connection)
+
+ writeResult <- textConnectionValue(connection)
+
+ expect_that(writeResult[1], equals("file"))
+ expect_that(writeResult[2], equals("content"))
+})
+
+test_that("flush sends data stored in a connection to a REST server", {
+
+ 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")
+ fish <- collection$get("animal/fish")
+
+ connection <- fish$connection("w")
+
+ writeLines("file content", connection)
+
+ fish$flush()
+
+ expect_that(fakeREST$writeBuffer, equals("file content"))
+})
+
+test_that("write raises exception if file doesn't belong to a collection", {
+
+ dog <- ArvadosFile$new("dog")
+
+ expect_that(dog$write(),
+ throws_error("ArvadosFile doesn't belong to any collection."))
+})
+
+test_that("write delegates writing operation to REST service class", {
+
+ 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")
+ fish <- collection$get("animal/fish")
+
+ fileContent <- fish$write("new file content")
+
+ expect_that(fakeREST$writeBuffer, equals("new file content"))
+})
+
+test_that(paste("move raises exception if arvados file",
+ "doesn't belong to any collection"), {
+
+ animal <- ArvadosFile$new("animal")
+
+ expect_that(animal$move("new/location"),
+ throws_error("ArvadosFile 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 raises exception if new location contains content with the same name", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "animal/dog",
+ "animal/fish/shark",
+ "dog")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ dog <- collection$get("animal/dog")
+
+ expect_that(dog$move("dog"),
+ throws_error("Destination already contains content with same name."))
+
+})
+
+test_that("move moves arvados file 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")
+ dog <- collection$get("animal/dog")
+
+ dog$move("dog")
+ dogIsNullOnOldLocation <- is.null(collection$get("animal/dog"))
+ dogExistsOnNewLocation <- !is.null(collection$get("dog"))
+
+ expect_that(dogIsNullOnOldLocation, is_true())
+ expect_that(dogExistsOnNewLocation, is_true())
+})
diff --git a/sdk/R/tests/testthat/test-Collection.R b/sdk/R/tests/testthat/test-Collection.R
new file mode 100644
index 0000000..1249483
--- /dev/null
+++ b/sdk/R/tests/testthat/test-Collection.R
@@ -0,0 +1,296 @@
+source("fakes/FakeRESTService.R")
+
+context("Collection")
+
+test_that(paste("constructor creates file tree from text content",
+ "retreived form REST service"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ root <- collection$get("")
+
+ expect_that(fakeREST$getCollectionContentCallCount, equals(1))
+ expect_that(root$getName(), equals(""))
+})
+
+test_that(paste("add raises exception if passed argumet is not",
+ "ArvadosFile or Subcollection"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ newNumber <- 10
+
+ expect_that(collection$add(newNumber),
+ throws_error(paste("Expected AravodsFile or Subcollection",
+ "object, got (numeric)."), fixed = TRUE))
+})
+
+test_that("add raises exception if relative path is not valid", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ newPen <- ArvadosFile$new("pen")
+
+ expect_that(collection$add(newPen, "objects"),
+ throws_error("Subcollection objects doesn't exist.",
+ fixed = TRUE))
+})
+
+test_that(paste("add adds ArvadosFile or Subcollection",
+ "to local tree structure and remote REST service"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ newDog <- ArvadosFile$new("dog")
+ collection$add(newDog, "animal")
+
+ dog <- collection$get("animal/dog")
+ dogExistsInCollection <- !is.null(dog) && dog$getName() == "dog"
+
+ expect_that(dogExistsInCollection, is_true())
+ expect_that(fakeREST$createCallCount, equals(1))
+})
+
+test_that("create raises exception if passed argumet is not character vector", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ expect_that(collection$create(10),
+ throws_error("Expected character vector, got (numeric).",
+ fixed = TRUE))
+})
+
+test_that("create raises exception if relative path is not valid", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ newPen <- ArvadosFile$new("pen")
+
+ expect_that(collection$create(newPen, "objects"),
+ throws_error("Subcollection objects doesn't exist.",
+ fixed = TRUE))
+})
+
+test_that(paste("create adds files specified by fileNames",
+ "to local tree structure and remote REST service"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ files <- c("dog", "cat")
+ collection$create(files, "animal")
+
+ dog <- collection$get("animal/dog")
+ cat <- collection$get("animal/cat")
+ dogExistsInCollection <- !is.null(dog) && dog$getName() == "dog"
+ catExistsInCollection <- !is.null(cat) && cat$getName() == "cat"
+
+ expect_that(dogExistsInCollection, is_true())
+ expect_that(catExistsInCollection, is_true())
+ expect_that(fakeREST$createCallCount, equals(2))
+})
+
+test_that("remove raises exception if passed argumet is not character vector", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ expect_that(collection$remove(10),
+ throws_error("Expected character vector, got (numeric).",
+ fixed = TRUE))
+})
+
+test_that(paste("remove removes files specified by paths",
+ "from local tree structure and from remote REST service"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "animal/dog",
+ "animal/cat",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ collection$remove(c("animal/dog", "animal/cat"))
+
+ dog <- collection$get("animal/dog")
+ cat <- collection$get("animal/dog")
+ dogExistsInCollection <- !is.null(dog) && dog$getName() == "dog"
+ catExistsInCollection <- !is.null(cat) && cat$getName() == "cat"
+
+ expect_that(dogExistsInCollection, is_false())
+ expect_that(catExistsInCollection, is_false())
+ expect_that(fakeREST$deleteCallCount, equals(2))
+})
+
+test_that(paste("move moves content to a new location inside file tree",
+ "and on REST service"), {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/dog",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ collection$move("animal/dog", "dog")
+
+ dogIsNullOnOldLocation <- is.null(collection$get("animal/dog"))
+ dogExistsOnNewLocation <- !is.null(collection$get("dog"))
+
+ expect_that(dogIsNullOnOldLocation, is_true())
+ expect_that(dogExistsOnNewLocation, is_true())
+ expect_that(fakeREST$moveCallCount, equals(1))
+})
+
+test_that("move raises exception if new location is not valid", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ expect_that(collection$move("fish", "object"),
+ throws_error("Element you want to move doesn't exist in the collection.",
+ fixed = TRUE))
+})
+
+test_that("getFileListing returns collection content received from REST service", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ contentMatchExpected <- all(collection$getFileListing() ==
+ c("animal", "animal/fish", "ball"))
+
+ expect_that(contentMatchExpected, is_true())
+ #2 calls because Collection$new calls getFileListing once
+ expect_that(fakeREST$getCollectionContentCallCount, equals(2))
+
+})
+
+test_that("get returns arvados file or subcollection from internal tree structure", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "ball")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+
+ fish <- collection$get("animal/fish")
+ fishIsNotNull <- !is.null(fish)
+
+ expect_that(fishIsNotNull, is_true())
+ expect_that(fish$getName(), equals("fish"))
+})
diff --git a/sdk/R/tests/testthat/test-CollectionTree.R b/sdk/R/tests/testthat/test-CollectionTree.R
index 40551a2..42a54bf 100644
--- a/sdk/R/tests/testthat/test-CollectionTree.R
+++ b/sdk/R/tests/testthat/test-CollectionTree.R
@@ -1,6 +1,6 @@
context("CollectionTree")
-test_that("Creates file tree from character array properly", {
+test_that("constructor creates file tree from character array properly", {
collection <- "myCollection"
characterArray <- c("animal",
diff --git a/sdk/R/tests/testthat/test-Subcollection.R b/sdk/R/tests/testthat/test-Subcollection.R
index 45d0b02..3572044 100644
--- a/sdk/R/tests/testthat/test-Subcollection.R
+++ b/sdk/R/tests/testthat/test-Subcollection.R
@@ -2,7 +2,7 @@ source("fakes/FakeRESTService.R")
context("Subcollection")
-test_that("getRelativePath returns relative path properly", {
+test_that("getRelativePath returns path relative to the tree root", {
animal <- Subcollection$new("animal")
@@ -263,6 +263,28 @@ test_that(paste("move raises exception if subcollection",
throws_error("Subcollection doesn't belong to any collection"))
})
+test_that("move raises exception if new location contains content with the same name", {
+
+ api <- Arvados$new("myToken", "myHostName")
+ api$setHttpClient(FakeHttpRequest$new())
+ api$setHttpParser(FakeHttpParser$new())
+
+ collectionContent <- c("animal",
+ "animal/fish",
+ "animal/dog",
+ "animal/fish/shark",
+ "fish")
+
+ fakeREST <- FakeRESTService$new(collectionContent)
+ api$setRESTService(fakeREST)
+ collection <- Collection$new(api, "myUUID")
+ fish <- collection$get("animal/fish")
+
+ expect_that(fish$move("fish"),
+ throws_error("Destination already contains content with same name."))
+
+})
+
test_that(paste("move raises exception if newLocationInCollection",
"parameter is invalid"), {
@@ -280,9 +302,9 @@ test_that(paste("move raises exception if newLocationInCollection",
api$setRESTService(fakeREST)
collection <- Collection$new(api, "myUUID")
- dog <- collection$get("animal/dog")
+ fish <- collection$get("animal/fish")
- expect_that(dog$move("objects/dog"),
+ expect_that(fish$move("objects/dog"),
throws_error("Unable to get destination subcollection"))
})
commit d25be127db660e0c3c97bf53f8488d73e28b86d3
Merge: 38ceac3 29df5af
Author: Fuad Muhic <fmuhic at capeannenterprises.com>
Date: Wed Jan 17 17:20:49 2018 +0100
Merge branch '11876-r-sdk' of git.curoverse.com:arvados into 11876-r-sdk
Arvados-DCO-1.1-Signed-off-by: Fuad Muhic <fmuhic at capeannenterprises.com>
commit 38ceac30a22ac3c506ca69263ff9e2640e5bd71e
Author: Fuad Muhic <fmuhic at capeannenterprises.com>
Date: Tue Jan 16 14:03:41 2018 +0100
Added unit tests for Subcollection class
Arvados-DCO-1.1-Signed-off-by: Fuad Muhic <fmuhic at capeannenterprises.com>
diff --git a/sdk/R/R/Arvados.R b/sdk/R/R/Arvados.R
index 5515bfd..582a7ab 100644
--- a/sdk/R/R/Arvados.R
+++ b/sdk/R/R/Arvados.R
@@ -1,5 +1,6 @@
source("./R/HttpRequest.R")
source("./R/HttpParser.R")
+source("./R/RESTService.R")
#' Arvados SDK Object
#'
@@ -36,6 +37,7 @@ Arvados <- R6::R6Class(
private$http <- HttpRequest$new()
private$httpParser <- HttpParser$new()
+ private$REST <- RESTService$new(self)
private$token <- token
private$host <- host
private$rawHost <- host_name
@@ -50,6 +52,9 @@ Arvados <- R6::R6Class(
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))
@@ -290,6 +295,7 @@ Arvados <- R6::R6Class(
webDavHostName = NULL,
http = NULL,
httpParser = NULL,
+ REST = NULL,
fetchAllItems = function(resourceURL, filters)
{
diff --git a/sdk/R/R/ArvadosFile.R b/sdk/R/R/ArvadosFile.R
index 2da3db3..ed642a5 100644
--- a/sdk/R/R/ArvadosFile.R
+++ b/sdk/R/R/ArvadosFile.R
@@ -183,9 +183,11 @@ ArvadosFile <- R6::R6Class(
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.
diff --git a/sdk/R/R/Collection.R b/sdk/R/R/Collection.R
index 8bd4655..a0d719a 100644
--- a/sdk/R/R/Collection.R
+++ b/sdk/R/R/Collection.R
@@ -2,6 +2,8 @@ source("./R/Subcollection.R")
source("./R/ArvadosFile.R")
source("./R/HttpRequest.R")
source("./R/HttpParser.R")
+source("./R/RESTService.R")
+source("./R/util.R")
#' Arvados Collection Object
#'
@@ -21,19 +23,20 @@ Collection <- R6::R6Class(
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 == "./")
{
@@ -41,13 +44,11 @@ Collection <- R6::R6Class(
}
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) ||
@@ -65,6 +66,7 @@ Collection <- R6::R6Class(
}
},
+ #todo collapse 2 parameters in one
create = function(fileNames, relativePath = "")
{
if(relativePath == "" ||
@@ -143,8 +145,7 @@ Collection <- R6::R6Class(
move = function(content, newLocation)
{
- if(endsWith(content, "/"))
- content <- substr(content, 0, nchar(content) - 1)
+ content <- trimFromEnd(content, "/")
elementToMove <- self$get(content)
@@ -154,88 +155,26 @@ Collection <- R6::R6Class(
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)
diff --git a/sdk/R/R/HttpRequest.R b/sdk/R/R/HttpRequest.R
index ad153a0..cc4d868 100644
--- a/sdk/R/R/HttpRequest.R
+++ b/sdk/R/R/HttpRequest.R
@@ -26,7 +26,6 @@ HttpRequest <- R6::R6Class(
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)
},
@@ -65,6 +64,7 @@ HttpRequest <- R6::R6Class(
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)
}
diff --git a/sdk/R/R/RESTService.R b/sdk/R/R/RESTService.R
new file mode 100644
index 0000000..d65ef0f
--- /dev/null
+++ b/sdk/R/R/RESTService.R
@@ -0,0 +1,112 @@
+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
+)
diff --git a/sdk/R/R/Subcollection.R b/sdk/R/R/Subcollection.R
index 298ab10..38c3ad0 100644
--- a/sdk/R/R/Subcollection.R
+++ b/sdk/R/R/Subcollection.R
@@ -12,8 +12,6 @@ Subcollection <- R6::R6Class(
initialize = function(name)
{
private$name <- name
- private$http <- HttpRequest$new()
- private$httpParser <- HttpParser$new()
},
getName = function() private$name,
@@ -40,8 +38,8 @@ Subcollection <- R6::R6Class(
{
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))
{
@@ -51,7 +49,8 @@ Subcollection <- R6::R6Class(
else
contentPath <- content$getFileListing()
- private$collection$createFilesOnREST(contentPath)
+ REST <- private$collection$getRESTService()
+ REST$create(contentPath, private$collection$uuid)
content$setCollection(private$collection)
}
@@ -62,9 +61,9 @@ Subcollection <- R6::R6Class(
}
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 = ", "), ")"),
+ "."))
}
},
@@ -75,12 +74,13 @@ Subcollection <- R6::R6Class(
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)
}
@@ -91,17 +91,17 @@ Subcollection <- R6::R6Class(
}
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())
@@ -120,63 +120,43 @@ Subcollection <- R6::R6Class(
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)
@@ -222,8 +202,6 @@ Subcollection <- R6::R6Class(
children = NULL,
parent = NULL,
collection = NULL,
- http = NULL,
- httpParser = NULL,
removeChild = function(name)
{
@@ -239,6 +217,33 @@ Subcollection <- R6::R6Class(
}
}
}
+ },
+
+ 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)
}
),
diff --git a/sdk/R/tests/testthat/fakes/FakeRESTService.R b/sdk/R/tests/testthat/fakes/FakeRESTService.R
new file mode 100644
index 0000000..b13c71b
--- /dev/null
+++ b/sdk/R/tests/testthat/fakes/FakeRESTService.R
@@ -0,0 +1,58 @@
+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
+)
diff --git a/sdk/R/tests/testthat/test-Subcollection.R b/sdk/R/tests/testthat/test-Subcollection.R
index e69de29..45d0b02 100644
--- a/sdk/R/tests/testthat/test-Subcollection.R
+++ b/sdk/R/tests/testthat/test-Subcollection.R
@@ -0,0 +1,340 @@
+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))
+})
-----------------------------------------------------------------------
hooks/post-receive
--
More information about the arvados-commits
mailing list