Commit d096166d authored by Matija Obreza's avatar Matija Obreza

Initial R client code

parents
^.*\.Rproj$
^\.Rproj\.user$
.Rproj.user
.Rhistory
.RData
.Ruserdata
man
Package: genesysr
Title: R client for Genesys PGR (www.genesys-pgr.org)
Version: 0.1
Authors@R: person("Matija", "Obreza", email = "matija.obreza@croptrust.org",
role = c("aut", "cre"))
Description: Selected Genesys API calls implemented in R.
Allows for authentication and exposes common API calls.
Depends: R (>= 3.1.0)
License: Apache License 2.0
LazyData: true
Imports:
httr
RoxygenNote: 6.0.1
This diff is collapsed.
# Generated by roxygen2: do not edit by hand
export(api_url)
export(authorization)
export(client_login)
export(fetch_accessions)
export(filter_DOI)
export(filter_ORIGCTY)
export(filter_SAMPSTAT)
export(mcpd_filter)
export(me)
export(print_setup)
export(setup)
export(setup_production)
export(setup_sandbox)
export(user_login)
# Copyright 2018 Global Crop Diversity Trust
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
.genesysEnv <- new.env(parent = emptyenv())
#' Configure package defaults
.onLoad <- function(libname, pkgname) {
setup_production()
}
#' Setup for Genesys Production
#'
#' Use the Genesys R Client with \link{https://www.genesys-pgr.org} requiring \code{\link{user_login}}
#'
#' @export
setup_production <- function() {
setup(server = "https://www.genesys-pgr.org", client_id = "oHgJR.NjcdJAIB175gBDbuLEK3@www.genesys-pgr.org", client_secret = "public")
}
#' Setup for Genesys Sandbox
#'
#' Use the Genesys R Client with \link{https://sandbox.genesys-pgr.org} requiring \code{\link{user_login}}
#'
#' @export
setup_sandbox <- function() {
setup(server = "https://sandbox.genesys-pgr.org", client_id = "cCS6e.BAn9u2WkhIwgxBLxOVqZ@sandbox.genesys-pgr.org", client_secret = NULL)
}
#' Configure the Genesys environment
#'
#' @param server Server base URL (e.g. \link{https://www.genesys-pgr.org} or \link{https://sandbox.genesys-pgr.org})
#' @param client_id OAuth client ID
#' @param client_secret OAuth client secret
#'
#' @export
#' @seealso See utility methods \code{\link{setup_production}}, \code{\link{setup_sandbox}}
#'
#' @examples
#' # Link with sandbox
#' setup_sandbox()
#'
setup <- function(server = NULL, client_id = NULL, client_secret = NULL) {
assign("server", server, envir = .genesysEnv)
assign("client_id", client_id, envir = .genesysEnv)
assign("client_secret", client_secret, envir = .genesysEnv)
}
#' Print Genesys client configuration
#'
#' @export
print_setup <- function() {
message(paste("Genesys URL:", .genesysEnv$server))
message(paste("Client ID:", .genesysEnv$client_id))
message(paste("Client secret:", .genesysEnv$client_secret))
}
#' Provide OAuth2 token to use for authorization with Genesys
#'
#' @seealso \code{\link{login}}
#' @export
authorization <- function(authorization) {
assign("Authorization", authorization, envir = .genesysEnv)
message(paste('Genesys Authorization:', authorization))
}
#' Login to Genesys as a user
#'
#' The authorization URL will open in a browser, ask the user to grant
#' permissions to R and the verification code must be copy-pasted after
#' you grant access to the client.
#'
#' @seealso \code{\link{setup}}
#'
#' @export
user_login <- function() {
url <- paste0(.genesysEnv$server, "/oauth/authorize")
browseURL(httr::modify_url(url, query = list(
client_id = .genesysEnv$client_id, client_secret = .genesysEnv$client_secret,
redirect_uri = "oob",
scope = "read",
response_type= "code"
)))
code <- readline("Enter the authorization code: ");
url <- paste0(.genesysEnv$server, "/oauth/token")
resp <- httr::POST(url, body = list(
client_id = .genesysEnv$client_id, client_secret = .genesysEnv$client_secret,
redirect_uri = "oob",
grant_type = "authorization_code", code = code
), encode = "form")
if (httr::http_type(resp) != "application/json" || httr::status_code(resp) != 200) {
stop(paste("API did not return json", httr::content(resp, "text")), call. = FALSE)
}
parsed <- jsonlite::fromJSON(httr::content(resp, "text"), simplifyVector = FALSE)
authorization(paste("Bearer", parsed$access_token))
invisible(structure(
parsed,
class = "genesys_auth"
))
}
#' Login to Genesys as a service client (system-to-system)
#'
#' The client must be enabled for Client Credential grant on Genesys.
#'
#' @seealso \code{\link{setup}}
#'
#' @export
client_login <- function() {
url <- paste0(.genesysEnv$server, "/oauth/token")
resp <- httr::POST(url, body = list(
client_id = .genesysEnv$client_id, client_secret = .genesysEnv$client_secret,
grant_type = "client_credentials"
), encode = "form")
if (httr::http_type(resp) != "application/json" || httr::status_code(resp) != 200) {
stop("API did not return json", call. = FALSE)
}
parsed <- jsonlite::fromJSON(httr::content(resp, "text"), simplifyVector = FALSE)
authorization(paste("Bearer", parsed$access_token))
invisible(structure(
parsed,
class = "genesys_auth"
))
}
api_call <- function(path, method = "get", server = GENESYS_SERVER) {
resp <- httr::GET(api_url(path), httr::add_headers(
Authorization = .genesysEnv$Authorization
)
)
resp
if (httr::http_type(resp) != "application/json") {
stop("API did not return json", call. = FALSE)
}
# return(resp)
parsed <- jsonlite::fromJSON(httr::content(resp, "text"), simplifyVector = FALSE)
return(parsed)
}
#' Get full Genesys API URL for a specific path
#'
#' @param path
#'
#' @return Absolute URL to an API call
#' @export
#'
#' @examples
#' api_url("/me")
api_url <- function(path) {
paste0(.genesysEnv$server, "/api/v0", path)
}
get <- function(path, query = NULL) {
resp <- httr::GET(api_url(path), httr::add_headers(
Authorization = .genesysEnv$Authorization
))
if (httr::http_type(resp) != "application/json") {
stop("API did not return json", call. = FALSE)
}
resp
}
post <- function(path, query = NULL, body) {
resp <- httr::POST(api_url(path), httr::add_headers(
Authorization = .genesysEnv$Authorization,
"Content-Type" = "application/json"
), body = jsonlite::toJSON(body))
if (httr::http_type(resp) != "application/json") {
stop("API did not return json", call. = FALSE)
}
resp
}
# Copyright 2018 Global Crop Diversity Trust
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#' Make or adjust filter using MCPD terminology
#'
#' See FAO/Bioversity Multi-Crop Passport Descriptors.
#'
#' @param filter Existing filters (or blank list if not provided)
#' @param ORIGCTY Country of origin
#' @param SAMPSTAT Biological status of sample
#'
#' @examples
#' # Filter accessions from Mexico and Slovenia
#' mcpd_filter(ORIGCTY = c("MEX", "SVN"))
#'
#'
#' @export
mcpd_filter <- function(filter = list(), DOI = NULL, ORIGCTY = NULL, SAMPSTAT = NULL) {
f <- c(filter)
f <- filter_DOI(f, DOI)
f <- filter_ORIGCTY(f, ORIGCTY)
f <- filter_SAMPSTAT(f, SAMPSTAT)
f
}
#' Add filter on accession DOI
#' @export
filter_DOI <- function(filter = list(), DOI) {
f <- c(filter)
if (!is.null(DOI)) {
f$doi = c(f$doi, DOI)
}
f
}
#' Add filter on Country of origin of material
#' @export
filter_ORIGCTY <- function(filter = list(), ORIGCTY) {
f <- c(filter)
if (!is.null(ORIGCTY)) {
f$orgCty.iso3 = c(f$orgCty.iso3, ORIGCTY)
}
f
}
#' Add filter on Biological status of sample
#' @export
filter_SAMPSTAT <- function(filter = list(), SAMPSTAT) {
f <- c(filter)
if (!is.null(SAMPSTAT)) {
f$sampStat = c(f$sampStat, SAMPSTAT)
}
f
}
# Copyright 2018 Global Crop Diversity Trust
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#' Who am i?
#'
#' @export
me <- function() {
resp <- api_call("/me")
message(jsonlite::toJSON(resp, pretty = TRUE))
invisible(resp)
}
#' Fetch accession passport data
#'
#' @param filters an R \code{structure} with Genesys filters
#' @param size number of records to load per page (page size)
#' @param page the page index (0-based)
#'
#' @seealso \code{\link{mcpd_filter}}
#'
#' @examples
#' # Retrieve accession data by DOI
#' accessions <- fetch_accessions(mcpd_filter(DOI = c("10.1010/DUMMY", "10.1010/DUNNY")))
#'
#' @export
#' @return Paged data structure
fetch_accessions <- function(filters = list(), page = 0, size = 100) {
resp <- post(path = "/acn/filter", query=list(p = page, s = size), body = filters)
jsonlite::fromJSON(httr::content(resp, "text"), simplifyVector = FALSE)
}
Version: 1.0
RestoreWorkspace: No
SaveWorkspace: No
AlwaysSaveHistory: No
EnableCodeIndexing: Yes
UseSpacesForTab: Yes
NumSpacesForTab: 2
Encoding: UTF-8
RnwWeave: Sweave
LaTeX: pdfLaTeX
BuildType: Package
PackageUseDevtools: Yes
PackageInstallArgs: --no-multiarch --with-keep.source
PackageRoxygenize: rd,collate,namespace
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment