#' @title github-package: use the Github API from R
#'
#' @description This package wraps the Github web service API so you can make R
#' calls against the Github API (to get information about repositories, or
#' even to create new content)
#'
#' @author Carlos Scheidegger
#' @docType package
#' @name github
#' @aliases github
#' @keywords package github-package
#' @examples
#' \dontrun{get.user.repositories("cscheid")}
#' @seealso \code{jsonlite}
NULL
.state <- new.env(parent=emptyenv())
#' Obtain a github context interactively
#'
#' interactive.login opens a web browser, asks for your username+password,
#' performs the OAuth dance, retrieves the token, and uses it to create a github
#' context.
#'
#' If you use rgithub interactively, then you will get a default
#' client ID and client secret that you can use. Please don't abuse that,
#' or the feature might need to be removed.
#'
#' Refer to \url{http://developer.github.com/guides/basics-of-authentication/}
#'
#' @param client_id the github client ID
#'
#' @param client_secret the github client secret
#'
#' @param scopes the OAuth scopes you want to request
#'
#' @param base_url the base URL for the github webpage. Change this in GitHub
#' Enterprise deployments to your base G.E. URL
#'
#' @param api_url the base URL for the github API. Change this in GitHub
#' Enterprise deployments to your base G.E. API URL
#'
#' @param max_etags the maximum number of entries to cache in the context
#'
#' @param verbose logical, passed to \code{create.github.context} and,
#' ultimately, to httr configuration
#'
#' @return a github context object that is used in every github API call issued
#' by this library.
interactive.login <- function(client_id = NULL,
client_secret = NULL,
scopes = NULL,
base_url = "https://github.com",
api_url = "https://api.github.com",
max_etags = 10000,
verbose = FALSE)
{
if (is.null(client_id) && is.null(client_secret) && interactive()) {
client_id <- "1ce1de9d27bd86ce924d"
client_secret <- "67f526618a826e6149ce00b4a07bc4c2aca90df1"
}
## auth_url <- NULL
auth_url <- modify_url(base_url, path = "login/oauth")
## if (is.null(scopes))
## else
## auth_url <- modify_url(base_url, path = "login/oauth",
## query = list(scope = str_c(scopes, collapse = ',')))
## print(auth_url)
github <- oauth_endpoint(NULL, "authorize", "access_token",
base_url = auth_url)
# as in httr, if client_secret is not given,
# the environment variable GITHUB_CONSUMER_SECRET will be
# used.
app <- oauth_app("github", client_id, client_secret)
client_secret <- app$secret
github_token <- oauth2.0_token(github, app, as_header=FALSE, scope=scopes)
create.github.context(api_url, client_id, client_secret, github_token, verbose=verbose)
}
#' Create a github context object.
#'
#' If create.github.context is called without some of client_id, client_secret
#' or access_token, then some API calls will be unavailable, and more severe
#' rate limiting will be in effect. Refer to \url{http://developer.github.com} for
#' more details.
#'
#' If the environment variable GITHUB_PAT is set, then rgithub will attempt
#' to authenticate using the value of that variable as a personal authentication
#' token.
#'
#' create.github.context stores the context last created in an environment.
#' If any of the github API functions are called without a context, this
#' context is used instead. (if no context has been created, an unauthenticated
#' context will be created)
#'
#' @param api_url the base URL
#'
#' @param client_id the github client ID
#'
#' @param client_secret the github client secret
#'
#' @param access_token the github access token
#'
#' @param personal_token the personal access token given by github via the /authorizations api
#'
#' @param max_etags the maximum number of entries to cache in the context
#'
#' @param verbose if TRUE, passes verbose() to httr configuration
#'
#' @return a github context object that is used in every github API call
#' issued by this library.
create.github.context <- function(api_url = "https://api.github.com", client_id = NULL,
client_secret = NULL, access_token = NULL, personal_token = NULL,
max_etags = 10000, verbose = FALSE)
{
if (is.null(personal_token) && (Sys.getenv("GITHUB_PAT") != "")) {
personal_token <- Sys.getenv("GITHUB_PAT")
}
ctx <- list(api_url = api_url,
client_secret = client_secret,
personal_token = personal_token,
token = access_token,
client_id = client_id,
max_etags = max_etags,
etags = new.env(parent = emptyenv()),
authenticated = !is.null(access_token),
verbose = verbose)
if (!is.null(access_token) || !is.null(personal_token)) {
r <- get.myself(ctx)
if (!r$ok) {
if (!is.null(access_token))
stop("invalid access_token.")
if (!is.null(personal_token))
stop("invalid (perhaps revoked?) personal_token.")
stop("internal error, shouldn't have gotten here")
}
ctx$user <- r$content
ctx$oath_scopes <- r$headers$`x-oauth-scopes`
}
class(ctx) <- "githubcontext"
.state$ctx <- ctx
ctx
}
#' returns the most recently created github context, or creates one if none has been so far created
#'
#' @return a github context object
get.github.context <- function()
{
if (is.null(.state$ctx))
create.github.context()
.state$ctx
}
.build.url <- function(ctx, resource, params)
{
# FIXME this path needs sanitization (some names can't include
# slashes, etc) NB if you ever fix this, the *.reference calls in
# data.R will need attention, since reference include slashes that
# are passed unescaped to the github API
query <- params
if (!is.null(ctx$client_id))
query$client_id <- ctx$client_id
if (!is.null(ctx$client_secret))
query$client_secret <- ctx$client_secret
# we cannot use modify_url directly, because it doesn't merge paths
# so we have to do that by hand
api.path <- parse_url(ctx$api_url)$path
if (isTRUE(nzchar(api.path)))
path <- gsub('//+', '/', paste(api.path, resource, sep = '/'))
else
path <- resource
if (is.null(ctx$token) && is.null(ctx$personal_token))
return(list(url = modify_url(ctx$api_url, path = path, query = query),
config = c()))
if (!is.null(ctx$personal_token))
return(list(url = modify_url(ctx$api_url, path = path, query = query),
config = authenticate(ctx$personal_token, "x-oauth-basic", type = "basic")))
# from here on out, ctx$token is not null
# FIXME this is ugly: we use httr's refclass for the interactive flow, but a string for the non-interactive flow...
if (!is.null(tryCatch(ctx$token$sign, error=function(cond) { NULL }))) {
# we have sign: this came from the interactive flow...
result <- modify_url(ctx$api_url, path = path, query = query)
result <- ctx$token$sign(url = result)
result <- result$url
return(list(url = result, config = c()))
} else {
# we don't have sign: this came from the non-interactive flow.
query$access_token <- ctx$token
result <- modify_url(ctx$api_url, path = path, query = query)
return(list(url = result, config = c()))
}
}
.cached.api.request <- function(ctx, req, method, expect.code = 200,
params = list(), config = accept_json())
{
resource <- str_c(req, collapse = '/')
etags <- ctx$etags
if (exists(resource, etags)) {
cache <- get(resource, etags)
tag <- cache$tag
r <- .api.request(ctx, req, method, expect.code = c(304, expect.code),
params = params, config = c(add_headers(`If-None-Match`=tag), config))
if (r$code == 304) {
r$content <- cache$content
}
} else {
r <- .api.request(ctx, req, method, expect.code = expect.code,
params = params, config = config)
}
if (r$code != 304) {
assign(resource, list(tag = r$headers$ETag, content = r$content), etags)
}
# if etags environment is too large, we need to trim it. but this
# requires a traversal over the entire data structure, which is O(n)
# so we only want this to happen once every O(n) operations to get
# O(1) amortized time, and so we need to trim a constant fraction of
# the elements at once. we get rid of half of them.
#
# We choose the entries to trim randomly.
if (length(etags) > ctx$max_etags) {
l <- as.list(etags)
names_to_remove <- names(sample(as.list(etags), as.integer(length(etags)/2)))
print(names_to_remove)
print(names(as.list(etags)))
rm(list=names_to_remove, envir=etags)
}
r
}
.api.request <- function(ctx, req, method, expect.code = 200,
params = list(), config = accept_json(), body = NULL)
{
resource <- str_c(req, collapse = '/')
lst <- .build.url(ctx, resource, params)
url <- lst$url
config <- c(config, lst$config)
config <- c(config, user_agent(getOption("HTTPUserAgent")), add_headers(Accept = "application/vnd.github.beta+json"))
if (ctx$verbose)
config <- c(config, verbose())
r <- method(url = url, config = config, body = body)
result <- tryCatch(content(r),
error = function(e) {
raw <- r$content
raw[raw>127] <- as.raw(63)
r$content <- raw
content(r)
})
output <-
list(ok = r$status_code %in% expect.code, content = result, headers = r$headers,
code = r$status_code)
## class(output) <- "github"
output
}
.without.body <- function(method)
{
function(url, config, body) { method(url, config = config) }
}
.with.body <- function(method) {
function(url, config, body) {
if (is.list(body)) {
body <- toJSON(body, auto_unbox=TRUE, null="null")
# config = c(config, add_headers(`Content-Type` = "application/json; charset=utf-8"))
}
else if (is.character(body))
stopifnot(length(body) == 1)
else
stopifnot(is.null(body))
method(url, config = config, body = body)
}
}
.api.get.request <- function(ctx, req, expect.code = 200, params = list(), config = accept_json()) .cached.api.request(ctx, req, .without.body(GET), expect.code, params, config)
.api.delete.request <- function(ctx, req, expect.code = 204, params = list(), config = accept_json()) .api.request(ctx, req, .without.body(DELETE), expect.code, params, config)
.api.put.request <- function(ctx, req, expect.code = 200, params = list(), config = accept_json(), body = NULL) .api.request(ctx, req, .with.body(PUT), expect.code, params, config, body)
.api.patch.request <- function(ctx, req, expect.code = 200, params = list(), config = accept_json(), body = NULL) .api.request(ctx, req, .with.body(PATCH), expect.code, params, config, body)
.api.post.request <- function(ctx, req, expect.code = 201, params = list(), config = accept_json(), body = NULL) .api.request(ctx, req, .with.body(POST), expect.code, params, config, body)
.api.test.request <- function(ctx, path)
{
r=.api.get.request(ctx, path, expect.code = c(204, 404))
if(r$ok)
list(ok = TRUE, content = r$code == 204)
else
list(ok = FALSE, content = content(r$response))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.