*#*
.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
--- /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("Please provide host name and authentification token or set ARVADOS_API_HOST and ARVADOS_API_TOKEN environmental variables.")
+
+ discoveryDocumentURL <- paste0("https://", host, "/discovery/v1/apis/arvados/v1/rest")
+
+ version <- "v1"
+ host <- paste0("https://", host, "/arvados/", version, "/")
+
+ private$http <- HttpRequest$new()
+ private$httpParser <- HttpParser$new()
+ private$token <- token
+ private$host <- host
+
+ headers <- list(Authorization = paste("OAuth2", private$token))
+
+ serverResponse <- private$http$GET(discoveryDocumentURL, headers)
+
+ discoveryDocument <- private$httpParser$parseJSONResponse(serverResponse)
+ private$webDavHostName <- discoveryDocument$keepWebServiceUrl
+ },
+
+ getToken = function() private$token,
+ getHostName = function() private$host,
+
+ #Todo(Fudo): Hardcoded credentials to WebDAV server. Remove them later
+ getWebDavHostName = function() 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))
+
+ names(filters) <- c("collection")
+
+ serverResponse <- private$http$GET(collectionURL, headers, filters, limit, offset)
+ collection <- private$httpParser$parseJSONResponse(serverResponse)
+
+ if(!is.null(collection$errors))
+ stop(collection$errors)
+
+ collection
+ },
+
+ 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, body)
+ {
+ collectionURL <- paste0(private$host, "collections/", uuid)
+ headers <- list("Authorization" = paste("OAuth2", private$token),
+ "Content-Type" = "application/json")
+
+ names(body) <- c("collection")
+ 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(body)
+ {
+ collectionURL <- paste0(private$host, "collections")
+ headers <- list("Authorization" = paste("OAuth2", private$token),
+ "Content-Type" = "application/json")
+
+ names(body) <- c("collection")
+ 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(body)
+ {
+ projectURL <- paste0(private$host, "groups")
+ headers <- list("Authorization" = paste("OAuth2", private$token),
+ "Content-Type" = "application/json")
+
+ names(body) <- c("group")
+ 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, body)
+ {
+ projectURL <- paste0(private$host, "groups/", uuid)
+ headers <- list("Authorization" = paste("OAuth2", private$token),
+ "Content-Type" = "application/json")
+
+ names(body) <- c("group")
+ 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))
+
+ names(filters) <- c("groups")
+
+ serverResponse <- private$http$GET(projectURL, headers, filters, limit, offset)
+ projects <- private$httpParser$parseJSONResponse(serverResponse)
+
+ if(!is.null(projects$errors))
+ stop(projects$errors)
+
+ projects
+ },
+
+ 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,
+ webDavHostName = NULL,
+ http = NULL,
+ httpParser = NULL
+ ),
+
+ 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,
+
+ getFileList = 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)
+ },
+
+ removeFromCollection = function()
+ {
+ if(is.null(private$collection))
+ stop("Subcollection doesn't belong to any collection.")
+
+ private$collection$.__enclos_env__$private$deleteFromREST(self$getRelativePath())
+
+ #todo rename this add to a collection
+ private$addToCollection(NULL)
+ private$detachFromParent()
+ },
+
+ getRelativePath = function()
+ {
+ relativePath <- c(private$name)
+ parent <- private$parent
+
+ #Recurse back to root
+ while(!is.null(parent))
+ {
+ relativePath <- c(parent$getName(), relativePath)
+ parent <- parent$getParent()
+ }
+
+ relativePath <- relativePath[relativePath != ""]
+ paste0(relativePath, collapse = "/")
+ },
+
+ getParent = function() private$parent,
+
+ read = function(offset = 0, length = 0)
+ {
+ #todo range is wrong fix it
+ if(offset < 0 || length < 0)
+ stop("Offset and length must be positive values.")
+
+ 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());
+ headers <- list(Authorization = paste("OAuth2", private$collection$api$getToken()),
+ Range = range)
+
+ serverResponse <- private$http$GET(fileURL, headers)
+
+ if(serverResponse$status_code != 206)
+ stop(paste("Server code:", serverResponse$status_code))
+
+ parsedServerResponse <- httr::content(serverResponse, "raw")
+ parsedServerResponse
+ },
+
+ write = function(content, contentType = "text/html")
+ {
+ 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 != 201)
+ stop(paste("Server code:", serverResponse$status_code))
+
+ parsedServerResponse <- httr::content(serverResponse, "text")
+ parsedServerResponse
+ },
+
+ move = function(newLocation)
+ {
+ 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 subcollectin")
+ }
+
+ status <- private$collection$.__enclos_env__$private$moveOnRest(self$getRelativePath(), paste0(newParent$getRelativePath(), "/", self$getName()))
+
+ private$attachToParent(newParent)
+
+ paste("Status code :", status$status_code)
+ }
+ ),
+
+ private = list(
+
+ name = NULL,
+ size = NULL,
+ parent = NULL,
+ collection = NULL,
+ http = NULL,
+ httpParser = NULL,
+
+ getChild = function(name)
+ {
+ return(NULL)
+ },
+
+ getFirstChild = function()
+ {
+ return(NULL)
+ },
+
+ addToCollection = function(collection)
+ {
+ private$collection = collection
+ },
+
+ detachFromParent = function()
+ {
+ if(!is.null(private$parent))
+ {
+ private$parent$.__enclos_env__$private$removeChild(private$name)
+ private$parent <- NULL
+ }
+ },
+
+ attachToParent = function(parent)
+ {
+ parent$.__enclos_env__$private$children <- c(parent$.__enclos_env__$private$children, self)
+ private$parent <- parent
+ }
+ ),
+
+ 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$.__enclos_env__$private$tree
+ }
+ 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(content))
+ {
+ sapply(content, function(fileName)
+ {
+ subcollection$add(ArvadosFile$new(fileName))
+ })
+ }
+ else if("ArvadosFile" %in% class(content) ||
+ "Subcollection" %in% class(content))
+ {
+ subcollection$add(content)
+ }
+ },
+
+ 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."))
+
+ file$removeFromCollection()
+ })
+ }
+ else if("ArvadosFile" %in% class(content) ||
+ "Subcollection" %in% class(content))
+ {
+ if(is.null(content$.__enclos_env__$private$collection) ||
+ content$.__enclos_env__$private$collection$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)
+ },
+
+ getFileContent = function() private$getCollectionContent(),
+
+ get = function(relativePath)
+ {
+ private$tree$getElement(relativePath)
+ }
+ ),
+
+ 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]
+ },
+
+ createFilesOnREST = function(files)
+ {
+ sapply(files, function(filePath)
+ {
+ private$createNewFile(filePath, NULL, "text/html")
+ })
+ },
+
+ generateTree = function(content)
+ {
+ treeBranches <- sapply(collectionContent, function(filePath)
+ {
+ splitPath <- unlist(strsplit(filePath$name, "/", fixed = TRUE))
+
+ branch = private$createBranch(splitPath, filePath$fileSize)
+ })
+ },
+
+ 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 != 201)
+ 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 != 204)
+ 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
+ }
+ ),
+
+ 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$.__enclos_env__$private$addToCollection(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$.__enclos_env__$private$getChild(pathFragment)
+
+ if(is.null(returnElement))
+ return(NULL)
+ }
+
+ returnElement
+ }
+ ),
+
+ 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$.__enclos_env__$private$getChild(node$getName())
+
+ if(is.null(child))
+ {
+ container$add(node)
+ #todo add it to collection
+ }
+ else
+ {
+ if("ArvadosFile" %in% class(child))
+ {
+ child = private$replaceFileWithSubcollection(child)
+ }
+
+ private$addBranch(child, node$.__enclos_env__$private$getFirstChild())
+ }
+ },
+
+ replaceFileWithSubcollection = function(arvadosFile)
+ {
+ subcollection <- Subcollection$new(arvadosFile$getName())
+ fileParent <- arvadosFile$.__enclos_env__$private$parent
+ fileParent$.__enclos_env__$private$removeChild(arvadosFile$getName())
+ fileParent$add(subcollection)
+
+ arvadosFile$.__enclos_env__$private$parent <- 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")
+ },
+
+ #TODO rename this
+ 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(
+
+ initialize = function()
+ {
+ },
+
+ 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 = 100, offset = 0)
+ {
+ headers <- httr::add_headers(unlist(headers))
+ query <- private$createQuery(queryFilters, limit, offset)
+ url <- paste0(url, query)
+
+ serverResponse <- httr::PUT(url = url, config = headers, body = body)
+ },
+
+ POST = function(url, headers = NULL, body = NULL,
+ queryFilters = NULL, limit = 100, offset = 0)
+ {
+ 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(
+
+ #Todo(Fudo): Refactor this and find a better way to build
+ # Python array from R list (recursion?)
+ 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 exacthey 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)
+
+ #Todo(Fudo): This is a hack for now. Find a proper solution.
+ 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 = "&")
+ 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()
+ },
+
+ add = function(content)
+ {
+ if("ArvadosFile" %in% class(content) ||
+ "Subcollection" %in% class(content))
+ {
+ if(!is.null(content$.__enclos_env__$private$collection))
+ stop("ArvadosFile/Subcollection already belongs to a collection.")
+
+ if(!is.null(private$collection))
+ {
+ contentPath <- paste0(self$getRelativePath(), "/", content$getFileList())
+ private$collection$.__enclos_env__$private$createFilesOnREST(contentPath)
+ content$.__enclos_env__$private$addToCollection(private$collection)
+ }
+
+ private$children <- c(private$children, content)
+ content$.__enclos_env__$private$parent = self
+ }
+ else
+ {
+ stop("Expected AravodsFile or Subcollection object, got ...")
+ }
+ },
+
+ removeFromCollection = function()
+ {
+ if(is.null(private$collection))
+ stop("Subcollection doesn't belong to any collection.")
+
+ collectionList <- paste0(self$getRelativePath(), "/", self$getFileList(fullpath = FALSE))
+ sapply(collectionList, function(file)
+ {
+ private$collection$.__enclos_env__$private$deleteFromREST(file)
+ })
+
+ #todo rename this add to a collection
+ private$addToCollection(NULL)
+ private$dettachFromParent()
+
+ },
+
+ getFileList = function(fullpath = TRUE)
+ {
+ content <- NULL
+
+ if(fullpath)
+ {
+ for(child in private$children)
+ content <- c(content, child$getFileList())
+
+ 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)
+ },
+
+ getName = function() private$name,
+
+ getRelativePath = function()
+ {
+ relativePath <- c(private$name)
+ parent <- private$parent
+
+ #Recurse back to root
+ while(!is.null(parent))
+ {
+ relativePath <- c(parent$getName(), relativePath)
+ parent <- parent$getParent()
+ }
+
+ relativePath <- relativePath[relativePath != ""]
+ paste0(relativePath, collapse = "/")
+ },
+
+ move = function(newLocation)
+ {
+ 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 subcollectin")
+ }
+
+ status <- private$collection$.__enclos_env__$private$moveOnRest(self$getRelativePath(), paste0(newParent$getRelativePath(), "/", self$getName()))
+
+ private$attachToParent(newParent)
+
+ paste("Status code :", status$status_code)
+ },
+
+ getParent = function() private$parent
+ ),
+
+ private = list(
+
+ name = NULL,
+ children = NULL,
+ parent = NULL,
+ collection = NULL,
+ http = NULL,
+ httpParser = NULL,
+
+ getChild = function(name)
+ {
+ for(child in private$children)
+ {
+ if(child$getName() == name)
+ return(child)
+ }
+
+ return(NULL)
+ },
+
+ getFirstChild = function()
+ {
+ if(length(private$children) == 0)
+ return(NULL)
+
+ private$children[[1]]
+ },
+
+ 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()
+ }
+ }
+ }
+ },
+
+ addToCollection = function(collection)
+ {
+ for(child in private$children)
+ child$.__enclos_env__$private$addToCollection(collection)
+
+ private$collection = collection
+ },
+
+ dettachFromParent = function()
+ {
+ if(!is.null(private$parent))
+ {
+ private$parent$.__enclos_env__$private$removeChild(private$name)
+ private$parent <- NULL
+ }
+ else
+ stop("Parent doesn't exists.")
+ },
+
+ attachToParent = function(parent)
+ {
+ parent$.__enclos_env__$private$children <- c(parent$.__enclos_env__$private$children, self)
+ private$parent <- parent
+ }
+ ),
+
+ cloneable = FALSE
+)
--- /dev/null
+R SDK for Arvados
+
+Examples of usage:
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Initialize API:
+
+arv <- Arvados$new("insert_token", "insert_host_name")
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Get collection:
+
+arv$getCollection("uuid")
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#List collections:
+
+collectionList <- arv$listCollections(list("uuid", "=" "aaaaa-bbbbb-ccccccccccccccc"), limit = 10, offset = 2)
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Delete collection:
+
+deletedCollection <- arv$deleteCollection("uuid")
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Update collection:
+
+updatedCollection <- arv$updateCollection("uuid", list((name = "new_name", description = "new_desciption")))
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Create collection:
+
+cratedCollection <- arv$createCollection(list(list(name = "new_name", description = "new_desciption")))
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Collection content manipulation:
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Create collection object:
+
+arv <- Arvados$new("insert_token", "insert_host_name")
+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(offset = 1024, length = 512)
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Get ArvadosFile or Subcollection size
+
+size <- arvadosFile$getSizeInBytes()
+size <- arvadosSubcollection$getSizeInBytes()
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Create new file in a collection
+
+#Call structure
+
+collection$add(arvadosFileOrSubcollectionOrFileName, optionalRelativePath)
+
+#Example
+
+collection$add("main.cpp", "cpp/src/")
+
+#or
+
+folder <- Subcollection$new("src")
+file <- ArvadosFile$new("main.cpp")
+folder$add(file)
+
+collection$add(folder, "cpp")
+
+#Both 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.
+
+#You can also add multiple files
+
+collection$add(c("path/to/my/file.cpp", "path/to/other/file.cpp"))
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#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"))
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Get project:
+
+arv$getProject("uuid")
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#List projects:
+
+projects <- arv$listProjects(list("uuid", "=" "aaaaa-bbbbb-ccccccccccccccc"), limit = 10, offset = 2)
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Delete project:
+
+deletedProject <- arv$deleteProject("uuid")
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Update project:
+
+updatedProject <- arv$updateProject("uuid", list((name = "new_name", description = "new_desciption")))
+
+--------------------------------------------------------------------------------------------------------------------------------
+
+#Create project:
+
+cratedProject <- arv$createProject(list(list(name = "project_name", description = "project_desciption")))
+
+--------------------------------------------------------------------------------------------------------------------------------
--- /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}
projects / arvados.git / commitdiff