Nothing
# 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.
.VERSION = packageVersion("genesysr")
.genesysEnv <- new.env(parent = emptyenv())
#' Configure package defaults on load
#'
#' @param libname Library name
#' @param pkgname Package name
#' @keywords internal
.onLoad <- function(libname, pkgname) {
setup_production()
}
#' Setup for Genesys Production
#'
#' Use the Genesys R Client with <https://api.genesys-pgr.org> requiring \code{\link{user_login}}
#'
#' @export
setup_production <- function() {
setup(server = "https://api.genesys-pgr.org", client_id = "oHgJR.NjcdJAIB175gBDbuLEK3@www.genesys-pgr.org", client_secret = "public")
}
#' Setup for Genesys Sandbox
#'
#' Use the Genesys R Client with <https://api.sandbox.genesys-pgr.org> requiring \code{\link{user_login}}
#'
#' @export
setup_sandbox <- function() {
setup(server = "https://api.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. "https://api.genesys-pgr.org" or "https://api.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("genesysr:", .VERSION))
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
#'
#' @param authorization OAuth2 Authorization header obtained from somewhere else (e.g. an ENV variable)
#'
#' @seealso \code{\link{user_login}}, \code{\link{client_login}}
#' @export
authorization <- function(authorization) {
assign("Authorization", authorization, envir = .genesysEnv)
message(paste('Genesys Authorization:', authorization))
}
#' Ensure that environment has OAuth token
#' @keywords internal
.check_auth <- function() {
if (is.null(.genesysEnv$Authorization)) {
warning("You must first authorize with Genesys with user_login() or client_login(...).");
}
}
#' Login to Genesys as a user
#'
#' The authorization URL will open in a browser, ask the user to grant
#' permissions to R.
#'
#' ```
#'
#' After successful authentication the browser will display the message:
#' "Authentication complete. Please close this page and return to R."
#'
#' Close the browser and return to R.
#'
#' @param redirect_uri a custom redirect_uri to submit as part of the authentication request.
#' This is most useful if the default port is blocked and you wish to specify
#' another port: `redirect_uri = "http://127.0.0.1:44211"`.
#' Note that using `http://localhost` will not work.
#' @seealso \code{\link{setup}}
#'
#' @importFrom httr2 oauth_client oauth_flow_auth_code
#' @export
user_login <- function(redirect_uri = "http://127.0.0.1:48913") {
# browser()
client <- oauth_client(
id = .genesysEnv$client_id,
secret = .genesysEnv$client_secret,
token_url = paste0(.genesysEnv$server, "/oauth/token"),
auth = "body",
# name = "Genesys R"
)
if (interactive()) {
message("Please login to Genesys in the browser window");
token <- oauth_flow_auth_code(client, pkce = T, scope = "openid", redirect_uri = redirect_uri, auth_url = paste0(.genesysEnv$server, "/oauth/authorize"))
# browser()
authorization(paste("Bearer", token$access_token))
invisible(token)
}
}
#' 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}}
#'
#' @importFrom httr2 oauth_client oauth_flow_client_credentials
#' @export
client_login <- function() {
client <- oauth_client(
id = .genesysEnv$client_id,
secret = .genesysEnv$client_secret,
token_url = paste0(.genesysEnv$server, "/oauth/token"),
name = "Genesys R"
)
token <- oauth_flow_client_credentials(client, scope = "openid", token_params = list())
authorization(paste("Bearer", token$access_token))
invisible(token)
}
# Prepare API request
#' @keywords internal
#' @import magrittr
.api_request <- function(path, method = "get", accept = "application/json", query = NULL, body = NULL, content.type = "application/json") {
.check_auth()
if (typeof(query$select) != "NULL") {
query$select <- paste(unlist(query$select), collapse=',')
}
params <- query
if (!is.null(query)) names(params) <- paste0(names(params))
#browser()
req <- httr2::request(base_url = .genesysEnv$server) %>%
httr2::req_url_path_append(path) %>%
httr2::req_headers(
Authorization = .genesysEnv$Authorization,
Accept = accept,
) %>%
httr2::req_url_query(!!!params) %>%
httr2::req_method(method = method) %>%
httr2::req_user_agent(paste("genesysr", .VERSION, "(https://cran.r-project.org/package=genesysr)"))
if (! is.null(body)) {
req <- req %>% httr2::req_body_raw(body = body, type = content.type);
}
invisible(req)
}
#' @keywords internal
#' @import magrittr
.api_call <- function(path, method = "get", accept = "application/json", query = NULL, body = NULL, content.type = "application/json") {
req <- .api_request(path = path, method = method, accept = accept, query = query, body = body, content.type = content.type);
resp <- req %>%
httr2::req_perform(verbosity = 0) %>% # Set verbosity to 3 for debugging
httr2::resp_body_string(encoding = "UTF8")
return(resp)
}
#' Get partial API v1 URL for the provided path
#'
#' @param path relative path of the API v1 endpoint (e.g. \code{/me})
#'
#' @return Returns "/api/v1" + path
#' @export
#'
#' @examples
#' api1_url("/me")
api1_url <- function(path) {
paste0("/api/v1", path)
}
#' Get partial API v2 URL for the provided path
#'
#' @param path relative path of the API v2 endpoint (e.g. \code{/me})
#'
#' @return Returns "/api/v2" + path
#' @export
#'
#' @examples
#' api2_url("/me")
api2_url <- function(path) {
paste0("/api/v2", path)
}
#' @keywords internal
.get <- function(path, query = NULL, accept = "application/json") {
resp <- .api_call(path, query = query, accept = accept)
resp
}
#' HTTP POST method
#'
#' @param path API path
#' @param query query string parameters
#' @param body request body (will be serialized to JSON)
#' @param content.type Content-Type of the body
#'
#' @return httr response
#' @keywords internal
.post <- function(path, query = NULL, body = NULL, content.type = "application/json", accept = "application/json") {
content <- jsonlite::toJSON(body, auto_unbox = TRUE)
if (! is.null(body) && length(body) == 0) {
# If body is provided, but has length of 0
content <- "{}"
}
# print(paste("Body is:", content))
resp <- .api_call(path, method = "post", query = query, accept = accept, content.type = content.type, body = content)
resp
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.