From: Fuad Muhic Date: Tue, 19 Dec 2017 17:03:41 +0000 (+0100) Subject: Merge branch 'master' of git.curoverse.com:arvados into 11876-r-sdk X-Git-Tag: 1.1.3~2^2~55 X-Git-Url: https://git.arvados.org/arvados.git/commitdiff_plain/62a2ccba46cb5b83e510e727afa44eee2e893676?hp=459de9bfd86a58496e9585ebc999113afd6bb0d1 Merge branch 'master' of git.curoverse.com:arvados into 11876-r-sdk Arvados-DCO-1.1-Signed-off-by: Fuad Muhic --- diff --git a/.gitignore b/.gitignore index e61f485237..d41eaeea5f 100644 --- a/.gitignore +++ b/.gitignore @@ -27,3 +27,4 @@ services/api/config/arvados-clients.yml *#* .DS_Store .vscode +.Rproj.user diff --git a/sdk/R/.Rbuildignore b/sdk/R/.Rbuildignore new file mode 100644 index 0000000000..91114bf2f2 --- /dev/null +++ b/sdk/R/.Rbuildignore @@ -0,0 +1,2 @@ +^.*\.Rproj$ +^\.Rproj\.user$ diff --git a/sdk/R/ArvadosR.Rproj b/sdk/R/ArvadosR.Rproj new file mode 100644 index 0000000000..a648ce1502 --- /dev/null +++ b/sdk/R/ArvadosR.Rproj @@ -0,0 +1,20 @@ +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 diff --git a/sdk/R/DESCRIPTION b/sdk/R/DESCRIPTION new file mode 100644 index 0000000000..0e586e91bd --- /dev/null +++ b/sdk/R/DESCRIPTION @@ -0,0 +1,19 @@ +Package: ArvadosR +Type: Package +Title: Arvados R SDK +Version: 0.0.1 +Author: Fuad Muhic +Maintainer: Ward Vandewege +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 diff --git a/sdk/R/NAMESPACE b/sdk/R/NAMESPACE new file mode 100644 index 0000000000..1c94e716bf --- /dev/null +++ b/sdk/R/NAMESPACE @@ -0,0 +1,7 @@ +# Generated by roxygen2: do not edit by hand + +export(Arvados) +export(ArvadosFile) +export(Collection) +export(CollectionTree) +export(Subcollection) diff --git a/sdk/R/R/Arvados.R b/sdk/R/R/Arvados.R new file mode 100644 index 0000000000..2c9d003be9 --- /dev/null +++ b/sdk/R/R/Arvados.R @@ -0,0 +1,237 @@ +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 +) diff --git a/sdk/R/R/ArvadosFile.R b/sdk/R/R/ArvadosFile.R new file mode 100644 index 0000000000..85d11c7d66 --- /dev/null +++ b/sdk/R/R/ArvadosFile.R @@ -0,0 +1,180 @@ +#' 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 +) diff --git a/sdk/R/R/Collection.R b/sdk/R/R/Collection.R new file mode 100644 index 0000000000..ea6f692ce5 --- /dev/null +++ b/sdk/R/R/Collection.R @@ -0,0 +1,201 @@ +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 +) diff --git a/sdk/R/R/CollectionTree.R b/sdk/R/R/CollectionTree.R new file mode 100644 index 0000000000..82c6eb8f9e --- /dev/null +++ b/sdk/R/R/CollectionTree.R @@ -0,0 +1,116 @@ +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 + } + ) +) diff --git a/sdk/R/R/HttpParser.R b/sdk/R/R/HttpParser.R new file mode 100644 index 0000000000..dda3db90b0 --- /dev/null +++ b/sdk/R/R/HttpParser.R @@ -0,0 +1,45 @@ +#' 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) + } + ) +) diff --git a/sdk/R/R/HttpRequest.R b/sdk/R/R/HttpRequest.R new file mode 100644 index 0000000000..7a399a4b30 --- /dev/null +++ b/sdk/R/R/HttpRequest.R @@ -0,0 +1,150 @@ +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 +) diff --git a/sdk/R/R/Subcollection.R b/sdk/R/R/Subcollection.R new file mode 100644 index 0000000000..78cc4c13bf --- /dev/null +++ b/sdk/R/R/Subcollection.R @@ -0,0 +1,217 @@ +#' 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 +) diff --git a/sdk/R/README b/sdk/R/README new file mode 100644 index 0000000000..2e2298e187 --- /dev/null +++ b/sdk/R/README @@ -0,0 +1,171 @@ +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"))) + +-------------------------------------------------------------------------------------------------------------------------------- diff --git a/sdk/R/man/Arvados.Rd b/sdk/R/man/Arvados.Rd new file mode 100644 index 0000000000..6dfb0cedcc --- /dev/null +++ b/sdk/R/man/Arvados.Rd @@ -0,0 +1,25 @@ +% 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} diff --git a/sdk/R/man/ArvadosFile.Rd b/sdk/R/man/ArvadosFile.Rd new file mode 100644 index 0000000000..f48a71f515 --- /dev/null +++ b/sdk/R/man/ArvadosFile.Rd @@ -0,0 +1,14 @@ +% 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} diff --git a/sdk/R/man/Collection.Rd b/sdk/R/man/Collection.Rd new file mode 100644 index 0000000000..46c76cb40b --- /dev/null +++ b/sdk/R/man/Collection.Rd @@ -0,0 +1,17 @@ +% 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} diff --git a/sdk/R/man/CollectionTree.Rd b/sdk/R/man/CollectionTree.Rd new file mode 100644 index 0000000000..adeed46309 --- /dev/null +++ b/sdk/R/man/CollectionTree.Rd @@ -0,0 +1,17 @@ +% 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} diff --git a/sdk/R/man/HttpParser.Rd b/sdk/R/man/HttpParser.Rd new file mode 100644 index 0000000000..68d314fb72 --- /dev/null +++ b/sdk/R/man/HttpParser.Rd @@ -0,0 +1,14 @@ +% 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} diff --git a/sdk/R/man/Subcollection.Rd b/sdk/R/man/Subcollection.Rd new file mode 100644 index 0000000000..e644e02168 --- /dev/null +++ b/sdk/R/man/Subcollection.Rd @@ -0,0 +1,14 @@ +% 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}