*#*
.DS_Store
.vscode
+.Rproj.user
--- /dev/null
+^.*\.Rproj$
+^\.Rproj\.user$
--- /dev/null
+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 4
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX
+
+AutoAppendNewline: Yes
+StripTrailingWhitespace: Yes
+
+BuildType: Package
+PackageUseDevtools: Yes
+PackageInstallArgs: --no-multiarch --with-keep.source
--- /dev/null
+Package: ArvadosR
+Type: Package
+Title: Arvados R SDK
+Version: 0.0.1
+Author: Fuad Muhic
+Maintainer: Ward Vandewege <wvandewege@veritasgenetics.com>
+Description: This is the Arvados R SDK
+URL: http://doc.arvados.org
+License: Apache-2.0
+Encoding: UTF-8
+LazyData: true
+RoxygenNote: 6.0.1.9000
+Imports:
+ R6,
+ httr,
+ stringr,
+ jsonlite,
+ curl,
+ XML
+Suggests: testthat
--- /dev/null
+# Generated by roxygen2: do not edit by hand
+
+export(Arvados)
+export(ArvadosFile)
+export(Collection)
+export(CollectionTree)
+export(Subcollection)
--- /dev/null
+source("./R/HttpRequest.R")
+source("./R/HttpParser.R")
+
+#' Arvados SDK Object
+#'
+#' All Arvados logic is inside this class
+#'
+#' @field token Token represents user authentification token.
+#' @field host Host represents server name we wish to connect to.
+#' @examples arv = Arvados$new("token", "host_name")
+#' @export Arvados
+Arvados <- R6::R6Class(
+
+ "Arvados",
+
+ public = list(
+
+ initialize = function(auth_token = NULL, host_name = NULL)
+ {
+ if(!is.null(host_name))
+ Sys.setenv(ARVADOS_API_HOST = host_name)
+
+ if(!is.null(auth_token))
+ Sys.setenv(ARVADOS_API_TOKEN = auth_token)
+
+ host <- Sys.getenv("ARVADOS_API_HOST");
+ token <- Sys.getenv("ARVADOS_API_TOKEN");
+
+ if(host == "" | token == "")
+ stop(paste0("Please provide host name and authentification token",
+ " or set ARVADOS_API_HOST and ARVADOS_API_TOKEN",
+ " environmental variables."))
+
+ version <- "v1"
+ host <- paste0("https://", host, "/arvados/", version, "/")
+
+ private$http <- HttpRequest$new()
+ private$httpParser <- HttpParser$new()
+ private$token <- token
+ private$host <- host
+ private$rawHost <- host_name
+ },
+
+ getToken = function() private$token,
+ getHostName = function() private$host,
+
+ getHttpClient = function() private$http,
+ setHttpClient = function(newClient) private$http <- newClient,
+
+ getHttpParser = function() private$httpParser,
+ setHttpParser = function(newParser) private$httpParser <- newParser,
+
+ getWebDavHostName = function()
+ {
+ if(is.null(private$webDavHostName))
+ {
+ discoveryDocumentURL <- paste0("https://", private$rawHost,
+ "/discovery/v1/apis/arvados/v1/rest")
+
+ headers <- list(Authorization = paste("OAuth2", private$token))
+
+ serverResponse <- private$http$GET(discoveryDocumentURL, headers)
+
+ discoveryDocument <- private$httpParser$parseJSONResponse(serverResponse)
+ private$webDavHostName <- discoveryDocument$keepWebServiceUrl
+
+ if(is.null(private$webDavHostName))
+ stop("Unable to find WebDAV server.")
+ }
+
+ private$webDavHostName
+ },
+
+ getCollection = function(uuid)
+ {
+ collectionURL <- paste0(private$host, "collections/", uuid)
+ headers <- list(Authorization = paste("OAuth2", private$token))
+
+ serverResponse <- private$http$GET(collectionURL, headers)
+
+ collection <- private$httpParser$parseJSONResponse(serverResponse)
+
+ if(!is.null(collection$errors))
+ stop(collection$errors)
+
+ collection
+ },
+
+ listCollections = function(filters = NULL, limit = 100, offset = 0)
+ {
+ collectionURL <- paste0(private$host, "collections")
+ headers <- list(Authorization = paste("OAuth2", private$token))
+
+ if(!is.null(filters))
+ names(filters) <- c("collection")
+
+ serverResponse <- private$http$GET(collectionURL, headers, filters,
+ limit, offset)
+
+ collections <- private$httpParser$parseJSONResponse(serverResponse)
+
+ if(!is.null(collections$errors))
+ stop(collections$errors)
+
+ collections
+ },
+
+ listAllCollections = function(filters = NULL)
+ {
+ if(!is.null(filters))
+ names(filters) <- c("collection")
+
+ collectionURL <- paste0(private$host, "collections")
+ private$fetchAllItems(collectionURL, filters)
+ },
+
+ deleteCollection = function(uuid)
+ {
+ collectionURL <- paste0(private$host, "collections/", uuid)
+ headers <- list("Authorization" = paste("OAuth2", private$token),
+ "Content-Type" = "application/json")
+
+ serverResponse <- private$http$DELETE(collectionURL, headers)
+
+ collection <- private$httpParser$parseJSONResponse(serverResponse)
+
+ if(!is.null(collection$errors))
+ stop(collection$errors)
+
+ collection
+ },
+
+ updateCollection = function(uuid, newContent)
+ {
+ collectionURL <- paste0(private$host, "collections/", uuid)
+ headers <- list("Authorization" = paste("OAuth2", private$token),
+ "Content-Type" = "application/json")
+
+ body <- list(list())
+ names(body) <- c("collection")
+ body$collection <- newContent
+
+ body <- jsonlite::toJSON(body, auto_unbox = T)
+
+ serverResponse <- private$http$PUT(collectionURL, headers, body)
+
+ collection <- private$httpParser$parseJSONResponse(serverResponse)
+
+ if(!is.null(collection$errors))
+ stop(collection$errors)
+
+ collection
+ },
+
+ createCollection = function(content)
+ {
+ collectionURL <- paste0(private$host, "collections")
+ headers <- list("Authorization" = paste("OAuth2", private$token),
+ "Content-Type" = "application/json")
+
+ body <- list(list())
+ names(body) <- c("collection")
+ body$collection <- content
+
+ body <- jsonlite::toJSON(body, auto_unbox = T)
+
+ serverResponse <- private$http$POST(collectionURL, headers, body)
+
+ collection <- private$httpParser$parseJSONResponse(serverResponse)
+
+ if(!is.null(collection$errors))
+ stop(collection$errors)
+
+ collection
+ },
+
+ getProject = function(uuid)
+ {
+ projectURL <- paste0(private$host, "groups/", uuid)
+ headers <- list(Authorization = paste("OAuth2", private$token))
+
+ serverResponse <- private$http$GET(projectURL, headers)
+
+ project <- private$httpParser$parseJSONResponse(serverResponse)
+
+ if(!is.null(project$errors))
+ stop(project$errors)
+
+ project
+ },
+
+ createProject = function(content)
+ {
+ projectURL <- paste0(private$host, "groups")
+ headers <- list("Authorization" = paste("OAuth2", private$token),
+ "Content-Type" = "application/json")
+
+ body <- list(list())
+ names(body) <- c("group")
+ body$group <- c("group_class" = "project", content)
+ body <- jsonlite::toJSON(body, auto_unbox = T)
+
+ serverResponse <- private$http$POST(projectURL, headers, body)
+
+ project <- private$httpParser$parseJSONResponse(serverResponse)
+
+ if(!is.null(project$errors))
+ stop(project$errors)
+
+ project
+ },
+
+ updateProject = function(uuid, newContent)
+ {
+ projectURL <- paste0(private$host, "groups/", uuid)
+ headers <- list("Authorization" = paste("OAuth2", private$token),
+ "Content-Type" = "application/json")
+
+ body <- list(list())
+ names(body) <- c("group")
+ body$group <- newContent
+ body <- jsonlite::toJSON(body, auto_unbox = T)
+
+ serverResponse <- private$http$PUT(projectURL, headers, body)
+
+ project <- private$httpParser$parseJSONResponse(serverResponse)
+
+ if(!is.null(project$errors))
+ stop(project$errors)
+
+ project
+ },
+
+ listProjects = function(filters = NULL, limit = 100, offset = 0)
+ {
+ projectURL <- paste0(private$host, "groups")
+ headers <- list(Authorization = paste("OAuth2", private$token))
+
+ if(!is.null(filters))
+ names(filters) <- c("groups")
+
+ filters[[length(filters) + 1]] <- list("group_class", "=", "project")
+
+ serverResponse <- private$http$GET(projectURL, headers, filters,
+ limit, offset)
+
+ projects <- private$httpParser$parseJSONResponse(serverResponse)
+
+ if(!is.null(projects$errors))
+ stop(projects$errors)
+
+ projects
+ },
+
+ listAllProjects = function(filters = NULL)
+ {
+ if(!is.null(filters))
+ names(filters) <- c("groups")
+
+ filters[[length(filters) + 1]] <- list("group_class", "=", "project")
+
+ projectURL <- paste0(private$host, "groups")
+
+ private$fetchAllItems(projectURL, filters)
+ },
+
+ deleteProject = function(uuid)
+ {
+ projectURL <- paste0(private$host, "groups/", uuid)
+ headers <- list("Authorization" = paste("OAuth2", private$token),
+ "Content-Type" = "application/json")
+
+ serverResponse <- private$http$DELETE(projectURL, headers)
+
+ project <- private$httpParser$parseJSONResponse(serverResponse)
+
+ if(!is.null(project$errors))
+ stop(project$errors)
+
+ project
+ }
+ ),
+
+ private = list(
+
+ token = NULL,
+ host = NULL,
+ rawHost = NULL,
+ webDavHostName = NULL,
+ http = NULL,
+ httpParser = NULL,
+
+ fetchAllItems = function(resourceURL, filters)
+ {
+ headers <- list(Authorization = paste("OAuth2", private$token))
+
+ offset <- 0
+ itemsAvailable <- .Machine$integer.max
+ items <- c()
+ while(length(items) < itemsAvailable)
+ {
+ serverResponse <- private$http$GET(url = resourceURL,
+ headers = headers,
+ queryFilters = filters,
+ limit = NULL,
+ offset = offset)
+
+ parsedResponse <- private$httpParser$parseJSONResponse(serverResponse)
+
+ if(!is.null(parsedResponse$errors))
+ stop(parsedResponse$errors)
+
+ items <- c(items, parsedResponse$items)
+ offset <- length(items)
+ itemsAvailable <- parsedResponse$items_available
+ }
+
+ items
+ }
+ ),
+
+ cloneable = FALSE
+)
--- /dev/null
+#' ArvadosFile Object
+#'
+#' Update description
+#'
+#' @export ArvadosFile
+ArvadosFile <- R6::R6Class(
+
+ "ArvadosFile",
+
+ public = list(
+
+ initialize = function(name)
+ {
+ private$name <- name
+ private$http <- HttpRequest$new()
+ private$httpParser <- HttpParser$new()
+ },
+
+ getName = function() private$name,
+
+ getFileListing = function(fullpath = TRUE)
+ {
+ self$getName()
+ },
+
+ getSizeInBytes = function()
+ {
+ collectionURL <- URLencode(paste0(private$collection$api$getWebDavHostName(),
+ "c=", private$collection$uuid))
+ fileURL <- paste0(collectionURL, "/", self$getRelativePath());
+
+ headers = list("Authorization" = paste("OAuth2", private$collection$api$getToken()))
+
+ propfindResponse <- private$http$PROPFIND(fileURL, headers)
+
+ sizes <- private$httpParser$extractFileSizeFromWebDAVResponse(propfindResponse, collectionURL)
+ as.numeric(sizes)
+ },
+
+ get = function(fileLikeObjectName)
+ {
+ return(NULL)
+ },
+
+ getFirst = function()
+ {
+ return(NULL)
+ },
+
+ getCollection = function() private$collection,
+
+ setCollection = function(collection)
+ {
+ private$collection <- collection
+ },
+
+ getRelativePath = function()
+ {
+ relativePath <- c(private$name)
+ parent <- private$parent
+
+ while(!is.null(parent))
+ {
+ relativePath <- c(parent$getName(), relativePath)
+ parent <- parent$getParent()
+ }
+
+ relativePath <- relativePath[relativePath != ""]
+ paste0(relativePath, collapse = "/")
+ },
+
+ getParent = function() private$parent,
+
+ setParent = function(newParent) private$parent <- newParent,
+
+ read = function(contentType = "raw", offset = 0, length = 0)
+ {
+ if(is.null(private$collection))
+ stop("ArvadosFile doesn't belong to any collection.")
+
+ 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)
+
+ fileURL = paste0(private$collection$api$getWebDavHostName(),
+ "c=", private$collection$uuid, "/", self$getRelativePath());
+
+ if(offset == 0 && length == 0)
+ {
+ headers <- list(Authorization = paste("OAuth2",
+ private$collection$api$getToken()))
+ }
+ else
+ {
+ 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))
+
+ parsedServerResponse <- httr::content(serverResponse, contentType)
+ parsedServerResponse
+ },
+
+ 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))
+
+ parsedServerResponse <- httr::content(serverResponse, "text")
+ parsedServerResponse
+ },
+
+ move = function(newLocation)
+ {
+ #todo test if file can be moved
+
+ if(is.null(private$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.")
+ }
+
+ newParent <- private$collection$get(newLocation)
+
+ if(is.null(newParent))
+ {
+ stop("Unable to get destination subcollection.")
+ }
+
+ childWithSameName <- newParent$get(private$name)
+
+ if(!is.null(childWithSameName))
+ stop("Destination already contains file with same name.")
+
+ 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)
+
+ private$parent <- newParent
+
+ "Content moved successfully."
+ }
+ ),
+
+ private = list(
+
+ name = NULL,
+ size = NULL,
+ parent = NULL,
+ collection = NULL,
+ http = NULL,
+ httpParser = NULL
+ ),
+
+ cloneable = FALSE
+)
--- /dev/null
+source("./R/Subcollection.R")
+source("./R/ArvadosFile.R")
+source("./R/HttpRequest.R")
+source("./R/HttpParser.R")
+
+#' Arvados Collection Object
+#'
+#' Update description
+#'
+#' @examples arv = Collection$new(api, uuid)
+#' @export Collection
+Collection <- R6::R6Class(
+
+ "Collection",
+
+ public = list(
+
+ api = NULL,
+ uuid = NULL,
+
+ initialize = function(api, uuid)
+ {
+ self$api <- api
+ private$http <- HttpRequest$new()
+ private$httpParser <- HttpParser$new()
+
+ self$uuid <- uuid
+ collection <- self$api$getCollection(uuid)
+
+ private$fileContent <- private$getCollectionContent()
+ private$tree <- CollectionTree$new(private$fileContent, self)
+ },
+
+ add = function(content, relativePath = "")
+ {
+ if(relativePath == "" ||
+ relativePath == "." ||
+ relativePath == "./")
+ {
+ subcollection <- private$tree$getTree()
+ }
+ else
+ {
+ if(endsWith(relativePath, "/") && nchar(relativePath) > 0)
+ relativePath <- substr(relativePath, 1, nchar(relativePath) - 1)
+
+ subcollection <- self$get(relativePath)
+ }
+
+ if(is.null(subcollection))
+ stop(paste("Subcollection", relativePath, "doesn't exist."))
+
+ if("ArvadosFile" %in% class(content) ||
+ "Subcollection" %in% class(content))
+ {
+ subcollection$add(content)
+
+ content
+ }
+ else
+ {
+ contentClass <- paste(class(content), collapse = ", ")
+ stop(paste("Expected AravodsFile or Subcollection object, got",
+ paste0("(", contentClass, ")"), "."))
+ }
+ },
+
+ create = function(fileNames, relativePath = "")
+ {
+ if(relativePath == "" ||
+ relativePath == "." ||
+ relativePath == "./")
+ {
+ subcollection <- private$tree$getTree()
+ }
+ else
+ {
+ if(endsWith(relativePath, "/") && nchar(relativePath) > 0)
+ relativePath <- substr(relativePath, 1, nchar(relativePath) - 1)
+
+ subcollection <- self$get(relativePath)
+ }
+
+ if(is.null(subcollection))
+ stop(paste("Subcollection", relativePath, "doesn't exist."))
+
+ if(is.character(fileNames))
+ {
+ arvadosFiles <- NULL
+ sapply(fileNames, function(fileName)
+ {
+ childWithSameName <- subcollection$get(fileName)
+ if(!is.null(childWithSameName))
+ stop("Destination already contains file with same name.")
+
+ newFile <- ArvadosFile$new(fileName)
+ subcollection$add(newFile)
+
+ arvadosFiles <<- c(arvadosFiles, newFile)
+ })
+
+ if(length(arvadosFiles) == 1)
+ return(arvadosFiles[[1]])
+ else
+ return(arvadosFiles)
+ }
+ else
+ {
+ contentClass <- paste(class(fileNames), collapse = ", ")
+ stop(paste("Expected character vector, got",
+ paste0("(", contentClass, ")"), "."))
+ }
+ },
+
+ remove = function(content)
+ {
+ if(is.character(content))
+ {
+ sapply(content, function(filePath)
+ {
+ if(endsWith(filePath, "/") && nchar(filePath) > 0)
+ filePath <- substr(filePath, 1, nchar(filePath) - 1)
+
+ file <- self$get(filePath)
+
+ if(is.null(file))
+ stop(paste("File", filePath, "doesn't exist."))
+
+ parent <- file$getParent()
+ parent$remove(filePath)
+ })
+ }
+ else if("ArvadosFile" %in% class(content) ||
+ "Subcollection" %in% class(content))
+ {
+ if(is.null(content$getCollection()) ||
+ content$getCollection()$uuid != self$uuid)
+ stop("Subcollection doesn't belong to this collection.")
+
+ content$removeFromCollection()
+ }
+ },
+
+ move = function(content, newLocation)
+ {
+ if(endsWith(content, "/"))
+ content <- substr(content, 0, nchar(content) - 1)
+
+ elementToMove <- self$get(content)
+
+ if(is.null(elementToMove))
+ stop("Element you want to move doesn't exist in the collection.")
+
+ elementToMove$move(newLocation)
+ },
+
+ getFileListing = function() private$getCollectionContent(),
+
+ 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
+ }
+ ),
+
+ private = list(
+
+ http = NULL,
+ httpParser = 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)
+ {
+ splitPath <- unlist(strsplit(filePath$name, "/", fixed = TRUE))
+
+ branch = private$createBranch(splitPath, filePath$fileSize)
+ })
+ }
+ ),
+
+ cloneable = FALSE
+)
--- /dev/null
+source("./R/Subcollection.R")
+
+source("./R/ArvadosFile.R")
+
+#' Arvados Collection Object
+#'
+#' Update description
+#'
+#' @examples arv = Collection$new(api, uuid)
+#' @export CollectionTree
+CollectionTree <- R6::R6Class(
+ "CollectionTree",
+ public = list(
+
+ pathsList = NULL,
+
+ initialize = function(fileContent, collection)
+ {
+ self$pathsList <- fileContent
+
+ treeBranches <- sapply(fileContent, function(filePath)
+ {
+ splitPath <- unlist(strsplit(filePath, "/", fixed = TRUE))
+ branch <- private$createBranch(splitPath)
+ })
+
+ root <- Subcollection$new("")
+
+ sapply(treeBranches, function(branch)
+ {
+ private$addBranch(root, branch)
+ })
+
+ root$setCollection(collection)
+ private$tree <- root
+ },
+
+ getElement = function(relativePath)
+ {
+ if(endsWith(relativePath, "/"))
+ relativePath <- substr(relativePath, 0, nchar(relativePath) - 1)
+
+ splitPath <- unlist(strsplit(relativePath, "/", fixed = TRUE))
+ returnElement <- private$tree
+
+ for(pathFragment in splitPath)
+ {
+ returnElement <- returnElement$get(pathFragment)
+
+ if(is.null(returnElement))
+ return(NULL)
+ }
+
+ returnElement
+ },
+
+ getTree = function() private$tree
+ ),
+
+ private = list(
+
+ tree = NULL,
+
+ createBranch = function(splitPath)
+ {
+ branch <- NULL
+ lastElementIndex <- length(splitPath)
+
+ for(elementIndex in lastElementIndex:1)
+ {
+ if(elementIndex == lastElementIndex)
+ {
+ branch <- ArvadosFile$new(splitPath[[elementIndex]])
+ }
+ else
+ {
+ newFolder <- Subcollection$new(splitPath[[elementIndex]])
+ newFolder$add(branch)
+ branch <- newFolder
+ }
+ }
+
+ branch
+ },
+
+ addBranch = function(container, node)
+ {
+ child <- container$get(node$getName())
+
+ if(is.null(child))
+ {
+ container$add(node)
+ }
+ else
+ {
+ if("ArvadosFile" %in% class(child))
+ {
+ child = private$replaceFileWithSubcollection(child)
+ }
+
+ private$addBranch(child, node$getFirst())
+ }
+ },
+
+ replaceFileWithSubcollection = function(arvadosFile)
+ {
+ subcollection <- Subcollection$new(arvadosFile$getName())
+ fileParent <- arvadosFile$getParent()
+ fileParent$remove(arvadosFile$getName())
+ fileParent$add(subcollection)
+
+ arvadosFile$setParent(NULL)
+
+ subcollection
+ }
+ )
+)
--- /dev/null
+#' HttpParser
+#'
+HttpParser <- R6::R6Class(
+
+ "HttrParser",
+
+ public = list(
+ initialize = function()
+ {
+ },
+
+ parseJSONResponse = function(serverResponse)
+ {
+ parsed_response <- httr::content(serverResponse,
+ as = "parsed",
+ type = "application/json")
+ },
+
+ parseWebDAVResponse = function(response, uri)
+ {
+ text <- rawToChar(response$content)
+ doc <- XML::xmlParse(text, asText=TRUE)
+ base <- paste(paste("/", strsplit(uri, "/")[[1]][-1:-3], sep="", collapse=""), "/", sep="")
+ result <- unlist(
+ XML::xpathApply(doc, "//D:response/D:href", function(node) {
+ sub(base, "", URLdecode(XML::xmlValue(node)), fixed=TRUE)
+ })
+ )
+ result <- result[result != ""]
+ result
+ },
+
+ extractFileSizeFromWebDAVResponse = function(response, uri)
+ {
+ text <- rawToChar(response$content)
+ doc <- XML::xmlParse(text, asText=TRUE)
+
+ base <- paste(paste("/", strsplit(uri, "/")[[1]][-1:-3], sep="", collapse=""), "/", sep="")
+ result <- XML::xpathApply(doc, "//D:response/D:propstat/D:prop/D:getcontentlength", function(node) {
+ XML::xmlValue(node)
+ })
+
+ unlist(result)
+ }
+ )
+)
--- /dev/null
+HttpRequest <- R6::R6Class(
+
+ "HttrRequest",
+
+ public = list(
+
+ validContentTypes = NULL,
+
+ initialize = function()
+ {
+ self$validContentTypes <- c("text", "raw")
+ },
+
+ GET = function(url, headers = NULL, queryFilters = NULL, limit = NULL, offset = NULL)
+ {
+ headers <- httr::add_headers(unlist(headers))
+ query <- private$createQuery(queryFilters, limit, offset)
+ url <- paste0(url, query)
+
+ serverResponse <- httr::GET(url = url, config = headers)
+ },
+
+ PUT = function(url, headers = NULL, body = NULL,
+ queryFilters = NULL, limit = NULL, offset = NULL)
+ {
+ 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)
+ },
+
+ POST = function(url, headers = NULL, body = NULL,
+ queryFilters = NULL, limit = NULL, offset = NULL)
+ {
+ headers <- httr::add_headers(unlist(headers))
+ query <- private$createQuery(queryFilters, limit, offset)
+ url <- paste0(url, query)
+
+ serverResponse <- httr::POST(url = url, config = headers, body = body)
+ },
+
+ DELETE = function(url, headers = NULL, body = NULL,
+ queryFilters = NULL, limit = NULL, offset = NULL)
+ {
+ headers <- httr::add_headers(unlist(headers))
+ query <- private$createQuery(queryFilters, limit, offset)
+ url <- paste0(url, query)
+
+ serverResponse <- httr::DELETE(url = url, config = headers)
+ },
+
+ PROPFIND = function(url, headers = NULL)
+ {
+ h <- curl::new_handle()
+ curl::handle_setopt(h, customrequest = "PROPFIND")
+ curl::handle_setheaders(h, .list = headers)
+
+ propfindResponse <- curl::curl_fetch_memory(url, h)
+ },
+
+ MOVE = function(url, headers = NULL)
+ {
+ h <- curl::new_handle()
+ curl::handle_setopt(h, customrequest = "MOVE")
+ curl::handle_setheaders(h, .list = headers)
+
+ propfindResponse <- curl::curl_fetch_memory(url, h)
+ }
+ ),
+
+ private = list(
+
+ createQuery = function(filters, limit, offset)
+ {
+ finalQuery <- NULL
+
+ if(!is.null(filters))
+ {
+ filters <- sapply(filters, function(filter)
+ {
+ if(length(filter) != 3)
+ stop("Filter list must have exactly 3 elements.")
+
+ attributeAndOperator = filter[c(1, 2)]
+ filterList = filter[[3]]
+ filterListIsPrimitive = TRUE
+ if(length(filterList) > 1)
+ filterListIsPrimitive = FALSE
+
+ attributeAndOperator <- sapply(attributeAndOperator, function(component) {
+ component <- paste0("\"", component, "\"")
+ })
+
+ filterList <- sapply(unlist(filterList), function(filter) {
+ filter <- paste0("\"", filter, "\"")
+ })
+
+ filterList <- paste(filterList, collapse = ",+")
+
+ if(!filterListIsPrimitive)
+ filterList <- paste0("[", filterList, "]")
+
+ filter <- c(attributeAndOperator, filterList)
+
+ queryParameter <- paste(filter, collapse = ",+")
+ queryParameter <- paste0("[", queryParameter, "]")
+
+ })
+
+ filters <- paste(filters, collapse = ",+")
+ filters <- paste0("[", filters, "]")
+
+ encodedQuery <- URLencode(filters, reserved = T, repeated = T)
+
+ encodedQuery <- stringr::str_replace_all(encodedQuery, "%2B", "+")
+
+ finalQuery <- c(finalQuery, paste0("filters=", encodedQuery))
+
+ finalQuery
+ }
+
+ if(!is.null(limit))
+ {
+ if(!is.numeric(limit))
+ stop("Limit must be a numeric type.")
+
+ finalQuery <- c(finalQuery, paste0("limit=", limit))
+ }
+
+ if(!is.null(offset))
+ {
+ if(!is.numeric(offset))
+ stop("Offset must be a numeric type.")
+
+ finalQuery <- c(finalQuery, paste0("offset=", offset))
+ }
+
+ if(length(finalQuery) > 1)
+ {
+ finalQuery <- paste0(finalQuery, collapse = "&")
+ }
+
+ if(!is.null(finalQuery))
+ finalQuery <- paste0("/?", finalQuery)
+
+ finalQuery
+ }
+ ),
+
+ cloneable = FALSE
+)
--- /dev/null
+#' Arvados SubCollection Object
+#'
+#' Update description
+#'
+#' @export Subcollection
+Subcollection <- R6::R6Class(
+
+ "Subcollection",
+
+ public = list(
+
+ initialize = function(name)
+ {
+ private$name <- name
+ private$http <- HttpRequest$new()
+ private$httpParser <- HttpParser$new()
+ },
+
+ getName = function() private$name,
+
+ getRelativePath = function()
+ {
+ relativePath <- c(private$name)
+ parent <- private$parent
+
+ while(!is.null(parent))
+ {
+ relativePath <- c(parent$getName(), relativePath)
+ parent <- parent$getParent()
+ }
+
+ relativePath <- relativePath[relativePath != ""]
+ paste0(relativePath, collapse = "/")
+ },
+
+ add = function(content)
+ {
+ if("ArvadosFile" %in% class(content) ||
+ "Subcollection" %in% class(content))
+ {
+ childWithSameName <- self$get(content$getName())
+ if(!is.null(childWithSameName))
+ stop("Subcollection already contains ArvadosFile
+ or Subcollection with same name.")
+
+ if(!is.null(private$collection))
+ {
+ if(self$getRelativePath() != "")
+ contentPath <- paste0(self$getRelativePath(),
+ "/", content$getFileListing())
+ else
+ contentPath <- content$getFileListing()
+
+ private$collection$createFilesOnREST(contentPath)
+ content$setCollection(private$collection)
+ }
+
+ private$children <- c(private$children, content)
+ content$setParent(self)
+
+ "Content added successfully."
+ }
+ else
+ {
+ stop(paste("Expected AravodsFile or Subcollection object, got",
+ class(content), "."))
+ }
+ },
+
+ remove = function(name)
+ {
+ if(is.character(name))
+ {
+ child <- self$get(name)
+
+ if(is.null(child))
+ stop("Subcollection doesn't contains ArvadosFile
+ or Subcollection with same name.")
+
+ if(!is.null(private$collection))
+ {
+ private$collection$deleteFromREST(child$getRelativePath())
+ child$setCollection(NULL)
+ }
+
+ private$removeChild(name)
+ child$setParent(NULL)
+
+ "Content removed"
+ }
+ else
+ {
+ stop(paste("Expected character, got", class(content), "."))
+ }
+ },
+
+ getFileListing = function(fullpath = TRUE)
+ {
+ content <- NULL
+
+ if(fullpath)
+ {
+ for(child in private$children)
+ content <- c(content, child$getFileListing())
+
+ if(private$name != "")
+ content <- unlist(paste0(private$name, "/", content))
+ }
+ else
+ {
+ for(child in private$children)
+ content <- c(content, child$getName())
+ }
+
+ content
+ },
+
+ 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))
+ {
+ newLocation <- substr(newLocation, 0,
+ nchar(newLocation) - nchar(private$name))
+ }
+ else
+ {
+ stop("Destination path is not valid.")
+ }
+
+ newParent <- private$collection$get(newLocation)
+
+ if(is.null(newParent))
+ {
+ 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)
+
+ private$parent <- newParent
+
+ "Content moved successfully."
+ },
+
+ get = function(name)
+ {
+ for(child in private$children)
+ {
+ if(child$getName() == name)
+ return(child)
+ }
+
+ return(NULL)
+ },
+
+ getFirst = function()
+ {
+ if(length(private$children) == 0)
+ return(NULL)
+
+ private$children[[1]]
+ },
+
+ setCollection = function(collection, setRecursively = TRUE)
+ {
+ private$collection = collection
+
+ if(setRecursively)
+ {
+ for(child in private$children)
+ child$setCollection(collection)
+ }
+ },
+
+ getCollection = function() private$collection,
+
+ getParent = function() private$parent,
+
+ setParent = function(newParent) private$parent <- newParent
+ ),
+
+ private = list(
+
+ name = NULL,
+ children = NULL,
+ parent = NULL,
+ collection = NULL,
+ http = NULL,
+ httpParser = NULL,
+
+ removeChild = function(name)
+ {
+ numberOfChildren = length(private$children)
+ if(numberOfChildren > 0)
+ {
+ for(childIndex in 1:numberOfChildren)
+ {
+ if(private$children[[childIndex]]$getName() == name)
+ {
+ private$children = private$children[-childIndex]
+ return()
+ }
+ }
+ }
+ }
+ ),
+
+ cloneable = FALSE
+)
--- /dev/null
+R SDK for Arvados
+
+This SDK focuses on providing support for accessing Arvados projects, collections, and the files within collections.
+
+The API is not final and feedback is solicited from users on ways in which it could be improved.
+
+INSTALLATION
+
+1. Install the dependencies
+
+ > install.packages(c('R6', 'httr', 'stringr', 'jsonlite', 'curl', 'XML'))
+
+If needed, you may have to install the supporting packages first. On Linux, these are:
+
+ libxml2-dev, libssl-dev, libcurl4-gnutls-dev or libcurl4-openssl-dev
+
+2. Install the ArvardosR package
+
+ > install.packages('/path/to/ArvadosR_0.0.1.tar.gz', repos = NULL, type="source", dependencies = TRUE)
+
+
+EXAMPLES OF USAGE
+
+
+#Load Library and Initialize API:
+
+library('ArvadosR')
+arv <- Arvados$new() # uses environment variables ARVADOS_API_TOKEN and ARVADOS_API_HOST
+arv <- Arvados$new("your Arvados token", "example.arvadosapi.com")
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Get a collection:
+
+arv$getCollection("uuid")
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#List collections:
+collectionList <- arv$listCollections(list(list("name", "like", "Test%"))) # offset of 0 and default limit of 100
+collectionList <- arv$listCollections(list(list("name", "like", "Test%")), limit = 10, offset = 2)
+
+collectionList$items_available # count of total number of items (may be more than returned due to paging)
+collectionList$items # items which match the filter criteria
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Delete a collection:
+
+deletedCollection <- arv$deleteCollection("uuid")
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Update a collection's metadata:
+
+updatedCollection <- arv$updateCollection("uuid", list(name = "My new name", description = "a brand new description"))
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Create collection:
+
+createdCollection <- arv$createCollection(list(name = "Example", description = "This is a test collection"))
+
+
+--------------------------------------------------------------------------------------------------------------------------------
+COLLECTION CONTENT MANIPULATION
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Create collection object:
+
+collection <- Collection$new(arv, "uuid")
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Get file/folder content as character vector
+
+collection$getFileContent()
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#This will return ArvadosFile or Subcollection from internal tree-like structure.
+
+arvadosFile <- collection$get("location/to/my/file.cpp")
+
+#or
+
+arvadosSubcollection <- collection$get("location/to/my/directory/")
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Read whole file or just a portion of it.
+
+fileContent <- arvadosFile$read()
+fileContent <- arvadosFile$read("text")
+fileContent <- arvadosFile$read("raw", offset = 1024, length = 512)
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Get ArvadosFile or Subcollection size
+
+size <- arvadosFile$getSizeInBytes()
+size <- arvadosSubcollection$getSizeInBytes()
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Create new file in a collection
+
+collection$create(fileNames, optionalRelativePath)
+
+#Example
+
+mainFile <- collection$create("main.cpp", "cpp/src/")
+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")
+folder$add(file)
+
+collection$add(folder, "cpp")
+
+#This examples will add file "main.cpp" in "./cpp/src/" folder if folder exists.
+#If subcollection contains more files or folders they will be added recursively.
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Write to existing file (Override current content of the file)
+
+arvadosFile <- collection$get("location/to/my/file.cpp")
+
+arvadosFile$write("This is new file content")
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Delete file from a collection
+
+file <- collection$get("location/to/my/file.cpp")
+
+file$removeFromCollection()
+
+#Or
+
+collection$remove(file)
+
+#Both examples will remove file "file.cpp" from a collection
+#If subcollection contains more files or folders they will be removed recursively.
+
+#You can also remove multiple files
+
+collection$remove(c("path/to/my/file.cpp", "path/to/other/file.cpp"))
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Move file or folder inside collection
+
+file <- collection$get("location/to/my/file.cpp")
+
+file$move("destination/file.cpp")
+
+#Or subcollections
+
+subcollection <- collection$get("location/to/folder")
+
+subcollection$move("destination/folder")
+
+#Make sure to include folder name in destination
+#For example
+#file$move("destination/") will not work
+
+
+--------------------------------------------------------------------------------------------------------------------------------
+WORKING WITH ARVADOS PROJECTS
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Get a project:
+
+arv$getProject("uuid")
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#List projects:
+
+projects <- arv$listProjects(list(list("owner_uuid", "=", "aaaaa-j7d0g-ccccccccccccccc"))) # list subprojects of a project
+arv$listProjects(list(list("name","like","Example%"))) # list projects which have names beginning with Example
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Delete a project:
+
+deletedProject <- arv$deleteProject("uuid")
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Update project:
+
+updatedProject <- arv$updateProject("uuid", list(name = "new_name", description = "new description"))
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Create project:
+
+createdProject <- arv$createProject(list(name = "project_name", description = "project description"))
+
+
+--------------------------------------------------------------------------------------------------------------------------------
+BUILDING THE ARVADOS SDK TARBALL
+--------------------------------------------------------------------------------------------------------------------------------
+
+
+cd arvados/sdk
+R CMD build R
+
+This will create a tarball of the Arvados package in the current directory.
--- /dev/null
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/Arvados.R
+\docType{data}
+\name{Arvados}
+\alias{Arvados}
+\title{Arvados SDK Object}
+\format{An object of class \code{R6ClassGenerator} of length 24.}
+\usage{
+Arvados
+}
+\description{
+All Arvados logic is inside this class
+}
+\section{Fields}{
+
+\describe{
+\item{\code{token}}{Token represents user authentification token.}
+
+\item{\code{host}}{Host represents server name we wish to connect to.}
+}}
+
+\examples{
+arv = Arvados$new("token", "host_name")
+}
+\keyword{datasets}
--- /dev/null
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/ArvadosFile.R
+\docType{data}
+\name{ArvadosFile}
+\alias{ArvadosFile}
+\title{ArvadosFile Object}
+\format{An object of class \code{R6ClassGenerator} of length 24.}
+\usage{
+ArvadosFile
+}
+\description{
+Update description
+}
+\keyword{datasets}
--- /dev/null
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/Collection.R
+\docType{data}
+\name{Collection}
+\alias{Collection}
+\title{Arvados Collection Object}
+\format{An object of class \code{R6ClassGenerator} of length 24.}
+\usage{
+Collection
+}
+\description{
+Update description
+}
+\examples{
+arv = Collection$new(api, uuid)
+}
+\keyword{datasets}
--- /dev/null
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/CollectionTree.R
+\docType{data}
+\name{CollectionTree}
+\alias{CollectionTree}
+\title{Arvados Collection Object}
+\format{An object of class \code{R6ClassGenerator} of length 24.}
+\usage{
+CollectionTree
+}
+\description{
+Update description
+}
+\examples{
+arv = Collection$new(api, uuid)
+}
+\keyword{datasets}
--- /dev/null
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/HttpParser.R
+\docType{data}
+\name{HttpParser}
+\alias{HttpParser}
+\title{HttpParser}
+\format{An object of class \code{R6ClassGenerator} of length 24.}
+\usage{
+HttpParser
+}
+\description{
+HttpParser
+}
+\keyword{datasets}
--- /dev/null
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/Subcollection.R
+\docType{data}
+\name{Subcollection}
+\alias{Subcollection}
+\title{Arvados SubCollection Object}
+\format{An object of class \code{R6ClassGenerator} of length 24.}
+\usage{
+Subcollection
+}
+\description{
+Update description
+}
+\keyword{datasets}
--- /dev/null
+library(testthat)
+library(ArvadosR)
+
+test_check("ArvadosR")
--- /dev/null
+FakeHttpParser <- R6::R6Class(
+
+ "HttrParser",
+
+ public = list(
+
+ parserCallCount = NULL,
+
+ initialize = function()
+ {
+ self$parserCallCount <- 0
+ },
+
+ parseJSONResponse = function(serverResponse)
+ {
+ self$parserCallCount <- self$parserCallCount + 1
+ serverResponse
+ },
+
+ parseWebDAVResponse = function(response, uri)
+ {
+ response
+ },
+
+ extractFileSizeFromWebDAVResponse = function(response, uri)
+ {
+ response
+ }
+ )
+)
--- /dev/null
+FakeHttpRequest <- R6::R6Class(
+
+ "FakeHttpRequest",
+
+ public = list(
+
+ content = NULL,
+ expectedURL = NULL,
+ URLIsProperlyConfigured = NULL,
+ requestHeaderContainsAuthorizationField = NULL,
+
+ numberOfGETRequests = NULL,
+ numberOfDELETERequests = NULL,
+
+ initialize = function(expectedURL = NULL, serverResponse = NULL)
+ {
+ self$content <- serverResponse
+ self$expectedURL <- expectedURL
+ self$requestHeaderContainsAuthorizationField <- FALSE
+ self$URLIsProperlyConfigured <- FALSE
+
+ self$numberOfGETRequests <- 0
+ self$numberOfDELETERequests <- 0
+ },
+
+ GET = function(url, headers = NULL, queryFilters = NULL, limit = NULL, offset = NULL)
+ {
+ private$validateURL(url)
+ private$validateHeaders(headers)
+ self$numberOfGETRequests <- self$numberOfGETRequests + 1
+
+ self$content
+ },
+
+ PUT = function(url, headers = NULL, body = NULL,
+ queryFilters = NULL, limit = NULL, offset = NULL)
+ {
+ self$content
+ },
+
+ POST = function(url, headers = NULL, body = NULL,
+ queryFilters = NULL, limit = NULL, offset = NULL)
+ {
+ self$content
+ },
+
+ DELETE = function(url, headers = NULL, body = NULL,
+ queryFilters = NULL, limit = NULL, offset = NULL)
+ {
+ private$validateURL(url)
+ private$validateHeaders(headers)
+ self$numberOfDELETERequests <- self$numberOfDELETERequests + 1
+ self$content
+ },
+
+ PROPFIND = function(url, headers = NULL)
+ {
+ self$content
+ },
+
+ MOVE = function(url, headers = NULL)
+ {
+ self$content
+ }
+ ),
+
+ private = list(
+
+ validateURL = function(url)
+ {
+ if(!is.null(self$expectedURL) && url == self$expectedURL)
+ self$URLIsProperlyConfigured <- TRUE
+ },
+
+ validateHeaders = function(headers)
+ {
+ if(!is.null(headers$Authorization))
+ self$requestHeaderContainsAuthorizationField <- TRUE
+ }
+ ),
+
+ cloneable = FALSE
+)
--- /dev/null
+context("Arvados API")
+
+source("fakes/FakeHttpRequest.R")
+source("fakes/FakeHttpParser.R")
+
+test_that("Constructor will use environment variables if no parameters are passed to it", {
+
+ Sys.setenv(ARVADOS_API_HOST = "environment_api_host")
+ Sys.setenv(ARVADOS_API_TOKEN = "environment_api_token")
+
+ arv <- Arvados$new()
+
+ Sys.unsetenv("ARVADOS_API_HOST")
+ Sys.unsetenv("ARVADOS_API_TOKEN")
+
+ expect_that("https://environment_api_host/arvados/v1/",
+ equals(arv$getHostName()))
+
+ expect_that("environment_api_token",
+ equals(arv$getToken()))
+})
+
+test_that("Constructor preferes constructor fields over environment variables", {
+
+ Sys.setenv(ARVADOS_API_HOST = "environment_api_host")
+ Sys.setenv(ARVADOS_API_TOKEN = "environment_api_token")
+
+ arv <- Arvados$new("constructor_api_token", "constructor_api_host")
+
+ Sys.unsetenv("ARVADOS_API_HOST")
+ Sys.unsetenv("ARVADOS_API_TOKEN")
+
+ expect_that("https://constructor_api_host/arvados/v1/",
+ equals(arv$getHostName()))
+
+ expect_that("constructor_api_token",
+ equals(arv$getToken()))
+})
+
+test_that("Constructor raises exception if fields and environment variables are not provided", {
+
+ expect_that(Arvados$new(),
+ throws_error(paste0("Please provide host name and authentification token",
+ " or set ARVADOS_API_HOST and ARVADOS_API_TOKEN",
+ " environmental variables.")))
+})
+
+test_that("getWebDavHostName calls REST service properly", {
+
+ hostName <- "hostName"
+ token <- "token"
+ arv <- Arvados$new(token, hostName)
+
+ serverResponse <- list(keepWebServiceUrl = "https://myWebDavServer.com")
+ expectedURL <- paste0("https://", hostName,
+ "/discovery/v1/apis/arvados/v1/rest")
+
+ httpRequest <- FakeHttpRequest$new(expectedURL, serverResponse)
+ arv$setHttpClient(httpRequest)
+ arv$setHttpParser(FakeHttpParser$new())
+
+ webDAVHostName <- arv$getWebDavHostName()
+
+ expect_that(httpRequest$URLIsProperlyConfigured, is_true())
+ expect_that(httpRequest$requestHeaderContainsAuthorizationField, is_true())
+ expect_that(httpRequest$numberOfGETRequests, equals(1))
+})
+
+test_that("getWebDavHostName returns webDAV host name properly", {
+
+ arv <- Arvados$new("token", "hostName")
+
+ serverResponse <- list(keepWebServiceUrl = "https://myWebDavServer.com")
+
+ httpRequest <- FakeHttpRequest$new(expectedURL = NULL, serverResponse)
+ arv$setHttpClient(httpRequest)
+ arv$setHttpParser(FakeHttpParser$new())
+
+ expect_that("https://myWebDavServer.com", equals(arv$getWebDavHostName()))
+})
+
+test_that("getCollection calls REST service properly", {
+
+ arv <- Arvados$new("token", "hostName")
+
+ serverResponse <- NULL
+ collectionUUID <- "aaaaa-j7d0g-ccccccccccccccc"
+ expectedURL <- paste0(arv$getHostName(), "collections/", collectionUUID)
+
+ httpRequest <- FakeHttpRequest$new(expectedURL, serverResponse)
+ arv$setHttpClient(httpRequest)
+ arv$setHttpParser(FakeHttpParser$new())
+
+ arv$getCollection(collectionUUID)
+
+ expect_that(httpRequest$URLIsProperlyConfigured, is_true())
+ expect_that(httpRequest$requestHeaderContainsAuthorizationField, is_true())
+ expect_that(httpRequest$numberOfGETRequests, equals(1))
+})
+
+test_that("getCollection parses server response", {
+
+ arv <- Arvados$new("token", "hostName")
+
+ httpParser <- FakeHttpParser$new()
+ arv$setHttpParser(httpParser)
+ arv$setHttpClient(FakeHttpRequest$new())
+
+ collectionUUID <- "aaaaa-j7d0g-ccccccccccccccc"
+ arv$getCollection(collectionUUID)
+
+ expect_that(httpParser$parserCallCount, equals(1))
+})
+
+test_that("getCollection raises exception if response contains errors field", {
+
+ arv <- Arvados$new("token", "hostName")
+
+ serverResponse <- list(errors = 404)
+ arv$setHttpClient(FakeHttpRequest$new(NULL, serverResponse))
+ arv$setHttpParser(FakeHttpParser$new())
+
+ collectionUUID <- "aaaaa-j7d0g-ccccccccccccccc"
+
+ expect_that(arv$getCollection(collectionUUID),
+ throws_error(404))
+})
+
+test_that("listCollections calls REST service properly", {
+
+ arv <- Arvados$new("token", "hostName")
+
+ serverResponse <- NULL
+ expectedURL <- paste0(arv$getHostName(), "collections")
+
+ httpRequest <- FakeHttpRequest$new(expectedURL, serverResponse)
+ arv$setHttpClient(httpRequest)
+ arv$setHttpParser(FakeHttpParser$new())
+
+ arv$listCollections()
+
+ expect_that(httpRequest$URLIsProperlyConfigured, is_true())
+ expect_that(httpRequest$requestHeaderContainsAuthorizationField, is_true())
+ expect_that(httpRequest$numberOfGETRequests, equals(1))
+})
+
+test_that("listCollections parses server response", {
+
+ arv <- Arvados$new("token", "hostName")
+
+ httpParser <- FakeHttpParser$new()
+ arv$setHttpParser(httpParser)
+ arv$setHttpClient(FakeHttpRequest$new())
+
+ arv$listCollections()
+
+ expect_that(httpParser$parserCallCount, equals(1))
+})
+
+test_that("listCollections raises exception if response contains errors field", {
+
+ arv <- Arvados$new("token", "hostName")
+
+ serverResponse <- list(errors = 404)
+ expectedURL <- NULL
+ arv$setHttpClient(FakeHttpRequest$new(expectedURL, serverResponse))
+ arv$setHttpParser(FakeHttpParser$new())
+
+ expect_that(arv$listCollections(),
+ throws_error(404))
+})
+
+test_that("deleteCollection calls REST service properly", {
+
+ arv <- Arvados$new("token", "hostName")
+
+ serverResponse <- NULL
+ collectionUUID <- "aaaaa-j7d0g-ccccccccccccccc"
+ expectedURL <- paste0(arv$getHostName(), "collections/", collectionUUID)
+
+ httpRequest <- FakeHttpRequest$new(expectedURL, serverResponse)
+ arv$setHttpClient(httpRequest)
+ arv$setHttpParser(FakeHttpParser$new())
+
+ arv$deleteCollection(collectionUUID)
+
+ expect_that(httpRequest$URLIsProperlyConfigured, is_true())
+ expect_that(httpRequest$requestHeaderContainsAuthorizationField, is_true())
+ expect_that(httpRequest$numberOfDELETERequests, equals(1))
+})
+
+test_that("deleteCollection parses server response", {
+
+ arv <- Arvados$new("token", "hostName")
+
+ httpParser <- FakeHttpParser$new()
+ arv$setHttpParser(httpParser)
+ arv$setHttpClient(FakeHttpRequest$new())
+
+ collectionUUID <- "aaaaa-j7d0g-ccccccccccccccc"
+ arv$deleteCollection(collectionUUID)
+
+ expect_that(httpParser$parserCallCount, equals(1))
+})
+
+test_that("getCollection raises exception if response contains errors field", {
+
+ arv <- Arvados$new("token", "hostName")
+
+ serverResponse <- list(errors = 404)
+ arv$setHttpClient(FakeHttpRequest$new(NULL, serverResponse))
+ arv$setHttpParser(FakeHttpParser$new())
+
+ collectionUUID <- "aaaaa-j7d0g-ccccccccccccccc"
+
+ expect_that(arv$deleteCollection(collectionUUID),
+ throws_error(404))
+})
projects / arvados.git / commitdiff