\n"), ignore_attr = TRUE)
expect_equal(class(res), c("gh_response", "list"))
})
test_that("captures details to recreate request", {
skip_on_cran()
res <- gh("/orgs/{org}/repos", org = "r-lib", .per_page = 1)
req <- attr(res, "request")
expect_type(req, "list")
expect_equal(req$url, "https://api.github.com/orgs/r-lib/repos")
expect_equal(req$query, list(per_page = 1))
})
test_that("output file is not overwritten on error", {
tmp <- withr::local_tempfile()
writeLines("foo", tmp)
err <- tryCatch(
gh("/repos", .destfile = tmp),
error = function(e) e
)
expect_true(file.exists(tmp))
expect_equal(readLines(tmp), "foo")
expect_true(!is.null((err$response_content)))
})
gh/tests/testthat/helper.R 0000644 0001762 0000144 00000000657 14373116443 015272 0 ustar ligges users test_package_root <- function() {
x <- tryCatch(
rprojroot::find_package_root_file(),
error = function(e) NULL
)
if (!is.null(x)) {
return(x)
}
pkg <- testthat::testing_package()
x <- tryCatch(
rprojroot::find_package_root_file(
path = file.path("..", "..", "00_pkg_src", pkg)
),
error = function(e) NULL
)
if (!is.null(x)) {
return(x)
}
stop("Cannot find package root")
}
gh/tests/testthat/test-pagination.R 0000644 0001762 0000144 00000002025 15015013734 017101 0 ustar ligges users test_that("can extract relative pages", {
skip_on_cran()
page1 <- gh("/orgs/tidyverse/repos", per_page = 1)
expect_true(gh_has(page1, "next"))
expect_false(gh_has(page1, "prev"))
page2 <- gh_next(page1)
expect_equal(
attr(page2, "request")$url,
"https://api.github.com/organizations/22032646/repos?per_page=1&page=2"
)
expect_true(gh_has(page2, "prev"))
expect_snapshot(gh_prev(page1), error = TRUE)
})
test_that("can paginate even when space re-encoded to +", {
skip_on_cran()
json <- gh::gh(
"GET /search/issues",
q = 'label:"tidy-dev-day :nerd_face:"',
per_page = 10,
.limit = 20
)
expect_length(json$items, 20)
})
test_that("paginated request gets max_wait and max_rate", {
skip_on_cran()
gh <- gh("/orgs/tidyverse/repos", per_page = 5, .max_wait = 1, .max_rate = 10)
req <- gh_link_request(gh, "next", .token = NULL, .send_headers = NULL)
expect_equal(req$max_wait, 1)
expect_equal(req$max_rate, 10)
url <- httr2::url_parse(req$url)
expect_equal(url$query$page, "2")
})
gh/tests/testthat/test-gh_request.R 0000644 0001762 0000144 00000007322 15015003317 017117 0 ustar ligges users test_that("all forms of specifying endpoint are equivalent", {
r1 <- gh_build_request("GET /rate_limit")
expect_equal(r1$method, "GET")
expect_equal(r1$url, "https://api.github.com/rate_limit")
expect_equal(gh_build_request("/rate_limit"), r1)
expect_equal(gh_build_request("GET https://api.github.com/rate_limit"), r1)
expect_equal(gh_build_request("https://api.github.com/rate_limit"), r1)
})
test_that("method arg sets default method", {
r <- gh_build_request("/rate_limit", method = "POST")
expect_equal(r$method, "POST")
})
test_that("parameter substitution is equivalent to direct specification (:)", {
subst <-
gh_build_request(
"POST /repos/:org/:repo/issues/:number/labels",
params = list(
org = "ORG",
repo = "REPO",
number = "1",
"body"
)
)
spec <-
gh_build_request(
"POST /repos/ORG/REPO/issues/1/labels",
params = list("body")
)
expect_identical(subst, spec)
})
test_that("parameter substitution is equivalent to direct specification", {
subst <-
gh_build_request(
"POST /repos/{org}/{repo}/issues/{number}/labels",
params = list(
org = "ORG",
repo = "REPO",
number = "1",
"body"
)
)
spec <-
gh_build_request(
"POST /repos/ORG/REPO/issues/1/labels",
params = list("body")
)
expect_identical(subst, spec)
})
test_that("URI templates that need expansion are detected", {
expect_true(is_uri_template("/orgs/{org}/repos"))
expect_true(is_uri_template("/repos/{owner}/{repo}"))
expect_false(is_uri_template("/user/repos"))
})
test_that("older 'colon templates' are detected", {
expect_true(is_colon_template("/orgs/:org/repos"))
expect_true(is_colon_template("/repos/:owner/:repo"))
expect_false(is_colon_template("/user/repos"))
})
test_that("gh_set_endpoint() works", {
# no expansion, no extra params
input <- list(endpoint = "/user/repos")
expect_equal(input, gh_set_endpoint(input))
# no expansion, with extra params
input <- list(endpoint = "/user/repos", params = list(page = 2))
expect_equal(input, gh_set_endpoint(input))
# expansion, no extra params
input <- list(
endpoint = "/repos/{owner}/{repo}",
params = list(owner = "OWNER", repo = "REPO")
)
out <- gh_set_endpoint(input)
expect_equal(
out,
list(endpoint = "/repos/OWNER/REPO", params = list())
)
# expansion, with extra params
input <- list(
endpoint = "/repos/{owner}/{repo}/issues",
params = list(state = "open", owner = "OWNER", repo = "REPO", page = 2)
)
out <- gh_set_endpoint(input)
expect_equal(out$endpoint, "/repos/OWNER/REPO/issues")
expect_equal(out$params, list(state = "open", page = 2))
})
test_that("gh_set_endpoint() refuses to substitute an NA", {
input <- list(
endpoint = "POST /orgs/{org}/repos",
params = list(org = NA)
)
expect_snapshot(error = TRUE, gh_set_endpoint(input))
})
test_that("gh_set_endpoint() allows a named NA in body for non-GET", {
input <- list(
endpoint = "PUT /repos/{owner}/{repo}/pages",
params = list(owner = "OWNER", repo = "REPO", cname = NA)
)
out <- gh_set_endpoint(input)
expect_equal(out$endpoint, "PUT /repos/OWNER/REPO/pages")
expect_equal(out$params, list(cname = NA))
})
test_that("gh_set_url() ensures URL is in 'API form'", {
input <- list(
endpoint = "/user/repos",
api_url = "https://github.com"
)
out <- gh_set_url(input)
expect_equal(out$api_url, "https://api.github.com")
input$api_url <- "https://github.acme.com"
out <- gh_set_url(input)
expect_equal(out$api_url, "https://github.acme.com/api/v3")
})
test_that("gh_make_request() errors if unknown verb", {
expect_snapshot_error(gh("geeet /users/hadley/repos", .limit = 2))
})
gh/tests/testthat/helper-offline.R 0000644 0001762 0000144 00000001054 15015003317 016667 0 ustar ligges users skip_if_no_github <- function(has_scope = NULL) {
skip_if_offline("github.com")
skip_on_cran()
if (gh_token() == "") {
skip("No GitHub token")
}
if (!is.null(has_scope) && !has_scope %in% test_scopes()) {
skip(cli::format_inline("Current token lacks '{has_scope}' scope"))
}
}
test_scopes <- function() {
# whoami fails on GHA
whoami <- env_cache(
cache,
"whoami",
tryCatch(
gh_whoami(),
error = function(err) list(scopes = "")
)
)
strsplit(whoami$scopes, ", ")[[1]]
}
cache <- new_environment()
gh/tests/testthat/test-gh_token.R 0000644 0001762 0000144 00000013330 15015003317 016543 0 ustar ligges users test_that("URL specific token is used", {
good <- gh_pat(strrep("a", 40))
good2 <- gh_pat(strrep("b", 40))
bad <- gh_pat(strrep("0", 40))
bad2 <- gh_pat(strrep("1", 40))
env <- c(
GITHUB_API_URL = "https://github.acme.com",
GITHUB_PAT_GITHUB_ACME_COM = good,
GITHUB_PAT_GITHUB_ACME2_COM = good2,
GITHUB_PAT = bad,
GITHUB_TOKEN = bad2
)
withr::with_envvar(env, {
expect_equal(gh_token(), good)
expect_equal(gh_token("https://github.acme2.com"), good2)
})
env <- c(
GITHUB_API_URL = NA,
GITHUB_PAT_GITHUB_COM = good,
GITHUB_PAT = bad,
GITHUB_TOKEN = bad2
)
withr::with_envvar(env, {
expect_equal(gh_token(), good)
expect_equal(gh_token("https://api.github.com"), good)
})
})
test_that("fall back to GITHUB_PAT, then GITHUB_TOKEN", {
pat <- gh_pat(strrep("a", 40))
token <- gh_pat(strrep("0", 40))
env <- c(
GITHUB_API_URL = NA,
GITHUB_PAT_GITHUB_COM = NA,
GITHUB_PAT = pat,
GITHUB_TOKEN = token
)
withr::with_envvar(env, {
expect_equal(gh_token(), pat)
expect_equal(gh_token("https://api.github.com"), pat)
})
env <- c(
GITHUB_API_URL = NA,
GITHUB_PAT_GITHUB_COM = NA,
GITHUB_PAT = NA,
GITHUB_TOKEN = token
)
withr::with_envvar(env, {
expect_equal(gh_token(), token)
expect_equal(gh_token("https://api.github.com"), token)
})
})
test_that("gh_token_exists works as expected", {
withr::local_envvar(GITHUB_API_URL = "https://test.com")
withr::local_envvar(GITHUB_PAT_TEST_COM = NA)
expect_false(gh_token_exists())
withr::local_envvar(GITHUB_PAT_TEST_COM = gh_pat(strrep("0", 40)))
expect_true(gh_token_exists())
withr::local_envvar(GITHUB_PAT_TEST_COM = "invalid")
expect_false(gh_token_exists())
})
# gh_pat class ----
test_that("validate_gh_pat() rejects bad characters, wrong # of characters", {
# older PATs
expect_error(gh_pat(strrep("a", 40)), NA)
expect_error(
gh_pat(strrep("g", 40)),
"40 hexadecimal digits",
class = "error"
)
expect_error(gh_pat("aa"), "40 hexadecimal digits", class = "error")
# newer PATs
expect_error(gh_pat(paste0("ghp_", strrep("B", 36))), NA)
expect_error(gh_pat(paste0("ghp_", strrep("3", 251))), NA)
expect_error(gh_pat(paste0("github_pat_", strrep("A", 36))), NA)
expect_error(gh_pat(paste0("github_pat_", strrep("3", 244))), NA)
expect_error(
gh_pat(paste0("ghJ_", strrep("a", 36))),
"prefix",
class = "error"
)
expect_error(
gh_pat(paste0("github_pa_", strrep("B", 244))),
"github_pat_",
class = "error"
)
})
test_that("format.gh_pat() and str.gh_pat() hide the middle stuff", {
pat <- paste0(strrep("a", 10), strrep("4", 20), strrep("F", 10))
expect_match(format(gh_pat(pat)), "[a-zA-Z]+")
expect_output(str(gh_pat(pat)), "[a-zA-Z]+")
})
test_that("str.gh_pat() indicates it's a `gh_pat`", {
pat <- paste0(strrep("a", 10), strrep("4", 20), strrep("F", 10))
expect_output(str(gh_pat(pat)), "gh_pat")
})
test_that("format.gh_pat() handles empty string", {
expect_match(format(gh_pat("")), "")
})
# URL processing helpers ----
test_that("get_baseurl() insists on http(s)", {
expect_snapshot(error = TRUE, {
get_baseurl("github.com")
get_baseurl("github.acme.com")
})
})
test_that("get_baseurl() works", {
x <- "https://github.com"
expect_equal(get_baseurl("https://github.com"), x)
expect_equal(get_baseurl("https://github.com/"), x)
expect_equal(get_baseurl("https://github.com/stuff"), x)
expect_equal(get_baseurl("https://github.com/stuff/"), x)
expect_equal(get_baseurl("https://github.com/more/stuff"), x)
x <- "https://api.github.com"
expect_equal(get_baseurl("https://api.github.com"), x)
expect_equal(get_baseurl("https://api.github.com/rate_limit"), x)
x <- "https://github.acme.com"
expect_equal(get_baseurl("https://github.acme.com"), x)
expect_equal(get_baseurl("https://github.acme.com/"), x)
expect_equal(get_baseurl("https://github.acme.com/api/v3"), x)
# so (what little) support we have for user@host doesn't regress
expect_equal(
get_baseurl("https://jane@github.acme.com/api/v3"),
"https://jane@github.acme.com"
)
})
test_that("is_github_dot_com() works", {
expect_true(is_github_dot_com("https://github.com"))
expect_true(is_github_dot_com("https://api.github.com"))
expect_true(is_github_dot_com("https://api.github.com/rate_limit"))
expect_true(is_github_dot_com("https://api.github.com/graphql"))
expect_false(is_github_dot_com("https://github.acme.com"))
expect_false(is_github_dot_com("https://github.acme.com/api/v3"))
expect_false(is_github_dot_com("https://github.acme.com/api/v3/user"))
})
test_that("get_hosturl() works", {
x <- "https://github.com"
expect_equal(get_hosturl("https://github.com"), x)
expect_equal(get_hosturl("https://api.github.com"), x)
x <- "https://github.acme.com"
expect_equal(get_hosturl("https://github.acme.com"), x)
expect_equal(get_hosturl("https://github.acme.com/api/v3"), x)
})
test_that("get_apiurl() works", {
x <- "https://api.github.com"
expect_equal(get_apiurl("https://github.com"), x)
expect_equal(get_apiurl("https://github.com/"), x)
expect_equal(get_apiurl("https://github.com/r-lib/gh/issues"), x)
expect_equal(get_apiurl("https://api.github.com"), x)
expect_equal(get_apiurl("https://api.github.com/rate_limit"), x)
x <- "https://github.acme.com/api/v3"
expect_equal(get_apiurl("https://github.acme.com"), x)
expect_equal(get_apiurl("https://github.acme.com/OWNER/REPO"), x)
expect_equal(get_apiurl("https://github.acme.com/api/v3"), x)
})
test_that("tokens can be requested from a Connect server", {
skip_if_not_installed("connectcreds")
token <- strrep("a", 40)
connectcreds::local_mocked_connect_responses(token = token)
expect_equal(gh_token(), gh_pat(token))
})
gh/tests/testthat/_snaps/ 0000755 0001762 0000144 00000000000 15015013670 015133 5 ustar ligges users gh/tests/testthat/_snaps/gh_whoami.md 0000644 0001762 0000144 00000001233 15015014675 017424 0 ustar ligges users # whoami errors with bad/absent PAT
Code
gh_whoami(.token = "")
Message
No personal access token (PAT) available.
Obtain a PAT from here:
https://github.com/settings/tokens
For more on what to do with the PAT, see ?gh_whoami.
Code
gh_whoami(.token = NA)
Condition
Error in `gh()`:
! GitHub API error (401): Requires authentication
i Read more at
Code
gh_whoami(.token = "blah")
Condition
Error in `gh()`:
! GitHub API error (401): Bad credentials
i Read more at
gh/tests/testthat/_snaps/pagination.md 0000644 0001762 0000144 00000000204 15015014715 017603 0 ustar ligges users # can extract relative pages
Code
gh_prev(page1)
Condition
Error in `gh_link_request()`:
! No prev page
gh/tests/testthat/_snaps/gh_response.md 0000644 0001762 0000144 00000000226 15015014674 017776 0 ustar ligges users # warns if output is HTML
Code
res <- gh("POST /markdown", text = "foo")
Condition
Warning:
Response came back as html :(
gh/tests/testthat/_snaps/gh.md 0000644 0001762 0000144 00000000727 15015014710 016055 0 ustar ligges users # generates a useful message
Code
gh("/missing")
Condition
Error in `gh()`:
! GitHub API error (404): Not Found
x URL not found:
i Read more at
# can use per_page or .per_page but not both
Code
gh("/orgs/tidyverse/repos", per_page = 1, .per_page = 2)
Condition
Error in `gh()`:
! Exactly one of `per_page` or `.per_page` must be supplied.
gh/tests/testthat/_snaps/print.md 0000644 0001762 0000144 00000002777 15015014716 016630 0 ustar ligges users # can print all types of object
Code
json
Output
{
"name": "LICENSE",
"path": "LICENSE",
"sha": "c71242092c79fcc895841ca3e7de5bbcc551cde5",
"size": 81,
"url": "https://api.github.com/repos/r-lib/gh/contents/LICENSE?ref=v1.2.0",
"html_url": "https://github.com/r-lib/gh/blob/v1.2.0/LICENSE",
"git_url": "https://api.github.com/repos/r-lib/gh/git/blobs/c71242092c79fcc895841ca3e7de5bbcc551cde5",
"download_url": "https://raw.githubusercontent.com/r-lib/gh/v1.2.0/LICENSE",
"type": "file",
"content": "WUVBUjogMjAxNS0yMDIwCkNPUFlSSUdIVCBIT0xERVI6IEfDoWJvciBDc8Oh\ncmRpLCBKZW5uaWZlciBCcnlhbiwgSGFkbGV5IFdpY2toYW0K\n",
"encoding": "base64",
"_links": {
"self": "https://api.github.com/repos/r-lib/gh/contents/LICENSE?ref=v1.2.0",
"git": "https://api.github.com/repos/r-lib/gh/git/blobs/c71242092c79fcc895841ca3e7de5bbcc551cde5",
"html": "https://github.com/r-lib/gh/blob/v1.2.0/LICENSE"
}
}
Code
file
Output
[1] "LICENSE"
attr(,"class")
[1] "gh_response" "path"
Code
raw
Output
[1] 59 45 41 52 3a 20 32 30 31 35 2d 32 30 32 30 0a 43 4f 50 59 52 49 47 48 54
[26] 20 48 4f 4c 44 45 52 3a 20 47 c3 a1 62 6f 72 20 43 73 c3 a1 72 64 69 2c 20
[51] 4a 65 6e 6e 69 66 65 72 20 42 72 79 61 6e 2c 20 48 61 64 6c 65 79 20 57 69
[76] 63 6b 68 61 6d 0a
attr(,"class")
[1] "gh_response" "raw"
gh/tests/testthat/_snaps/gh_request.md 0000644 0001762 0000144 00000000407 15015014671 017626 0 ustar ligges users # gh_set_endpoint() refuses to substitute an NA
Code
gh_set_endpoint(input)
Condition
Error in `gh_set_endpoint()`:
! Named NA parameters are not allowed: org
# gh_make_request() errors if unknown verb
Unknown HTTP verb: "GEEET"
gh/tests/testthat/_snaps/gh_token.md 0000644 0001762 0000144 00000000454 15015014675 017264 0 ustar ligges users # get_baseurl() insists on http(s)
Code
get_baseurl("github.com")
Condition
Error in `get_baseurl()`:
! Only works with HTTP(S) protocols
Code
get_baseurl("github.acme.com")
Condition
Error in `get_baseurl()`:
! Only works with HTTP(S) protocols
gh/tests/testthat/_snaps/utils.md 0000644 0001762 0000144 00000000664 15015014716 016625 0 ustar ligges users # named NA is error
Code
check_named_nas(tc)
Condition
Error in `check_named_nas()`:
! Named NA parameters are not allowed: `a`
---
Code
check_named_nas(tc)
Condition
Error in `check_named_nas()`:
! Named NA parameters are not allowed: `a`
---
Code
check_named_nas(tc)
Condition
Error in `check_named_nas()`:
! Named NA parameters are not allowed: `c`
gh/tests/testthat/_snaps/gh_rate_limit.md 0000644 0001762 0000144 00000000515 15015014670 020266 0 ustar ligges users # errors
Code
gh_rate_limit(list())
Condition
Error in `gh_rate_limit()`:
! inherits(response, "gh_response") is not TRUE
Code
gh_rate_limits(.token = "bad")
Condition
Error in `gh()`:
! GitHub API error (401): Bad credentials
i Read more at
gh/tests/testthat/test-git.R 0000644 0001762 0000144 00000001676 14223565475 015564 0 ustar ligges users test_that("picks origin if available", {
remotes <- list(
upstream = "https://github.com/x/1",
origin = "https://github.com/x/2"
)
expect_warning(gr <- github_remote(remotes, "."), "Using origin")
expect_equal(gr$repo, "2")
})
test_that("otherwise picks first", {
remotes <- list(
a = "https://github.com/x/1",
b = "https://github.com/x/2"
)
expect_warning(gr <- github_remote(remotes, "."), "Using first")
expect_equal(gr$repo, "1")
})
# Parsing -----------------------------------------------------------------
test_that("parses common url forms", {
expected <- list(username = "x", repo = "y")
expect_equal(github_remote_parse("https://github.com/x/y.git"), expected)
expect_equal(github_remote_parse("https://github.com/x/y"), expected)
expect_equal(github_remote_parse("git@github.com:x/y.git"), expected)
})
test_that("returns NULL if can't parse", {
expect_equal(github_remote_parse("blah"), NULL)
})
gh/tests/testthat/test-gh_rate_limit.R 0000644 0001762 0000144 00000001511 15015003317 017552 0 ustar ligges users test_that("good input", {
mock_res <- structure(
list(),
class = "gh_response",
response = list(
"x-ratelimit-limit" = "5000",
"x-ratelimit-remaining" = "4999",
"x-ratelimit-reset" = "1580507619"
)
)
limit <- gh_rate_limit(mock_res)
expect_equal(limit$limit, 5000L)
expect_equal(limit$remaining, 4999L)
expect_s3_class(limit$reset, "POSIXct") # Avoiding tz issues
})
test_that("errors", {
expect_snapshot(error = TRUE, {
gh_rate_limit(list())
gh_rate_limits(.token = "bad")
})
})
test_that("missing rate limit", {
mock_res <- structure(
list(),
class = "gh_response",
response = list()
)
limit <- gh_rate_limit(mock_res)
expect_equal(limit$limit, NA_integer_)
expect_equal(limit$remaining, NA_integer_)
expect_equal(as.double(limit$reset), NA_real_)
})
gh/tests/testthat/test-gh_whoami.R 0000644 0001762 0000144 00000001003 14750174036 016715 0 ustar ligges users test_that("whoami works in presence of PAT", {
skip_if_no_github(has_scope = "user")
res <- gh_whoami()
expect_s3_class(res, "gh_response")
expect_match(res[["scopes"]], "\\buser\\b")
})
test_that("whoami errors with bad/absent PAT", {
skip_if_no_github()
skip_on_ci() # since no token sometimes fails due to rate-limiting
withr::local_envvar(GH_FORCE_HTTP_1_1 = "true")
expect_snapshot(error = TRUE, {
gh_whoami(.token = "")
gh_whoami(.token = NA)
gh_whoami(.token = "blah")
})
})
gh/tests/testthat/setup.R 0000644 0001762 0000144 00000000126 14750174036 015143 0 ustar ligges users withr::local_options(
gh_cache = FALSE,
.local_envir = testthat::teardown_env()
)
gh/tests/testthat/test-mock-repos.R 0000644 0001762 0000144 00000002244 14750174036 017042 0 ustar ligges users if (!exists("TMPL", environment(), inherits = FALSE)) {
TMPL <- function(x) x
}
test_that("repos, some basics", {
skip_if_no_github()
res <- gh(
TMPL("/users/{username}/repos"),
username = "gaborcsardi"
)
expect_true(all(c("id", "name", "full_name") %in% names(res[[1]])))
res <- gh(
TMPL("/orgs/{org}/repos"),
org = "r-lib",
type = "sources",
sort = "full_name"
)
expect_true("actions" %in% vapply(res, "[[", "name", FUN.VALUE = ""))
res <- gh("/repositories")
expect_true(all(c("id", "name", "full_name") %in% names(res[[1]])))
})
test_that("can POST, PATCH, and DELETE", {
skip_if_no_github(has_scope = "gist")
res <- gh(
"POST /gists",
files = list(test.R = list(content = "test")),
description = "A test gist for gh",
public = FALSE
)
expect_equal(res$description, "A test gist for gh")
expect_false(res$public)
res <- gh(
TMPL("PATCH /gists/{gist_id}"),
gist_id = res$id,
description = "Still a test repo"
)
expect_equal(res$description, "Still a test repo")
res <- gh(
TMPL("DELETE /gists/{gist_id}"),
gist_id = res$id
)
expect_s3_class(res, c("gh_response", "list"))
})
gh/tests/testthat.R 0000644 0001762 0000144 00000000134 14601241337 013774 0 ustar ligges users library(testthat)
library(gh)
if (Sys.getenv("NOT_CRAN") == "true") {
test_check("gh")
}
gh/MD5 0000644 0001762 0000144 00000007722 15015064052 011166 0 ustar ligges users 8211f2f0fd435bbd01dd551b82c2cf85 *DESCRIPTION
bd91a855238c3c0aa73fd869d9f14916 *LICENSE
f64db1274ce7385f8f2806e427e7010a *NAMESPACE
283609f3400e3557e952983725d09461 *NEWS.md
e84ddd9f282daf491f9634956ce47f93 *R/gh-package.R
077702d13212395e1a888e55800c3b27 *R/gh.R
ca17d82a40f42225eb8dc9322d04e9bb *R/gh_gql.R
26476bcd87606991b2d9d670d68217cc *R/gh_rate_limit.R
1c4db786c4b9d3bae3e68a10e09278f4 *R/gh_request.R
2dfac0a8c1d001dc5b60bec53a7e5f2e *R/gh_response.R
108614ac8e8f66ac7954e9f3684e7b08 *R/gh_token.R
403744529388dd4f29e5823d726b50e0 *R/gh_whoami.R
64667396ee7b78e87243d5f29950e15e *R/git.R
17bb123964057b839a42eda1c3da214b *R/import-standalone-purrr.R
109c7645e2e521840e883852f439e873 *R/pagination.R
6fff38f1a350df5ddebd6e3b6b531c43 *R/print.R
7bd6f736638f85ccad1f9882f1c185ae *R/utils.R
f72fbd625a960d00579ca944d0eff239 *README.md
4d7a1c445b78b6d3a77fc9bb7d41bb63 *build/vignette.rds
0b8f640c270c48bb0d9f20030b2957d9 *inst/WORDLIST
a84afedf0b3deb53141f30ca08e7e90c *inst/doc/managing-personal-access-tokens.R
20d1dd6826e49455214952498afa11a6 *inst/doc/managing-personal-access-tokens.Rmd
404774f1bdd966f33afd9d7db13223e5 *inst/doc/managing-personal-access-tokens.html
a1cbaf3f328e8d74e747faacf640c7fc *man/figures/lifecycle-archived.svg
6f521fb1819410630e279d1abf88685a *man/figures/lifecycle-defunct.svg
391f696f961e28914508628a7af31b74 *man/figures/lifecycle-deprecated.svg
691b1eb2aec9e1bec96b79d11ba5e631 *man/figures/lifecycle-experimental.svg
405e252e54a79b33522e9699e4e9051c *man/figures/lifecycle-maturing.svg
f41ed996be135fb35afe00641621da61 *man/figures/lifecycle-questioning.svg
306bef67d1c636f209024cf2403846fd *man/figures/lifecycle-soft-deprecated.svg
ed42e3fbd7cc30bc6ca8fa9b658e24a8 *man/figures/lifecycle-stable.svg
bf2f1ad432ecccee3400afe533404113 *man/figures/lifecycle-superseded.svg
1ef2d754b07ca597600306f7e158a334 *man/gh-package.Rd
926ff91d12abd86953c1fa9470b34f1c *man/gh.Rd
1804a42608e30f6047e673e5b6b85241 *man/gh_gql.Rd
2413b7a21096224eae890956b9aba761 *man/gh_next.Rd
16bc081bfc798c2ebc0c6b504f50f1a0 *man/gh_rate_limit.Rd
669344f432bc42847db2d9a6f8537cc1 *man/gh_token.Rd
8dc288d4beadb347828028716153ed0c *man/gh_tree_remote.Rd
ac3f8c23cbaf8435d42269f8cd84af98 *man/gh_whoami.Rd
016da8202cc86b463da849981d5d309a *man/print.gh_response.Rd
67d4520f09172a8ae7bfeaeb6b9b7c75 *tests/testthat.R
8c5a54ea925758aea587d7ba086127a0 *tests/testthat/_snaps/gh.md
5a3f2df164b36bf0a41be7954cac25af *tests/testthat/_snaps/gh_rate_limit.md
16df903d6b8a127ff0c33674727af4b8 *tests/testthat/_snaps/gh_request.md
1acea78acbb5c87fac8e6ecd73e7dc03 *tests/testthat/_snaps/gh_response.md
c02c7d9a71c147133eb361b78954d200 *tests/testthat/_snaps/gh_token.md
93133d2df287dbb4a8c05d73405ab4b1 *tests/testthat/_snaps/gh_whoami.md
5b97acc5878554d144a813f6673b1143 *tests/testthat/_snaps/pagination.md
2a91521da93c50134ba2df90772462ff *tests/testthat/_snaps/print.md
a36786bcbfe54c33abc64ce8811f2b73 *tests/testthat/_snaps/utils.md
21bb78887f73b9369977d11eddaecd53 *tests/testthat/helper-offline.R
39a379c801a00bcf3e4f54348dc296ec *tests/testthat/helper.R
4115e4ca457eb63e6854c9bda9eae456 *tests/testthat/setup.R
a9e13a45110d0804d9868fb582cd0c6b *tests/testthat/test-gh.R
43ef9c097cb1167cb94b67866ccb0905 *tests/testthat/test-gh_rate_limit.R
8a24e6de7727347fc0e32173b700dd0c *tests/testthat/test-gh_request.R
5eac499a3462330f254e2129a9009b77 *tests/testthat/test-gh_response.R
d0b06ef130dec975fd4e74e08022493d *tests/testthat/test-gh_token.R
d984112a804bf1521e7ef2e73a7b7609 *tests/testthat/test-gh_whoami.R
911d6932b175fd9c50d2de4f964d22de *tests/testthat/test-git.R
563ff71b1ea18b0050361815e9d858bb *tests/testthat/test-mock-repos.R
073fcc251255873a59d1918d12c7dd79 *tests/testthat/test-old-templates.R
b0c9db38cac31b41a3f35e6d8d094b66 *tests/testthat/test-pagination.R
62935ffd6072644a82b92b5173221afd *tests/testthat/test-print.R
942cfab4e734a9cc61513f87ad2c2f8b *tests/testthat/test-spelling.R
89c111502b5a74c8e9d3a439b9a7502c *tests/testthat/test-utils.R
20d1dd6826e49455214952498afa11a6 *vignettes/managing-personal-access-tokens.Rmd
gh/R/ 0000755 0001762 0000144 00000000000 15015013734 011050 5 ustar ligges users gh/R/git.R 0000644 0001762 0000144 00000004750 15015003317 011760 0 ustar ligges users #' Find the GitHub remote associated with a path
#'
#' This is handy helper if you want to make gh requests related to the
#' current project.
#'
#' @param path Path that is contained within a git repo.
#' @return If the repo has a github remote, a list containing `username`
#' and `repo`. Otherwise, an error.
#' @export
#' @examplesIf interactive()
#' gh_tree_remote()
gh_tree_remote <- function(path = ".") {
github_remote(git_remotes(path), path)
}
github_remote <- function(x, path) {
remotes <- lapply(x, github_remote_parse)
remotes <- remotes[!vapply(remotes, is.null, logical(1))]
if (length(remotes) == 0) {
cli::cli_abort("No GitHub remotes found at {.path {path}}")
}
if (length(remotes) > 1) {
if (any(names(remotes) == "origin")) {
warning("Multiple github remotes found. Using origin.", call. = FALSE)
remotes <- remotes[["origin"]]
} else {
warning("Multiple github remotes found. Using first.", call. = FALSE)
remotes <- remotes[[1]]
}
} else {
remotes[[1]]
}
}
github_remote_parse <- function(x) {
if (length(x) == 0) {
return(NULL)
}
if (!grepl("github", x)) {
return(NULL)
}
# https://github.com/hadley/devtools.git
# https://github.com/hadley/devtools
# git@github.com:hadley/devtools.git
re <- "github[^/:]*[/:]([^/]+)/(.*?)(?:\\.git)?$"
m <- regexec(re, x)
match <- regmatches(x, m)[[1]]
if (length(match) == 0) {
return(NULL)
}
list(
username = match[2],
repo = match[3]
)
}
git_remotes <- function(path = ".") {
conf <- git_config(path)
remotes <- conf[grepl("^remote", names(conf))]
remotes <- discard(remotes, function(x) is.null(x$url))
urls <- vapply(remotes, "[[", "url", FUN.VALUE = character(1))
names(urls) <- gsub('^remote "(.*?)"$', "\\1", names(remotes))
urls
}
git_config <- function(path = ".") {
config_path <- file.path(repo_root(path), ".git", "config")
if (!file.exists(config_path)) {
cli::cli_abort("git config does not exist at {.path {path}}")
}
ini::read.ini(config_path, "UTF-8")
}
repo_root <- function(path = ".") {
if (!file.exists(path)) {
cli::cli_abort("Can't find repo at {.path {path}}")
}
# Walk up to root directory
while (!has_git(path)) {
if (is_root(path)) {
cli::cli_abort("Could not find git root from {.path {path}}.")
}
path <- dirname(path)
}
path
}
has_git <- function(path) {
file.exists(file.path(path, ".git"))
}
is_root <- function(path) {
identical(path, dirname(path))
}
gh/R/print.R 0000644 0001762 0000144 00000000701 15015003317 012321 0 ustar ligges users #' Print the result of a GitHub API call
#'
#' @param x The result object.
#' @param ... Ignored.
#' @return The JSON result.
#'
#' @importFrom jsonlite prettify toJSON
#' @export
#' @method print gh_response
print.gh_response <- function(x, ...) {
if (inherits(x, c("raw", "path"))) {
attributes(x) <- list(class = class(x))
print.default(x)
} else {
print(toJSON(unclass(x), pretty = TRUE, auto_unbox = TRUE, force = TRUE))
}
}
gh/R/gh_request.R 0000644 0001762 0000144 00000013702 15015003317 013340 0 ustar ligges users ## Main API URL
default_api_url <- function() {
Sys.getenv("GITHUB_API_URL", unset = "https://api.github.com")
}
## Headers to send with each API request
default_send_headers <- c("User-Agent" = "https://github.com/r-lib/gh")
gh_build_request <- function(
endpoint = "/user",
params = list(),
token = NULL,
destfile = NULL,
overwrite = NULL,
accept = NULL,
send_headers = NULL,
max_wait = 10,
max_rate = NULL,
api_url = NULL,
method = "GET"
) {
working <- list(
method = method,
url = character(),
headers = NULL,
query = NULL,
body = NULL,
endpoint = endpoint,
params = params,
token = token,
accept = c(Accept = accept),
send_headers = send_headers,
api_url = api_url,
dest = destfile,
overwrite = overwrite,
max_wait = max_wait,
max_rate = max_rate
)
working <- gh_set_verb(working)
working <- gh_set_endpoint(working)
working <- gh_set_query(working)
working <- gh_set_body(working)
working <- gh_set_url(working)
working <- gh_set_headers(working)
working <- gh_set_temp_destfile(working)
working[c(
"method",
"url",
"headers",
"query",
"body",
"dest",
"desttmp",
"max_wait",
"max_rate"
)]
}
## gh_set_*(x)
## x = a list in which we build up an httr2 request
## x goes in, x comes out, possibly modified
gh_set_verb <- function(x) {
if (!nzchar(x$endpoint)) {
return(x)
}
# No method defined, so use default
if (grepl("^/", x$endpoint) || grepl("^http", x$endpoint)) {
return(x)
}
# Method can be lower-case (e.g. copy-pasting from API docs in Firefox)
method <- gsub("^([^/ ]+)\\s+.*$", "\\1", x$endpoint)
x$endpoint <- gsub(sprintf("^%s+ ", method), "", x$endpoint)
# Now switch method to upper-case
x$method <- toupper(method)
x
}
gh_set_endpoint <- function(x) {
params <- x$params
if (
!is_template(x$endpoint) || length(params) == 0L || has_no_names(params)
) {
return(x)
}
named_params <- which(has_name(params))
done <- rep_len(FALSE, length(params))
endpoint <- endpoint2 <- x$endpoint
for (i in named_params) {
endpoint2 <- expand_variable(
varname = names(params)[i],
value = params[[i]][1],
template = endpoint
)
if (is.na(endpoint2)) {
cli::cli_abort(
"Named NA parameters are not allowed: {names(params)[i]}"
)
}
if (endpoint2 != endpoint) {
endpoint <- endpoint2
done[i] <- TRUE
}
if (!is_template(endpoint)) {
break
}
}
x$endpoint <- endpoint
x$params <- x$params[!done]
x$params <- cleanse_names(x$params)
x
}
gh_set_query <- function(x) {
params <- x$params
if (x$method != "GET" || length(params) == 0L) {
return(x)
}
stopifnot(all(has_name(params)))
x$query <- params
x$params <- NULL
x
}
gh_set_body <- function(x) {
if (length(x$params) == 0L) {
return(x)
}
if (x$method == "GET") {
warning("This is a 'GET' request and unnamed parameters are being ignored.")
return(x)
}
if (length(x$params) == 1 && is.raw(x$params[[1]])) {
x$body <- x$params[[1]]
} else {
x$body <- x$params
}
x
}
gh_set_url <- function(x) {
if (grepl("^https?://", x$endpoint)) {
x$url <- URLencode(x$endpoint)
x$api_url <- get_baseurl(x$url)
} else {
x$api_url <- get_apiurl(x$api_url %||% default_api_url())
x$url <- URLencode(paste0(x$api_url, x$endpoint))
}
x
}
gh_set_temp_destfile <- function(working) {
working$desttmp <- if (is.null(working$dest)) {
NULL
} else {
paste0(working$dest, "-", basename(tempfile("")), ".gh-tmp")
}
working
}
get_baseurl <- function(url) {
# https://github.uni.edu/api/v3/
if (!any(grepl("^https?://", url))) {
stop("Only works with HTTP(S) protocols")
}
prot <- sub("^(https?://).*$", "\\1", url) # https://
rest <- sub("^https?://(.*)$", "\\1", url) # github.uni.edu/api/v3/
host <- sub("/.*$", "", rest) # github.uni.edu
paste0(prot, host) # https://github.uni.edu
}
# https://api.github.com --> https://github.com
# api.github.com --> github.com
normalize_host <- function(x) {
sub("api[.]github[.]com", "github.com", x)
}
get_hosturl <- function(url) {
url <- get_baseurl(url)
normalize_host(url)
}
# (almost) the inverse of get_hosturl()
# https://github.com --> https://api.github.com
# https://github.uni.edu --> https://github.uni.edu/api/v3
get_apiurl <- function(url) {
host_url <- get_hosturl(url)
prot_host <- strsplit(host_url, "://", fixed = TRUE)[[1]]
if (is_github_dot_com(host_url)) {
paste0(prot_host[[1]], "://api.github.com")
} else {
paste0(host_url, "/api/v3")
}
}
is_github_dot_com <- function(url) {
url <- get_baseurl(url)
url <- normalize_host(url)
grepl("^https?://github.com", url)
}
gh_set_headers <- function(x) {
# x$api_url must be set properly at this point
auth <- gh_auth(x$token %||% gh_token(x$api_url))
send_headers <- gh_send_headers(x$accept, x$send_headers)
x$headers <- c(send_headers, auth)
x
}
gh_send_headers <- function(accept_header = NULL, headers = NULL) {
modify_vector(
modify_vector(default_send_headers, accept_header),
headers
)
}
# helpers ----
# https://tools.ietf.org/html/rfc6570
# we support what the RFC calls "Level 1 templates", which only require
# simple string expansion of a placeholder consisting of [A-Za-z0-9_]
is_template <- function(x) {
is_colon_template(x) || is_uri_template(x)
}
is_colon_template <- function(x) grepl(":", x)
is_uri_template <- function(x) grepl("[{]\\w+?[}]", x)
template_type <- function(x) {
if (is_uri_template(x)) {
return("uri")
}
if (is_colon_template(x)) {
return("colon")
}
}
expand_variable <- function(varname, value, template) {
type <- template_type(template)
if (is.null(type)) {
return(template)
}
pattern <- switch(
type,
uri = paste0("[{]", varname, "[}]"),
colon = paste0(":", varname, "\\b"),
stop("Internal error: unrecognized template type")
)
gsub(pattern, value, template)
}
gh/R/gh.R 0000644 0001762 0000144 00000033321 15015013734 011573 0 ustar ligges users #' Query the GitHub API
#'
#' This is an extremely minimal client. You need to know the API
#' to be able to use this client. All this function does is:
#' * Try to substitute each listed parameter into `endpoint`, using the
#' `{parameter}` notation.
#' * If a GET request (the default), then add all other listed parameters
#' as query parameters.
#' * If not a GET request, then send the other parameters in the request
#' body, as JSON.
#' * Convert the response to an R list using [jsonlite::fromJSON()].
#'
#' @param endpoint GitHub API endpoint. Must be one of the following forms:
#' * `METHOD path`, e.g. `GET /rate_limit`,
#' * `path`, e.g. `/rate_limit`,
#' * `METHOD url`, e.g. `GET https://api.github.com/rate_limit`,
#' * `url`, e.g. `https://api.github.com/rate_limit`.
#'
#' If the method is not supplied, will use `.method`, which defaults
#' to `"GET"`.
#' @param ... Name-value pairs giving API parameters. Will be matched into
#' `endpoint` placeholders, sent as query parameters in GET requests, and as a
#' JSON body of POST requests. If there is only one unnamed parameter, and it
#' is a raw vector, then it will not be JSON encoded, but sent as raw data, as
#' is. This can be used for example to add assets to releases. Named `NULL`
#' values are silently dropped. For GET requests, named `NA` values trigger an
#' error. For other methods, named `NA` values are included in the body of the
#' request, as JSON `null`.
#' @param per_page,.per_page Number of items to return per page. If omitted,
#' will be substituted by `max(.limit, 100)` if `.limit` is set,
#' otherwise determined by the API (never greater than 100).
#' @param .destfile Path to write response to disk. If `NULL` (default),
#' response will be processed and returned as an object. If path is given,
#' response will be written to disk in the form sent. gh writes the
#' response to a temporary file, and renames that file to `.destfile`
#' after the request was successful. The name of the temporary file is
#' created by adding a `-.gh-tmp` suffix to it, where ``
#' is an ASCII string with random characters. gh removes the temporary
#' file on error.
#' @param .overwrite If `.destfile` is provided, whether to overwrite an
#' existing file. Defaults to `FALSE`. If an error happens the original
#' file is kept.
#' @param .token Authentication token. Defaults to [gh_token()].
#' @param .api_url Github API url (default: ). Used
#' if `endpoint` just contains a path. Defaults to `GITHUB_API_URL`
#' environment variable if set.
#' @param .method HTTP method to use if not explicitly supplied in the
#' `endpoint`.
#' @param .limit Number of records to return. This can be used
#' instead of manual pagination. By default it is `NULL`,
#' which means that the defaults of the GitHub API are used.
#' You can set it to a number to request more (or less)
#' records, and also to `Inf` to request all records.
#' Note, that if you request many records, then multiple GitHub
#' API calls are used to get them, and this can take a potentially
#' long time.
#' @param .accept The value of the `Accept` HTTP header. Defaults to
#' `"application/vnd.github.v3+json"` . If `Accept` is given in
#' `.send_headers`, then that will be used. This parameter can be used to
#' provide a custom media type, in order to access a preview feature of
#' the API.
#' @param .send_headers Named character vector of header field values
#' (except `Authorization`, which is handled via `.token`). This can be
#' used to override or augment the default `User-Agent` header:
#' `"https://github.com/r-lib/gh"`.
#' @param .progress Whether to show a progress indicator for calls that
#' need more than one HTTP request.
#' @param .params Additional list of parameters to append to `...`.
#' It is easier to use this than `...` if you have your parameters in
#' a list already.
#' @param .max_wait Maximum number of seconds to wait if rate limited.
#' Defaults to 10 minutes.
#' @param .max_rate Maximum request rate in requests per second. Set
#' this to automatically throttle requests.
#' @return Answer from the API as a `gh_response` object, which is also a
#' `list`. Failed requests will generate an R error. Requests that
#' generate a raw response will return a raw vector.
#'
#' @export
#' @seealso [gh_gql()] if you want to use the GitHub GraphQL API,
#' [gh_whoami()] for details on GitHub API token management.
#' @examplesIf identical(Sys.getenv("IN_PKGDOWN"), "true")
#' ## Repositories of a user, these are equivalent
#' gh("/users/hadley/repos", .limit = 2)
#' gh("/users/{username}/repos", username = "hadley", .limit = 2)
#'
#' ## Starred repositories of a user
#' gh("/users/hadley/starred", .limit = 2)
#' gh("/users/{username}/starred", username = "hadley", .limit = 2)
#' @examplesIf FALSE
#' ## Create a repository, needs a token (see gh_token())
#' gh("POST /user/repos", name = "foobar")
#' @examplesIf identical(Sys.getenv("IN_PKGDOWN"), "true")
#' ## Issues of a repository
#' gh("/repos/hadley/dplyr/issues")
#' gh("/repos/{owner}/{repo}/issues", owner = "hadley", repo = "dplyr")
#'
#' ## Automatic pagination
#' users <- gh("/users", .limit = 50)
#' length(users)
#' @examplesIf FALSE
#' ## Access developer preview of Licenses API (in preview as of 2015-09-24)
#' gh("/licenses") # used to error code 415
#' gh("/licenses", .accept = "application/vnd.github.drax-preview+json")
#' @examplesIf FALSE
#' ## Access Github Enterprise API
#' ## Use GITHUB_API_URL environment variable to change the default.
#' gh("/user/repos", type = "public", .api_url = "https://github.foobar.edu/api/v3")
#' @examplesIf FALSE
#' ## Use I() to force body part to be sent as an array, even if length 1
#' ## This works whether assignees has length 1 or > 1
#' assignees <- "gh_user"
#' assignees <- c("gh_user1", "gh_user2")
#' gh("PATCH /repos/OWNER/REPO/issues/1", assignees = I(assignees))
#' @examplesIf FALSE
#' ## There are two ways to send JSON data. One is that you supply one or
#' ## more objects that will be converted to JSON automatically via
#' ## jsonlite::toJSON(). In this case sometimes you need to use
#' ## jsonlite::unbox() because fromJSON() creates lists from scalar vectors
#' ## by default. The Content-Type header is automatically added in this
#' ## case. For example this request turns on GitHub Pages, using this
#' ## API: https://docs.github.com/v3/repos/pages/#enable-a-pages-site
#'
#' gh::gh(
#' "POST /repos/{owner}/{repo}/pages",
#' owner = "r-lib",
#' repo = "gh",
#' source = list(
#' branch = jsonlite::unbox("gh-pages"),
#' path = jsonlite::unbox("/")
#' ),
#' .send_headers = c(Accept = "application/vnd.github.switcheroo-preview+json")
#' )
#'
#' ## The second way is to handle the JSON encoding manually, and supply it
#' ## as a raw vector in an unnamed argument, and also a Content-Type header:
#'
#' body <- '{ "source": { "branch": "gh-pages", "path": "/" } }'
#' gh::gh(
#' "POST /repos/{owner}/{repo}/pages",
#' owner = "r-lib",
#' repo = "gh",
#' charToRaw(body),
#' .send_headers = c(
#' Accept = "application/vnd.github.switcheroo-preview+json",
#' "Content-Type" = "application/json"
#' )
#' )
#' @examplesIf FALSE
#' ## Pass along a query to the search/code endpoint via the ... argument
#' x <- gh::gh(
#' "/search/code",
#' q = "installation repo:r-lib/gh",
#' .send_headers = c("X-GitHub-Api-Version" = "2022-11-28")
#' )
#' str(x, list.len = 3, give.attr = FALSE)
#'
#'
gh <- function(
endpoint,
...,
per_page = NULL,
.per_page = NULL,
.token = NULL,
.destfile = NULL,
.overwrite = FALSE,
.api_url = NULL,
.method = "GET",
.limit = NULL,
.accept = "application/vnd.github.v3+json",
.send_headers = NULL,
.progress = TRUE,
.params = list(),
.max_wait = 600,
.max_rate = NULL
) {
params <- .parse_params(..., .params = .params)
check_exclusive(per_page, .per_page, .require = FALSE)
per_page <- per_page %||% .per_page
if (is.null(per_page) && !is.null(.limit)) {
per_page <- max(min(.limit, 100), 1)
}
if (!is.null(per_page)) {
params <- c(params, list(per_page = per_page))
}
req <- gh_build_request(
endpoint = endpoint,
params = params,
token = .token,
destfile = .destfile,
overwrite = .overwrite,
accept = .accept,
send_headers = .send_headers,
max_wait = .max_wait,
max_rate = .max_rate,
api_url = .api_url,
method = .method
)
if (req$method == "GET") check_named_nas(params)
raw <- gh_make_request(req)
res <- gh_process_response(raw, req)
len <- gh_response_length(res)
if (.progress && !is.null(.limit)) {
pages <- min(gh_extract_pages(res), ceiling(.limit / per_page))
cli::cli_progress_bar("Running gh query", total = pages)
cli::cli_progress_update() # already done one
}
while (!is.null(.limit) && len < .limit && gh_has_next(res)) {
res2 <- gh_next(res, .token = .token, .send_headers = .send_headers)
len <- len + gh_response_length(res2)
if (.progress) cli::cli_progress_update()
if (!is.null(names(res2)) && identical(names(res), names(res2))) {
res3 <- mapply(
# Handle named array case
function(x, y, n) {
# e.g. GET /search/repositories
z <- c(x, y)
atm <- is.atomic(z)
if (atm && n %in% c("total_count", "incomplete_results")) {
y
} else if (atm) {
unique(z)
} else {
z
}
},
res,
res2,
names(res),
SIMPLIFY = FALSE
)
} else {
# Handle unnamed array case
res3 <- c(res, res2) # e.g. GET /orgs/:org/invitations
}
attributes(res3) <- attributes(res2)
res <- res3
}
if (.progress) cli::cli_progress_done()
# We only subset for a non-named response.
if (
!is.null(.limit) &&
len > .limit &&
!"total_count" %in% names(res) &&
length(res) == len
) {
res_attr <- attributes(res)
res <- res[seq_len(.limit)]
attributes(res) <- res_attr
}
res
}
gh_response_length <- function(res) {
if (
!is.null(names(res)) && length(res) > 1 && names(res)[1] == "total_count"
) {
# Ignore total_count, incomplete_results, repository_selection
# and take the first list element to get the length
lst <- vapply(res, is.list, logical(1))
nm <- setdiff(
names(res),
c("total_count", "incomplete_results", "repository_selection")
)
tgt <- which(lst[nm])[1]
if (is.na(tgt)) length(res) else length(res[[nm[tgt]]])
} else {
length(res)
}
}
gh_make_request <- function(x, error_call = caller_env()) {
if (!x$method %in% c("GET", "POST", "PATCH", "PUT", "DELETE")) {
cli::cli_abort("Unknown HTTP verb: {.val {x$method}}")
}
req <- httr2::request(x$url)
req <- httr2::req_method(req, x$method)
req <- httr2::req_url_query(req, !!!x$query)
if (!is.null((x$body))) {
if (is.raw(x$body)) {
req <- httr2::req_body_raw(req, x$body)
} else {
req <- httr2::req_body_json(req, x$body, null = "list", digits = 4)
}
}
req <- httr2::req_headers(req, !!!x$headers)
# Reduce connection timeout from curl's 10s default to 5s
req <- httr2::req_options(req, connecttimeout_ms = 5000)
if (Sys.getenv("GH_FORCE_HTTP_1_1") == "true") {
req <- httr2::req_options(req, http_version = 2)
}
if (!isFALSE(getOption("gh_cache"))) {
req <- httr2::req_cache(
req,
max_size = 100 * 1024 * 1024, # 100 MB
path = tools::R_user_dir("gh", "cache")
)
}
if (!is_testing()) {
req <- httr2::req_retry(
req,
max_tries = 3,
is_transient = function(resp) github_is_transient(resp, x$max_wait),
after = github_after
)
}
if (!is.null(x$max_rate)) {
req <- httr2::req_throttle(req, x$max_rate)
}
# allow custom handling with gh_error
req <- httr2::req_error(req, is_error = function(resp) FALSE)
resp <- httr2::req_perform(req, path = x$desttmp)
if (httr2::resp_status(resp) >= 400) {
gh_error(resp, gh_req = x, error_call = error_call)
}
resp
}
# https://docs.github.com/v3/#client-errors
gh_error <- function(response, gh_req, error_call = caller_env()) {
heads <- httr2::resp_headers(response)
res <- httr2::resp_body_json(response)
status <- httr2::resp_status(response)
if (!is.null(gh_req$desttmp)) unlink(gh_req$desttmp)
msg <- "GitHub API error ({status}): {heads$status %||% ''} {res$message}"
if (status == 404) {
msg <- c(msg, x = c("URL not found: {.url {response$url}}"))
}
doc_url <- res$documentation_url
if (!is.null(doc_url)) {
msg <- c(msg, c("i" = "Read more at {.url {doc_url}}"))
}
errors <- res$errors
if (!is.null(errors)) {
errors <- as.data.frame(do.call(rbind, errors))
nms <- c("resource", "field", "code", "message")
nms <- nms[nms %in% names(errors)]
msg <- c(
msg,
capture.output(print(errors[nms], row.names = FALSE))
)
}
cli::cli_abort(
msg,
class = c("github_error", paste0("http_error_", status)),
call = error_call,
response_headers = heads,
response_content = res
)
}
# use retry-after info when possible
# https://docs.github.com/en/rest/overview/resources-in-the-rest-api#exceeding-the-rate-limit
github_is_transient <- function(resp, max_wait) {
if (httr2::resp_status(resp) != 403) {
return(FALSE)
}
if (!identical(httr2::resp_header(resp, "x-ratelimit-remaining"), "0")) {
return(FALSE)
}
time <- httr2::resp_header(resp, "x-ratelimit-reset")
if (is.null(time)) {
return(FALSE)
}
time <- as.numeric(time)
minutes_to_wait <- (time - unclass(Sys.time()))
minutes_to_wait <= max_wait
}
github_after <- function(resp) {
time <- as.numeric(httr2::resp_header(resp, "x-ratelimit-reset"))
time - unclass(Sys.time())
}
gh/R/gh_gql.R 0000644 0001762 0000144 00000001635 14223565475 012457 0 ustar ligges users #' A simple interface for the GitHub GraphQL API v4.
#'
#' See more about the GraphQL API here:
#'
#'
#' Note: pagination and the `.limit` argument does not work currently,
#' as pagination in the GraphQL API is different from the v3 API.
#' If you need pagination with GraphQL, you'll need to do that manually.
#'
#' @inheritParams gh
#' @param query The GraphQL query, as a string.
#' @export
#' @seealso [gh()] for the GitHub v3 API.
#' @examplesIf FALSE
#' gh_gql("query { viewer { login }}")
#'
#' # Get rate limit
#' ratelimit_query <- "query {
#' viewer {
#' login
#' }
#' rateLimit {
#' limit
#' cost
#' remaining
#' resetAt
#' }
#' }"
#'
#' gh_gql(ratelimit_query)
gh_gql <- function(query, ...) {
if (".limit" %in% names(list(...))) {
stop("`.limit` does not work with the GraphQL API")
}
gh(endpoint = "POST /graphql", query = query, ...)
}
gh/R/pagination.R 0000644 0001762 0000144 00000005703 15015013734 013331 0 ustar ligges users extract_link <- function(gh_response, link) {
headers <- attr(gh_response, "response")
links <- headers$link
if (is.null(links)) {
return(NA_character_)
}
links <- trim_ws(strsplit(links, ",")[[1]])
link_list <- lapply(links, function(x) {
x <- trim_ws(strsplit(x, ";")[[1]])
name <- sub("^.*\"(.*)\".*$", "\\1", x[2])
value <- sub("^<(.*)>$", "\\1", x[1])
c(name, value)
})
link_list <- structure(
vapply(link_list, "[", "", 2),
names = vapply(link_list, "[", "", 1)
)
if (link %in% names(link_list)) {
link_list[[link]]
} else {
NA_character_
}
}
gh_has <- function(gh_response, link) {
url <- extract_link(gh_response, link)
!is.na(url)
}
gh_has_next <- function(gh_response) {
gh_has(gh_response, "next")
}
gh_link_request <- function(gh_response, link, .token, .send_headers) {
stopifnot(inherits(gh_response, "gh_response"))
url <- extract_link(gh_response, link)
if (is.na(url)) cli::cli_abort("No {link} page")
req <- attr(gh_response, "request")
req$url <- url
req$token <- .token
req$send_headers <- .send_headers
req <- gh_set_headers(req)
req
}
gh_link <- function(gh_response, link, .token, .send_headers) {
req <- gh_link_request(gh_response, link, .token, .send_headers)
raw <- gh_make_request(req)
gh_process_response(raw, req)
}
gh_extract_pages <- function(gh_response) {
last <- extract_link(gh_response, "last")
if (!is.na(last)) {
as.integer(httr2::url_parse(last)$query$page)
} else {
NA
}
}
#' Get the next, previous, first or last page of results
#'
#' @details
#' Note that these are not always defined. E.g. if the first
#' page was queried (the default), then there are no first and previous
#' pages defined. If there is no next page, then there is no
#' next page defined, etc.
#'
#' If the requested page does not exist, an error is thrown.
#'
#' @param gh_response An object returned by a [gh()] call.
#' @inheritParams gh
#' @return Answer from the API.
#'
#' @seealso The `.limit` argument to [gh()] supports fetching more than
#' one page.
#'
#' @name gh_next
#' @export
#' @examplesIf identical(Sys.getenv("IN_PKGDOWN"), "true")
#' x <- gh("/users")
#' vapply(x, "[[", character(1), "login")
#' x2 <- gh_next(x)
#' vapply(x2, "[[", character(1), "login")
gh_next <- function(gh_response, .token = NULL, .send_headers = NULL) {
gh_link(gh_response, "next", .token = .token, .send_headers = .send_headers)
}
#' @name gh_next
#' @export
gh_prev <- function(gh_response, .token = NULL, .send_headers = NULL) {
gh_link(gh_response, "prev", .token = .token, .send_headers = .send_headers)
}
#' @name gh_next
#' @export
gh_first <- function(gh_response, .token = NULL, .send_headers = NULL) {
gh_link(gh_response, "first", .token = .token, .send_headers = .send_headers)
}
#' @name gh_next
#' @export
gh_last <- function(gh_response, .token = NULL, .send_headers = NULL) {
gh_link(gh_response, "last", .token = .token, .send_headers = .send_headers)
}
gh/R/gh_response.R 0000644 0001762 0000144 00000002511 15015013734 013506 0 ustar ligges users gh_process_response <- function(resp, gh_req) {
stopifnot(inherits(resp, "httr2_response"))
content_type <- httr2::resp_content_type(resp)
gh_media_type <- httr2::resp_header(resp, "x-github-media-type")
is_raw <- identical(content_type, "application/octet-stream") ||
isTRUE(grepl("param=raw$", gh_media_type, ignore.case = TRUE))
is_ondisk <- inherits(resp$body, "httr2_path") && !is.null(gh_req$dest)
is_empty <- length(resp$body) == 0
if (is_ondisk) {
res <- as.character(resp$body)
file.rename(res, gh_req$dest)
res <- gh_req$dest
} else if (is_empty) {
res <- list()
} else if (grepl("^application/json", content_type, ignore.case = TRUE)) {
res <- httr2::resp_body_json(resp)
} else if (is_raw) {
res <- httr2::resp_body_raw(resp)
} else {
if (grepl("^text/html", content_type, ignore.case = TRUE)) {
warning("Response came back as html :(", call. = FALSE)
}
res <- list(message = httr2::resp_body_string(resp))
}
attr(res, "response") <- httr2::resp_headers(resp)
attr(res, "request") <- remove_headers(gh_req)
if (is_ondisk) {
class(res) <- c("gh_response", "path")
} else if (is_raw) {
class(res) <- c("gh_response", "raw")
} else {
class(res) <- c("gh_response", "list")
}
res
}
remove_headers <- function(x) {
x[names(x) != "headers"]
}
gh/R/gh_whoami.R 0000644 0001762 0000144 00000004343 15015003317 013135 0 ustar ligges users #' Info on current GitHub user and token
#'
#' Reports wallet name, GitHub login, and GitHub URL for the current
#' authenticated user, the first bit of the token, and the associated scopes.
#'
#' Get a personal access token for the GitHub API from
#' and select the scopes necessary for your
#' planned tasks. The `repo` scope, for example, is one many are likely to need.
#'
#' On macOS and Windows it is best to store the token in the git credential
#' store, where most GitHub clients, including gh, can access it. You can
#' use the gitcreds package to add your token to the credential store:
#'
#' ```r
#' gitcreds::gitcreds_set()
#' ```
#'
#' See
#' and
#' for more about managing GitHub (and generic git) credentials.
#'
#' On other systems, including Linux, the git credential store is
#' typically not as convenient, and you might want to store your token in
#' the `GITHUB_PAT` environment variable, which you can set in your
#' `.Renviron` file.
#'
#' @inheritParams gh
#'
#' @return A `gh_response` object, which is also a `list`.
#' @export
#'
#' @examplesIf identical(Sys.getenv("IN_PKGDOWN"), "true")
#' gh_whoami()
#' @examplesIf FALSE
#' ## explicit token + use with GitHub Enterprise
#' gh_whoami(
#' .token = "8c70fd8419398999c9ac5bacf3192882193cadf2",
#' .api_url = "https://github.foobar.edu/api/v3"
#' )
gh_whoami <- function(.token = NULL, .api_url = NULL, .send_headers = NULL) {
.token <- .token %||% gh_token(.api_url)
if (isTRUE(.token == "")) {
message(
"No personal access token (PAT) available.\n",
"Obtain a PAT from here:\n",
"https://github.com/settings/tokens\n",
"For more on what to do with the PAT, see ?gh_whoami."
)
return(invisible(NULL))
}
res <- gh(
endpoint = "/user",
.token = .token,
.api_url = .api_url,
.send_headers = .send_headers
)
scopes <- attr(res, "response")[["x-oauth-scopes"]]
res <- res[c("name", "login", "html_url")]
res$scopes <- scopes
res$token <- format(gh_pat(.token))
## 'gh_response' class has to be restored
class(res) <- c("gh_response", "list")
res
}
gh/R/utils.R 0000644 0001762 0000144 00000005001 15015003317 012323 0 ustar ligges users trim_ws <- function(x) {
sub("\\s*$", "", sub("^\\s*", "", x))
}
## from devtools, among other places
compact <- function(x) {
is_empty <- vapply(x, function(x) length(x) == 0, logical(1))
x[!is_empty]
}
## from purrr, among other places
`%||%` <- function(x, y) {
if (is.null(x)) {
y
} else {
x
}
}
## as seen in purrr, with the name `has_names()`
has_name <- function(x) {
nms <- names(x)
if (is.null(nms)) {
rep_len(FALSE, length(x))
} else {
!(is.na(nms) | nms == "")
}
}
has_no_names <- function(x) all(!has_name(x))
## if all names are "", strip completely
cleanse_names <- function(x) {
if (has_no_names(x)) {
names(x) <- NULL
}
x
}
## to process HTTP headers, i.e. combine defaults w/ user-specified headers
## in the spirit of modifyList(), except
## x and y are vectors (not lists)
## name comparison is case insensitive
## http://www.w3.org/Protocols/rfc2616/rfc2616-sec4.html#sec4.2
## x will be default headers, y will be user-specified
modify_vector <- function(x, y = NULL) {
if (length(y) == 0L) {
return(x)
}
lnames <- function(x) tolower(names(x))
c(x[!(lnames(x) %in% lnames(y))], y)
}
discard <- function(.x, .p, ...) {
sel <- probe(.x, .p, ...)
.x[is.na(sel) | !sel]
}
probe <- function(.x, .p, ...) {
if (is.logical(.p)) {
stopifnot(length(.p) == length(.x))
.p
} else {
vapply(.x, .p, logical(1), ...)
}
}
drop_named_nulls <- function(x) {
if (has_no_names(x)) {
return(x)
}
named <- has_name(x)
null <- vapply(x, is.null, logical(1))
cleanse_names(x[!named | !null])
}
.parse_params <- function(..., .params = list()) {
params <- c(list2(...), .params)
drop_named_nulls(params)
}
check_named_nas <- function(x) {
if (has_no_names(x)) {
return(x)
}
named <- has_name(x)
na <- vapply(x, FUN.VALUE = logical(1), function(v) {
is.atomic(v) && anyNA(v)
})
bad <- which(named & na)
if (length(bad)) {
str <- paste0("`", names(x)[bad], "`", collapse = ", ")
stop("Named NA parameters are not allowed: ", str)
}
}
can_load <- function(pkg) {
isTRUE(requireNamespace(pkg, quietly = TRUE))
}
is_interactive <- function() {
opt <- getOption("rlib_interactive")
if (isTRUE(opt)) {
TRUE
} else if (identical(opt, FALSE)) {
FALSE
} else if (tolower(getOption("knitr.in.progress", "false")) == "true") {
FALSE
} else if (identical(Sys.getenv("TESTTHAT"), "true")) {
FALSE
} else {
interactive()
}
}
is_testing <- function() {
identical(Sys.getenv("TESTTHAT"), "true")
}
gh/R/gh_rate_limit.R 0000644 0001762 0000144 00000004210 15015003317 013773 0 ustar ligges users #' Return GitHub user's current rate limits
#'
#' @description
#' `gh_rate_limits()` reports on all rate limits for the authenticated user.
#' `gh_rate_limit()` reports on rate limits for previous successful request.
#'
#' Further details on GitHub's API rate limit policies are available at
#' .
#'
#' @param response `gh_response` object from a previous `gh` call, rate
#' limit values are determined from values in the response header.
#' Optional argument, if missing a call to "GET /rate_limit" will be made.
#'
#' @inheritParams gh
#'
#' @return A `list` object containing the overall `limit`, `remaining` limit, and the
#' limit `reset` time.
#'
#' @export
gh_rate_limit <- function(
response = NULL,
.token = NULL,
.api_url = NULL,
.send_headers = NULL
) {
if (is.null(response)) {
# This end point does not count against limit
.token <- .token %||% gh_token(.api_url)
response <- gh(
"GET /rate_limit",
.token = .token,
.api_url = .api_url,
.send_headers = .send_headers
)
}
stopifnot(inherits(response, "gh_response"))
http_res <- attr(response, "response")
reset <- as.integer(c(http_res[["x-ratelimit-reset"]], NA)[1])
reset <- as.POSIXct(reset, origin = "1970-01-01")
list(
limit = as.integer(c(http_res[["x-ratelimit-limit"]], NA)[1]),
remaining = as.integer(c(http_res[["x-ratelimit-remaining"]], NA)[1]),
reset = reset
)
}
#' @export
#' @rdname gh_rate_limit
gh_rate_limits <- function(
.token = NULL,
.api_url = NULL,
.send_headers = NULL
) {
.token <- .token %||% gh_token(.api_url)
response <- gh(
"GET /rate_limit",
.token = .token,
.api_url = .api_url,
.send_headers = .send_headers
)
resources <- response$resources
reset <- .POSIXct(sapply(resources, "[[", "reset"))
data.frame(
type = names(resources),
limit = sapply(resources, "[[", "limit"),
used = sapply(resources, "[[", "used"),
remaining = sapply(resources, "[[", "remaining"),
reset = reset,
mins_left = round((unclass(reset) - unclass(Sys.time())) / 60, 1),
stringsAsFactors = FALSE,
row.names = NULL
)
}
gh/R/import-standalone-purrr.R 0000644 0001762 0000144 00000013020 14521173232 016000 0 ustar ligges users # Standalone file: do not edit by hand
# Source:
# ----------------------------------------------------------------------
#
# ---
# repo: r-lib/rlang
# file: standalone-purrr.R
# last-updated: 2023-02-23
# license: https://unlicense.org
# imports: rlang
# ---
#
# This file provides a minimal shim to provide a purrr-like API on top of
# base R functions. They are not drop-in replacements but allow a similar style
# of programming.
#
# ## Changelog
#
# 2023-02-23:
# * Added `list_c()`
#
# 2022-06-07:
# * `transpose()` is now more consistent with purrr when inner names
# are not congruent (#1346).
#
# 2021-12-15:
# * `transpose()` now supports empty lists.
#
# 2021-05-21:
# * Fixed "object `x` not found" error in `imap()` (@mgirlich)
#
# 2020-04-14:
# * Removed `pluck*()` functions
# * Removed `*_cpl()` functions
# * Used `as_function()` to allow use of `~`
# * Used `.` prefix for helpers
#
# nocov start
map <- function(.x, .f, ...) {
.f <- as_function(.f, env = global_env())
lapply(.x, .f, ...)
}
walk <- function(.x, .f, ...) {
map(.x, .f, ...)
invisible(.x)
}
map_lgl <- function(.x, .f, ...) {
.rlang_purrr_map_mold(.x, .f, logical(1), ...)
}
map_int <- function(.x, .f, ...) {
.rlang_purrr_map_mold(.x, .f, integer(1), ...)
}
map_dbl <- function(.x, .f, ...) {
.rlang_purrr_map_mold(.x, .f, double(1), ...)
}
map_chr <- function(.x, .f, ...) {
.rlang_purrr_map_mold(.x, .f, character(1), ...)
}
.rlang_purrr_map_mold <- function(.x, .f, .mold, ...) {
.f <- as_function(.f, env = global_env())
out <- vapply(.x, .f, .mold, ..., USE.NAMES = FALSE)
names(out) <- names(.x)
out
}
map2 <- function(.x, .y, .f, ...) {
.f <- as_function(.f, env = global_env())
out <- mapply(.f, .x, .y, MoreArgs = list(...), SIMPLIFY = FALSE)
if (length(out) == length(.x)) {
set_names(out, names(.x))
} else {
set_names(out, NULL)
}
}
map2_lgl <- function(.x, .y, .f, ...) {
as.vector(map2(.x, .y, .f, ...), "logical")
}
map2_int <- function(.x, .y, .f, ...) {
as.vector(map2(.x, .y, .f, ...), "integer")
}
map2_dbl <- function(.x, .y, .f, ...) {
as.vector(map2(.x, .y, .f, ...), "double")
}
map2_chr <- function(.x, .y, .f, ...) {
as.vector(map2(.x, .y, .f, ...), "character")
}
imap <- function(.x, .f, ...) {
map2(.x, names(.x) %||% seq_along(.x), .f, ...)
}
pmap <- function(.l, .f, ...) {
.f <- as.function(.f)
args <- .rlang_purrr_args_recycle(.l)
do.call("mapply", c(
FUN = list(quote(.f)),
args, MoreArgs = quote(list(...)),
SIMPLIFY = FALSE, USE.NAMES = FALSE
))
}
.rlang_purrr_args_recycle <- function(args) {
lengths <- map_int(args, length)
n <- max(lengths)
stopifnot(all(lengths == 1L | lengths == n))
to_recycle <- lengths == 1L
args[to_recycle] <- map(args[to_recycle], function(x) rep.int(x, n))
args
}
keep <- function(.x, .f, ...) {
.x[.rlang_purrr_probe(.x, .f, ...)]
}
discard <- function(.x, .p, ...) {
sel <- .rlang_purrr_probe(.x, .p, ...)
.x[is.na(sel) | !sel]
}
map_if <- function(.x, .p, .f, ...) {
matches <- .rlang_purrr_probe(.x, .p)
.x[matches] <- map(.x[matches], .f, ...)
.x
}
.rlang_purrr_probe <- function(.x, .p, ...) {
if (is_logical(.p)) {
stopifnot(length(.p) == length(.x))
.p
} else {
.p <- as_function(.p, env = global_env())
map_lgl(.x, .p, ...)
}
}
compact <- function(.x) {
Filter(length, .x)
}
transpose <- function(.l) {
if (!length(.l)) {
return(.l)
}
inner_names <- names(.l[[1]])
if (is.null(inner_names)) {
fields <- seq_along(.l[[1]])
} else {
fields <- set_names(inner_names)
.l <- map(.l, function(x) {
if (is.null(names(x))) {
set_names(x, inner_names)
} else {
x
}
})
}
# This way missing fields are subsetted as `NULL` instead of causing
# an error
.l <- map(.l, as.list)
map(fields, function(i) {
map(.l, .subset2, i)
})
}
every <- function(.x, .p, ...) {
.p <- as_function(.p, env = global_env())
for (i in seq_along(.x)) {
if (!rlang::is_true(.p(.x[[i]], ...))) return(FALSE)
}
TRUE
}
some <- function(.x, .p, ...) {
.p <- as_function(.p, env = global_env())
for (i in seq_along(.x)) {
if (rlang::is_true(.p(.x[[i]], ...))) return(TRUE)
}
FALSE
}
negate <- function(.p) {
.p <- as_function(.p, env = global_env())
function(...) !.p(...)
}
reduce <- function(.x, .f, ..., .init) {
f <- function(x, y) .f(x, y, ...)
Reduce(f, .x, init = .init)
}
reduce_right <- function(.x, .f, ..., .init) {
f <- function(x, y) .f(y, x, ...)
Reduce(f, .x, init = .init, right = TRUE)
}
accumulate <- function(.x, .f, ..., .init) {
f <- function(x, y) .f(x, y, ...)
Reduce(f, .x, init = .init, accumulate = TRUE)
}
accumulate_right <- function(.x, .f, ..., .init) {
f <- function(x, y) .f(y, x, ...)
Reduce(f, .x, init = .init, right = TRUE, accumulate = TRUE)
}
detect <- function(.x, .f, ..., .right = FALSE, .p = is_true) {
.p <- as_function(.p, env = global_env())
.f <- as_function(.f, env = global_env())
for (i in .rlang_purrr_index(.x, .right)) {
if (.p(.f(.x[[i]], ...))) {
return(.x[[i]])
}
}
NULL
}
detect_index <- function(.x, .f, ..., .right = FALSE, .p = is_true) {
.p <- as_function(.p, env = global_env())
.f <- as_function(.f, env = global_env())
for (i in .rlang_purrr_index(.x, .right)) {
if (.p(.f(.x[[i]], ...))) {
return(i)
}
}
0L
}
.rlang_purrr_index <- function(x, right = FALSE) {
idx <- seq_along(x)
if (right) {
idx <- rev(idx)
}
idx
}
list_c <- function(x) {
inject(c(!!!x))
}
# nocov end
gh/R/gh_token.R 0000644 0001762 0000144 00000011303 15015003317 012763 0 ustar ligges users #' Return the local user's GitHub Personal Access Token (PAT)
#'
#' @description
#' If gh can find a personal access token (PAT) via `gh_token()`, it includes
#' the PAT in its requests. Some requests succeed without a PAT, but many
#' require a PAT to prove the request is authorized by a specific GitHub user. A
#' PAT also helps with rate limiting. If your gh use is more than casual, you
#' want a PAT.
#'
#' gh calls [gitcreds::gitcreds_get()] with the `api_url`, which checks session
#' environment variables (`GITHUB_PAT`, `GITHUB_TOKEN`)
#' and then the local Git credential store for a PAT
#' appropriate to the `api_url`. Therefore, if you have previously used a PAT
#' with, e.g., command line Git, gh may retrieve and re-use it. You can call
#' [gitcreds::gitcreds_get()] directly, yourself, if you want to see what is
#' found for a specific URL. If no matching PAT is found,
#' [gitcreds::gitcreds_get()] errors, whereas `gh_token()` does not and,
#' instead, returns `""`.
#'
#' See GitHub's documentation on [Creating a personal access
#' token](https://docs.github.com/en/github/authenticating-to-github/creating-a-personal-access-token),
#' or use `usethis::create_github_token()` for a guided experience, including
#' pre-selection of recommended scopes. Once you have a PAT, you can use
#' [gitcreds::gitcreds_set()] to add it to the Git credential store. From that
#' point on, gh (via [gitcreds::gitcreds_get()]) should be able to find it
#' without further effort on your part.
#'
#' @param api_url GitHub API URL. Defaults to the `GITHUB_API_URL` environment
#' variable, if set, and otherwise to .
#'
#' @return A string of characters, if a PAT is found, or the empty
#' string, otherwise. For convenience, the return value has an S3 class in
#' order to ensure that simple printing strategies don't reveal the entire
#' PAT.
#'
#' @export
#'
#' @examples
#' \dontrun{
#' gh_token()
#'
#' format(gh_token())
#'
#' str(gh_token())
#' }
gh_token <- function(api_url = NULL) {
api_url <- api_url %||% default_api_url()
stopifnot(is.character(api_url), length(api_url) == 1)
host_url <- get_hosturl(api_url)
# Check for credentials supplied by Posit Connect.
if (is_installed("connectcreds")) {
if (connectcreds::has_viewer_token(host_url)) {
token <- connectcreds::connect_viewer_token(host_url)
return(gh_pat(token$access_token))
}
}
token <- tryCatch(
gitcreds::gitcreds_get(host_url),
error = function(e) NULL
)
gh_pat(token$password %||% "")
}
#' @export
#' @rdname gh_token
gh_token_exists <- function(api_url = NULL) {
tryCatch(nzchar(gh_token(api_url)), error = function(e) FALSE)
}
gh_auth <- function(token) {
if (isTRUE(token != "")) {
if (any(grepl("\\W", token))) {
warning("Token contains whitespace characters")
}
c("Authorization" = paste("token", trim_ws(token)))
} else {
character()
}
}
# gh_pat class: exists in order have a print method that hides info ----
new_gh_pat <- function(x) {
if (is.character(x) && length(x) == 1) {
structure(x, class = "gh_pat")
} else {
cli::cli_abort("A GitHub PAT must be a string")
}
}
# validates PAT only in a very narrow, technical, and local sense
validate_gh_pat <- function(x) {
stopifnot(inherits(x, "gh_pat"))
if (
x == "" ||
# https://github.blog/changelog/2021-03-04-authentication-token-format-updates/
# Fine grained tokens start with "github_pat_".
# https://github.blog/changelog/2022-10-18-introducing-fine-grained-personal-access-tokens/
grepl(
"^(gh[pousr]_[A-Za-z0-9_]{36,251}|github_pat_[A-Za-z0-9_]{36,244})$",
x
) ||
grepl("^[[:xdigit:]]{40}$", x)
) {
x
} else {
url <- "https://gh.r-lib.org/articles/managing-personal-access-tokens.html"
cli::cli_abort(c(
"Invalid GitHub PAT format",
"i" = "A GitHub PAT must have one of three forms:",
"*" = "40 hexadecimal digits (older PATs)",
"*" = "A 'ghp_' prefix followed by 36 to 251 more characters (newer PATs)",
"*" = "A 'github_pat_' prefix followed by 36 to 244 more characters (fine-grained PATs)",
"i" = "Read more at {.url {url}}."
))
}
}
gh_pat <- function(x) {
validate_gh_pat(new_gh_pat(x))
}
#' @export
format.gh_pat <- function(x, ...) {
if (x == "") {
""
} else {
obfuscate(x)
}
}
#' @export
print.gh_pat <- function(x, ...) {
cat(format(x), sep = "\n")
invisible(x)
}
#' @export
str.gh_pat <- function(object, ...) {
cat(paste0(" ", format(object), "\n", collapse = ""))
invisible()
}
obfuscate <- function(x, first = 4, last = 4) {
paste0(
substr(x, start = 1, stop = first),
"...",
substr(x, start = nchar(x) - last + 1, stop = nchar(x))
)
}
gh/R/gh-package.R 0000644 0001762 0000144 00000000665 14521173232 013172 0 ustar ligges users #' @keywords internal
#' @aliases gh-package
"_PACKAGE"
# The following block is used by usethis to automatically manage
# roxygen namespace tags. Modify with care!
## usethis namespace: start
#' @import rlang
#' @importFrom cli cli_status cli_status_update
#' @importFrom glue glue
#' @importFrom jsonlite fromJSON toJSON
#' @importFrom lifecycle deprecated
#' @importFrom utils URLencode capture.output
## usethis namespace: end
NULL
gh/vignettes/ 0000755 0001762 0000144 00000000000 15015032422 012652 5 ustar ligges users gh/vignettes/managing-personal-access-tokens.Rmd 0000644 0001762 0000144 00000016154 15015003317 021470 0 ustar ligges users ---
title: "Managing Personal Access Tokens"
output: rmarkdown::html_vignette
vignette: >
%\VignetteIndexEntry{Managing Personal Access Tokens}
%\VignetteEngine{knitr::rmarkdown}
%\VignetteEncoding{UTF-8}
---
```{r}
#| include: false
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
```
```{r}
#| label: setup
library(gh)
```
gh generally sends a Personal Access Token (PAT) with its requests.
Some endpoints of the GitHub API can be accessed without authenticating yourself.
But once your API use becomes more frequent, you will want a PAT to prevent problems with rate limits and to access all possible endpoints.
This article describes how to store your PAT, so that gh can find it (automatically, in most cases). The function gh uses for this is `gh_token()`.
More resources on PAT management:
* GitHub documentation on [Creating a personal access token](https://docs.github.com/en/github/authenticating-to-github/creating-a-personal-access-token)
- Important: a PAT can expire, the default expiration date is 30 days.
* In the [usethis package](https://usethis.r-lib.org):
- Vignette: [Managing Git(Hub) Credentials](https://usethis.r-lib.org/articles/articles/git-credentials.html)
- `usethis::gh_token_help()` and `usethis::git_sitrep()` help you check if
a PAT is discoverable and has suitable scopes
- `usethis::create_github_token()` guides you through the process of getting
a new PAT
* In the [gitcreds package](https://gitcreds.r-lib.org/):
- `gitcreds::gitcreds_set()` helps you explicitly put your PAT into the Git
credential store
## PAT and host
`gh::gh()` allows the user to provide a PAT via the `.token` argument and to specify a host other than "github.com" via the `.api_url` argument.
(Some companies and universities run their own instance of GitHub Enterprise.)
```{r}
#| eval: false
gh(endpoint, ..., .token = NULL, ..., .api_url = NULL, ...)
```
However, it's annoying to always provide your PAT or host and it's unsafe for your PAT to appear explicitly in your R code.
It's important to make it *possible* for the user to provide the PAT and/or API URL directly, but it should rarely be necessary.
`gh::gh()` is designed to play well with more secure, less fiddly methods for expressing what you want.
How are `.api_url` and `.token` determined when the user does not provide them?
1. `.api_url` defaults to the value of the `GITHUB_API_URL` environment
variable and, if that is unset, falls back to `"https://api.github.com"`.
This is always done before worrying about the PAT.
1. The PAT is obtained via a call to `gh_token(.api_url)`. That is, the token
is looked up based on the host.
## The gitcreds package
gh now uses the gitcreds package to interact with the Git credential store.
gh calls `gitcreds::gitcreds_get()` with a URL to try to find a matching PAT.
`gitcreds::gitcreds_get()` checks session environment variables and then the local Git credential store.
Therefore, if you have previously used a PAT with, e.g., command line Git, gh may retrieve and re-use it.
You can call `gitcreds::gitcreds_get()` directly, yourself, if you want to see what is found for a specific URL.
``` r
gitcreds::gitcreds_get()
```
If you see something like this:
``` r
#>
#> protocol: https
#> host : github.com
#> username: PersonalAccessToken
#> password: <-- hidden -->
```
that means that gitcreds could get the PAT from the Git credential store.
You can call `gitcreds_get()$password` to see the actual PAT.
If no matching PAT is found, `gitcreds::gitcreds_get()` errors.
## PAT in an environment variable
If you don't have a Git installation, or your Git installation does not have a working credential store, then you can specify the PAT in an environment variable.
For `github.com` you can set the `GITHUB_PAT_GITHUB_COM` or `GITHUB_PAT` variable.
For a different GitHub host, call `gitcreds::gitcreds_cache_envvar()` with the API URL to see the environment variable you need to set.
For example:
```{r}
gitcreds::gitcreds_cache_envvar("https://github.acme.com")
```
## Recommendations
On a machine used for interactive development, we recommend:
* Store your PAT(s) in an official credential store.
* Do **not** store your PAT(s) in plain text in, e.g., `.Renviron`. In the
past, this has been a common and recommended practice for pragmatic reasons.
However, gitcreds/gh have now evolved to the point where it's
possible for all of us to follow better security practices.
* If you use a general-purpose password manager, like 1Password or LastPass,
you may *also* want to store your PAT(s) there. Why? If your PAT is
"forgotten" from the OS-level credential store, intentionally or not, you'll
need to provide it again when prompted.
If you don't have any other record of your PAT, you'll have to get a new
PAT whenever this happens. This is not the end of the world. But if you
aren't disciplined about deleting lost PATs from
, you will eventually find yourself in a
confusing situation where you can't be sure which PAT(s) are in use.
On a headless system, such as on a CI/CD platform, provide the necessary PAT(s) via secure environment variables.
Regular environment variables can be used to configure less sensitive settings, such as the API host.
Don't expose your PAT by doing something silly like dumping all environment variables to a log file.
Note that on GitHub Actions, specifically, a personal access token is [automatically available to the workflow](https://docs.github.com/en/actions/configuring-and-managing-workflows/authenticating-with-the-github_token) as the `GITHUB_TOKEN` secret.
That is why many workflows in the R community contain this snippet:
``` yaml
env:
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
```
This makes the automatic PAT available as the `GITHUB_PAT` environment variable.
If that PAT doesn't have the right permissions, then you'll need to explicitly provide one that does (see link above for more).
## Failure
If there is no PAT to be had, `gh::gh()` sends a request with no token.
(Internally, the `Authorization` header is omitted if the PAT is found to be the empty string, `""`.)
What do PAT-related failures look like?
If no PAT is sent and the endpoint requires no auth, the request probably succeeds!
At least until you run up against rate limits.
If the endpoint requires auth, you'll get an HTTP error, possibly this one:
```
GitHub API error (401): 401 Unauthorized
Message: Requires authentication
```
If a PAT is first discovered in an environment variable, it is taken at face value.
The two most common ways to arrive here are PAT specification via `.Renviron` or as a secret in a CI/CD platform, such as GitHub Actions.
If the PAT is invalid, the first affected request will fail, probably like so:
```
GitHub API error (401): 401 Unauthorized
Message: Bad credentials
```
This will also be the experience if an invalid PAT is provided directly via `.token`.
Even a valid PAT can lead to a downstream error, if it has insufficient scopes with respect to a specific request.
gh/NAMESPACE 0000644 0001762 0000144 00000001177 14750147036 012104 0 ustar ligges users # Generated by roxygen2: do not edit by hand
S3method(format,gh_pat)
S3method(print,gh_pat)
S3method(print,gh_response)
S3method(str,gh_pat)
export(gh)
export(gh_first)
export(gh_gql)
export(gh_last)
export(gh_next)
export(gh_prev)
export(gh_rate_limit)
export(gh_rate_limits)
export(gh_token)
export(gh_token_exists)
export(gh_tree_remote)
export(gh_whoami)
import(rlang)
importFrom(cli,cli_status)
importFrom(cli,cli_status_update)
importFrom(glue,glue)
importFrom(jsonlite,fromJSON)
importFrom(jsonlite,prettify)
importFrom(jsonlite,toJSON)
importFrom(lifecycle,deprecated)
importFrom(utils,URLencode)
importFrom(utils,capture.output)
gh/LICENSE 0000644 0001762 0000144 00000000050 15015003317 011643 0 ustar ligges users YEAR: 2025
COPYRIGHT HOLDER: gh authors
gh/NEWS.md 0000644 0001762 0000144 00000012441 15015032372 011746 0 ustar ligges users # gh 1.5.0
## BREAKING CHANGES
### Posit Security Advisory(PSA) - PSA-1649
* Posit acknowledges that the response header may contain sensitive
information. (#222) Thank you to @foysal1197 for your thorough research
and responsible disclosure.
`gh()`, and other functions that use it, now do not save the request
headers in the returned object. Consequently, if you use the `gh_next()`,
`gh_prev()`, `gh_first()` or `gh_last()` functions and passed `.token`
and/or `.send_headers` explicitly to the original `gh()` (or similar)
call, then you'll also need to pass the same `.token` and/or
`.send_headers` to `gh_next()`, `gh_prev()`, `gh_first()` or `gh_last()`.
## OTHER CHANGES
* New `gh_token_exists()` tells you if a valid GH token has been set.
* `gh()` now uses a cache provided by httr2. This cache lives in
`tools::R_user_dir("gh", "cache")`, maxes out at 100 MB, and can be
disabled by setting `options(gh_cache = FALSE)` (#203).
* `gh_token()` can now pick up on the viewer's GitHub credentials (if any)
when running on Posit Connect (@atheriel, #217).
# gh 1.4.1
* `gh_next()`, `gh_prev()`, `gh_first()` and `gh_last()`
now work correctly again (#181).
* When the user sets `.destfile` to write the response to disk, gh now
writes the output to a temporary file, which is then renamed to
`.destfile` after performing the request, or deleted on error (#178).
# gh 1.4.0
* `gh()` gains a new `.max_rate` parameter that sets the maximum number of
requests per second.
* gh is now powered by httr2. This should generally have little impact on normal
operation but if a request fails, you can use `httr2::last_response()` and
`httr2::last_request()` to debug.
* `gh()` gains a new `.max_wait` argument which gives the maximum number of
minutes to wait if you are rate limited (#67).
* New `gh_rate_limits()` function reports on all rate limits for the active
user.
* gh can now validate GitHub
[fine-grained](https://github.blog/security/application-security/introducing-fine-grained-personal-access-tokens-for-github/)
personal access tokens (@jvstein, #171).
# gh 1.3.1
* gh now accepts lower-case methods i.e. both `gh::gh("get /users/hadley/repos")` and `gh::gh("GET /users/hadley/repos")` work (@maelle, #167).
* Response headers (`"response_headers"`) and response content
(`"response_content")` are now returned in error conditions so that error
handlers can use information, such as the rate limit reset header, when
handling `github_error`s (@gadenbuie, #117).
# gh 1.3.0
* gh now shows the correct number of records in its progress bar when
paginating (#147).
* New `.params` argument in `gh()` to make it easier to pass parameters to
it programmatically (#140).
# gh 1.2.1
* Token validation accounts for the new format
[announced 2021-03-04 ](https://github.blog/changelog/2021-03-04-authentication-token-format-updates/)
and implemented on 2021-04-01 (#148, @fmichonneau).
# gh 1.2.0
* `gh_gql()` now passes all arguments to `gh()` (#124).
* gh now handles responses from pagination better, and tries to properly
merge them (#136, @rundel).
* gh can retrieve a PAT from the Git credential store, where the lookup is
based on the targeted API URL. This now uses the gitcreds package. The
environment variables consulted for URL-specific GitHub PATs have changed.
- For "https://api.github.com": `GITHUB_PAT_GITHUB_COM` now, instead of
`GITHUB_PAT_API_GITHUB_COM`
- For "https://github.acme.com/api/v3": `GITHUB_PAT_GITHUB_ACME_COM` now,
instead of `GITHUB_PAT_GITHUB_ACME_COM_API_V3`
See the documentation of the gitcreds package for details.
* The keyring package is no longer used, in favor of the Git credential
store.
* The documentation for the GitHub REST API has moved to
and endpoints are now documented using
the URI template style of [RFC 6570](https://www.rfc-editor.org/rfc/rfc6570):
- Old: `GET /repos/:owner/:repo/issues`
- New: `GET /repos/{owner}/{repo}/issues`
gh accepts and prioritizes the new style. However, it still does parameter
substitution for the old style.
* Fixed an error that occurred when calling `gh()` with `.progress = FALSE`
(@gadenbuie, #115).
* `gh()` accepts named `NA` parameters that are destined for the request
body (#139).
# gh 1.1.0
* Raw responses from GitHub are now returned as raw vector.
* Responses may be written to disk by providing a path in the `.destfile`
argument.
* gh now sets `.Last.error` to the error object after an uncaught error,
and `.Last.error.trace` to the stack trace of the error.
* `gh()` now silently drops named `NULL` parameters, and throws an
error for named `NA` parameters (#21, #84).
* `gh()` now returns better values for empty responses, typically empty
lists or dictionaries (#66).
* `gh()` now has an `.accept` argument to make it easier to set the
`Accept` HTTP header (#91).
* New `gh_gql()` function to make it easier to work with the GitHub
GraphQL API.
* gh now supports separate personal access tokens for GitHub Enterprise
sites. See `?gh_token` for details.
* gh now supports storing your GitHub personal access tokens (PAT) in the
system keyring, via the keyring package. See `?gh_token` for details.
* `gh()` can now POST raw data, which allows adding assets to releases (#56).
# gh 1.0.1
First public release.
gh/inst/ 0000755 0001762 0000144 00000000000 15015032421 011616 5 ustar ligges users gh/inst/doc/ 0000755 0001762 0000144 00000000000 15015032421 012363 5 ustar ligges users gh/inst/doc/managing-personal-access-tokens.html 0000644 0001762 0000144 00000043623 15015032421 021423 0 ustar ligges users
Managing Personal Access Tokens
Managing Personal Access Tokens
library(gh)
gh generally sends a Personal Access Token (PAT) with its requests.
Some endpoints of the GitHub API can be accessed without authenticating
yourself. But once your API use becomes more frequent, you will want a
PAT to prevent problems with rate limits and to access all possible
endpoints.
This article describes how to store your PAT, so that gh can find it
(automatically, in most cases). The function gh uses for this is
gh_token().
gitcreds::gitcreds_set() helps you explicitly put your
PAT into the Git credential store
PAT and host
gh::gh() allows the user to provide a PAT via the
.token argument and to specify a host other than
“github.com” via the .api_url argument. (Some companies and
universities run their own instance of GitHub Enterprise.)
However, it’s annoying to always provide your PAT or host and it’s
unsafe for your PAT to appear explicitly in your R code. It’s important
to make it possible for the user to provide the PAT and/or API
URL directly, but it should rarely be necessary. gh::gh()
is designed to play well with more secure, less fiddly methods for
expressing what you want.
How are .api_url and .token determined when
the user does not provide them?
.api_url defaults to the value of the
GITHUB_API_URL environment variable and, if that is unset,
falls back to "https://api.github.com". This is always done
before worrying about the PAT.
The PAT is obtained via a call to gh_token(.api_url).
That is, the token is looked up based on the host.
The gitcreds package
gh now uses the gitcreds package to interact with the Git credential
store.
gh calls gitcreds::gitcreds_get() with a URL to try to
find a matching PAT. gitcreds::gitcreds_get() checks
session environment variables and then the local Git credential store.
Therefore, if you have previously used a PAT with, e.g., command line
Git, gh may retrieve and re-use it. You can call
gitcreds::gitcreds_get() directly, yourself, if you want to
see what is found for a specific URL.
that means that gitcreds could get the PAT from the Git credential
store. You can call gitcreds_get()$password to see the
actual PAT.
If no matching PAT is found, gitcreds::gitcreds_get()
errors.
PAT in an environment variable
If you don’t have a Git installation, or your Git installation does
not have a working credential store, then you can specify the PAT in an
environment variable. For github.com you can set the
GITHUB_PAT_GITHUB_COM or GITHUB_PAT variable.
For a different GitHub host, call
gitcreds::gitcreds_cache_envvar() with the API URL to see
the environment variable you need to set. For example:
On a machine used for interactive development, we recommend:
Store your PAT(s) in an official credential store.
Do not store your PAT(s) in plain text in, e.g.,
.Renviron. In the past, this has been a common and
recommended practice for pragmatic reasons. However, gitcreds/gh have
now evolved to the point where it’s possible for all of us to follow
better security practices.
If you use a general-purpose password manager, like 1Password or
LastPass, you may also want to store your PAT(s) there. Why? If
your PAT is “forgotten” from the OS-level credential store,
intentionally or not, you’ll need to provide it again when prompted.
If you don’t have any other record of your PAT, you’ll have to get a
new PAT whenever this happens. This is not the end of the world. But if
you aren’t disciplined about deleting lost PATs from https://github.com/settings/tokens, you will eventually
find yourself in a confusing situation where you can’t be sure which
PAT(s) are in use.
On a headless system, such as on a CI/CD platform, provide the
necessary PAT(s) via secure environment variables. Regular environment
variables can be used to configure less sensitive settings, such as the
API host. Don’t expose your PAT by doing something silly like dumping
all environment variables to a log file.
Note that on GitHub Actions, specifically, a personal access token is
automatically
available to the workflow as the GITHUB_TOKEN secret.
That is why many workflows in the R community contain this snippet:
env:GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
This makes the automatic PAT available as the GITHUB_PAT
environment variable. If that PAT doesn’t have the right permissions,
then you’ll need to explicitly provide one that does (see link above for
more).
Failure
If there is no PAT to be had, gh::gh() sends a request
with no token. (Internally, the Authorization header is
omitted if the PAT is found to be the empty string,
"".)
What do PAT-related failures look like?
If no PAT is sent and the endpoint requires no auth, the request
probably succeeds! At least until you run up against rate limits. If the
endpoint requires auth, you’ll get an HTTP error, possibly this one:
GitHub API error (401): 401 Unauthorized
Message: Requires authentication
If a PAT is first discovered in an environment variable, it is taken
at face value. The two most common ways to arrive here are PAT
specification via .Renviron or as a secret in a CI/CD
platform, such as GitHub Actions. If the PAT is invalid, the first
affected request will fail, probably like so:
GitHub API error (401): 401 Unauthorized
Message: Bad credentials
This will also be the experience if an invalid PAT is provided
directly via .token.
Even a valid PAT can lead to a downstream error, if it has
insufficient scopes with respect to a specific request.