gh/ 0000755 0001762 0000144 00000000000 13612511651 010651 5 ustar ligges users gh/NAMESPACE 0000644 0001762 0000144 00000001424 13612445243 012074 0 ustar ligges users # Generated by roxygen2: do not edit by hand
S3method(print,gh_response)
export(gh)
export(gh_first)
export(gh_gql)
export(gh_last)
export(gh_next)
export(gh_prev)
export(gh_token)
export(gh_tree_remote)
export(gh_whoami)
export(slugify_url)
importFrom(cli,cli_alert_info)
importFrom(cli,cli_status)
importFrom(cli,cli_status_update)
importFrom(httr,DELETE)
importFrom(httr,GET)
importFrom(httr,PATCH)
importFrom(httr,POST)
importFrom(httr,PUT)
importFrom(httr,add_headers)
importFrom(httr,content)
importFrom(httr,headers)
importFrom(httr,http_type)
importFrom(httr,status_code)
importFrom(httr,write_disk)
importFrom(httr,write_memory)
importFrom(jsonlite,fromJSON)
importFrom(jsonlite,prettify)
importFrom(jsonlite,toJSON)
importFrom(utils,URLencode)
importFrom(utils,capture.output)
gh/LICENSE 0000644 0001762 0000144 00000000121 13243233512 011645 0 ustar ligges users YEAR: 2015-2016
COPYRIGHT HOLDER: Gábor Csárdi, Jennifer Bryan, Hadley Wickham
gh/README.md 0000644 0001762 0000144 00000011105 13612274250 012127 0 ustar ligges users
# gh
> GitHub API
[](https://travis-ci.org/r-lib/gh)
[](https://ci.appveyor.com/project/gaborcsardi/gh)
[](http://www.r-pkg.org/pkg/gh)
[](http://www.r-pkg.org/pkg/gh)
[](https://codecov.io/github/r-lib/gh?branch=master)
Minimalistic client to access
[GitHub's API v3](https://developer.github.com/v3/).
## Installation
Install the package from CRAN as usual:
```r
install.packages("gh")
```
## Usage
```r
library(gh)
```
Use the `gh()` function to access all API endpoints. The endpoints are
listed in the [documentation](https://developer.github.com/v3/).
The first argument of `gh()` is the endpoint. Note that the leading slash
must be included as well. Parameters can be passed as extra arguments. E.g.
```r
my_repos <- gh("/user/repos", type = "public")
vapply(my_repos, "[[", "", "name")
```
```
#> [1] "after" "argufy" "ask"
#> [4] "baseimports" "citest" "clisymbols"
#> [7] "cmaker" "cmark" "conditions"
#> [10] "crayon" "debugme" "devtools"
#> [13] "diffobj" "disposables" "dotenv"
#> [16] "elasticsearch-jetty" "falsy" "fswatch"
#> [19] "gitty" "httr" "httrmock"
#> [22] "ISA" "keypress" "lintr"
#> [25] "macBriain" "maxygen" "MISO"
#> [28] "parr" "parsedate" "pingr"
```
The JSON result sent by the API is converted to an R object.
If the end point itself has parameters, these can also be passed
as extra arguments:
```r
j_repos <- gh("/users/:username/repos", username = "jeroen")
vapply(j_repos, "[[", "", "name")
```
```
#> [1] "apps" "asantest" "awk"
#> [4] "base64" "bcrypt" "blog"
#> [7] "brotli" "cheerio" "cmark"
#> [10] "commonmark" "covr" "cranlogs"
#> [13] "curl" "cyphr" "daff"
#> [16] "data" "data.table.extras" "devtools"
#> [19] "DiagrammeR" "docdbi" "docplyr"
#> [22] "docs-travis-ci-com" "dplyr" "encode"
#> [25] "evaluate" "feather" "fib"
#> [28] "figures" "gdtools" "geojson"
```
### POST, PATCH, PUT and DELETE requests
POST, PATCH, PUT, and DELETE requests can be sent by including the
HTTP verb before the endpoint, in the first argument. E.g. to
create a repository:
```r
new_repo <- gh("POST /user/repos", name = "my-new-repo-for-gh-testing")
```
and then delete it:
```r
gh("DELETE /repos/:owner/:repo", owner = "gaborcsardi",
repo = "my-new-repo-for-gh-testing")
```
### Tokens
By default the `GITHUB_PAT` environment variable is used. Alternatively,
one can set the `.token` argument of `gh()`.
### Pagination
Supply the `page` parameter to get subsequent pages:
```r
my_repos2 <- gh("GET /users/:username/repos", username = "gaborcsardi",
type = "public", page = 2)
vapply(my_repos2, "[[", "", "name")
```
```
#> [1] "pkgconfig" "playground"
#> [3] "praise" "prettycode"
#> [5] "prettyunits" "progress"
#> [7] "prompt" "r-font"
#> [9] "R6" "rcorpora"
#> [11] "readline" "remoji"
#> [13] "resume" "rhub-presentations"
#> [15] "rintrojs" "roxygen"
#> [17] "scidb" "spark"
#> [19] "sparklyr" "splicing"
#> [21] "tamper" "testthat"
#> [23] "trump" "user2016-tutorial-shiny"
#> [25] "webdriver" "whoami"
```
## Environment Variables
+ The `GITHUB_API_URL` environment variable is used for the default github api url.
+ One of `GITHUB_PAT` or `GITHUB_TOKEN` environment variables is used, in this
order, as default token.
## License
MIT © Gábor Csárdi, Jennifer Bryan, Hadley Wickham
gh/man/ 0000755 0001762 0000144 00000000000 13612445240 011424 5 ustar ligges users gh/man/gh_gql.Rd 0000644 0001762 0000144 00000004526 13612423656 013172 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/gh_gql.R
\name{gh_gql}
\alias{gh_gql}
\title{A simple interface for the GitHub GraphQL API v4.}
\usage{
gh_gql(
query,
...,
.token = NULL,
.destfile = NULL,
.overwrite = FALSE,
.api_url = NULL,
.send_headers = NULL
)
}
\arguments{
\item{query}{The GraphQL query, as a string.}
\item{...}{Name-value pairs giving API parameters. Will be matched
into \code{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 \code{NULL} values are silently dropped,
and named \code{NA} values trigger an error.}
\item{.token}{Authentication token. Defaults to \code{GITHUB_PAT} or
\code{GITHUB_TOKEN} environment variables, in this order if any is set.
See \code{\link[=gh_token]{gh_token()}} if you need more flexibility, e.g. different tokens
for different GitHub Enterprise deployments.}
\item{.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.}
\item{.overwrite}{if \code{.destfile} is provided, whether to overwrite an
existing file. Defaults to FALSE.}
\item{.api_url}{Github API url (default: \url{https://api.github.com}). Used
if \code{endpoint} just contains a path. Defaults to \code{GITHUB_API_URL}
environment variable if set.}
\item{.send_headers}{Named character vector of header field values
(except \code{Authorization}, which is handled via \code{.token}). This can be
used to override or augment the default \code{User-Agent} header:
\code{"https://github.com/r-lib/gh"}.}
}
\description{
See more about the GraphQL API here:
\url{https://developer.github.com/v4/}
}
\details{
Note: pagination and the \code{.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.
}
\examples{
\dontshow{if (FALSE) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
gh_gql("query { viewer { login }}")
\dontshow{\}) # examplesIf}
}
\seealso{
\code{\link[=gh]{gh()}} for the GitHub v3 API.
}
gh/man/gh_next.Rd 0000644 0001762 0000144 00000002246 13611545611 013355 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/pagination.R
\name{gh_next}
\alias{gh_next}
\alias{gh_prev}
\alias{gh_first}
\alias{gh_last}
\title{Get the next, previous, first or last page of results}
\usage{
gh_next(gh_response)
gh_prev(gh_response)
gh_first(gh_response)
gh_last(gh_response)
}
\arguments{
\item{gh_response}{An object returned by a \code{\link[=gh]{gh()}} call.}
}
\value{
Answer from the API.
}
\description{
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.
}
\examples{
\dontshow{if (identical(Sys.getenv("IN_PKGDOWN"), "true")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
x <- gh("/users")
vapply(x, "[[", character(1), "login")
x2 <- gh_next(x)
vapply(x2, "[[", character(1), "login")
\dontshow{\}) # examplesIf}
}
\seealso{
The \code{.limit} argument to \code{\link[=gh]{gh()}} supports fetching more than
one page.
}
gh/man/gh_whoami.Rd 0000644 0001762 0000144 00000005552 13612361004 013657 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/gh_whoami.R
\name{gh_whoami}
\alias{gh_whoami}
\title{Info on current GitHub user and token}
\usage{
gh_whoami(.token = NULL, .api_url = NULL, .send_headers = NULL)
}
\arguments{
\item{.token}{Authentication token. Defaults to \code{GITHUB_PAT} or
\code{GITHUB_TOKEN} environment variables, in this order if any is set.
See \code{\link[=gh_token]{gh_token()}} if you need more flexibility, e.g. different tokens
for different GitHub Enterprise deployments.}
\item{.api_url}{Github API url (default: \url{https://api.github.com}). Used
if \code{endpoint} just contains a path. Defaults to \code{GITHUB_API_URL}
environment variable if set.}
\item{.send_headers}{Named character vector of header field values
(except \code{Authorization}, which is handled via \code{.token}). This can be
used to override or augment the default \code{User-Agent} header:
\code{"https://github.com/r-lib/gh"}.}
}
\value{
A \code{gh_response} object, which is also a \code{list}.
}
\description{
Reports wallet name, GitHub login, and GitHub URL for the current
authenticated user, the first bit of the token, and the associated scopes.
}
\details{
Get a personal access token for the GitHub API from
\url{https://github.com/settings/tokens} and select the scopes necessary for
your planned tasks. The \code{repo} scope, for example, is one many are
likely to need. The token itself is a string of 40 letters and digits. You
can store it any way you like and provide explicitly via the \code{.token}
argument to \code{\link[=gh]{gh()}}.
However, many prefer to define an environment variable \code{GITHUB_PAT} (or
\code{GITHUB_TOKEN}) with this value in their \code{.Renviron} file. Add a
line that looks like this, substituting your PAT:\preformatted{GITHUB_PAT=8c70fd8419398999c9ac5bacf3192882193cadf2
}
Put a line break at the end! If you’re using an editor that shows line
numbers, there should be (at least) two lines, where the second one is empty.
Restart R for this to take effect. Call \code{gh_whoami()} to confirm
success.
To get complete information on the authenticated user, call
\code{gh("/user")}.
For token management via API (versus the browser), use the
\href{https://developer.github.com/v3/oauth_authorizations}{Authorizations API}.
This API requires Basic Authentication using your username and password,
not tokens, and is outside the scope of the gh package.
}
\examples{
\dontshow{if (identical(Sys.getenv("IN_PKGDOWN"), "true")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
gh_whoami()
\dontshow{\}) # examplesIf}
\dontshow{if (FALSE) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
## explicit token + use with GitHub Enterprise
gh_whoami(.token = "8c70fd8419398999c9ac5bacf3192882193cadf2",
.api_url = "https://github.foobar.edu/api/v3")
\dontshow{\}) # examplesIf}
}
gh/man/gh.Rd 0000644 0001762 0000144 00000015044 13612423656 012324 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/package.R
\docType{package}
\name{gh}
\alias{gh}
\alias{gh-package}
\title{GitHub API}
\usage{
gh(
endpoint,
...,
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
)
}
\arguments{
\item{endpoint}{GitHub API endpoint. Must be one of the following forms:
\itemize{
\item \verb{METHOD path}, e.g. \code{GET /rate_limit},
\item \code{path}, e.g. \verb{/rate_limit},
\item \verb{METHOD url}, e.g. \verb{GET https://api.github.com/rate_limit},
\item \code{url}, e.g. \verb{https://api.github.com/rate_limit}.
}
If the method is not supplied, will use \code{.method}, which defaults
to \code{"GET"}.}
\item{...}{Name-value pairs giving API parameters. Will be matched
into \code{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 \code{NULL} values are silently dropped,
and named \code{NA} values trigger an error.}
\item{per_page}{Number of items to return per page. If omitted,
will be substituted by \code{max(.limit, 100)} if \code{.limit} is set,
otherwise determined by the API (never greater than 100).}
\item{.token}{Authentication token. Defaults to \code{GITHUB_PAT} or
\code{GITHUB_TOKEN} environment variables, in this order if any is set.
See \code{\link[=gh_token]{gh_token()}} if you need more flexibility, e.g. different tokens
for different GitHub Enterprise deployments.}
\item{.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.}
\item{.overwrite}{if \code{.destfile} is provided, whether to overwrite an
existing file. Defaults to FALSE.}
\item{.api_url}{Github API url (default: \url{https://api.github.com}). Used
if \code{endpoint} just contains a path. Defaults to \code{GITHUB_API_URL}
environment variable if set.}
\item{.method}{HTTP method to use if not explicitly supplied in the
\code{endpoint}.}
\item{.limit}{Number of records to return. This can be used
instead of manual pagination. By default it is \code{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 \code{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.}
\item{.accept}{The value of the \code{Accept} HTTP header. Defaults to
\code{"application/vnd.github.v3+json"} . If \code{Accept} is given in
\code{.send_headers}, then that will be used. This paramter can be used to
provide a custom media type, in order to access a preview feature of
the API.}
\item{.send_headers}{Named character vector of header field values
(except \code{Authorization}, which is handled via \code{.token}). This can be
used to override or augment the default \code{User-Agent} header:
\code{"https://github.com/r-lib/gh"}.}
\item{.progress}{Whether to show a progress indicator for calls that
need more than one HTTP request.}
}
\value{
Answer from the API as a \code{gh_response} object, which is also a
\code{list}. Failed requests will generate an R error. Requests that
generate a raw response will return a raw vector.
}
\description{
Minimal wrapper to access GitHub's 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:
\itemize{
\item Try to substitute each listed parameter into \code{endpoint}, using the
\verb{:parameter} notation.
\item If a GET request (the default), then add all other listed parameters
as query parameters.
\item If not a GET request, then send the other parameters in the request
body, as JSON.
\item Convert the response to an R list using \code{\link[jsonlite:fromJSON]{jsonlite::fromJSON()}}.
}
}
\examples{
\dontshow{if (identical(Sys.getenv("IN_PKGDOWN"), "true")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
## Repositories of a user, these are equivalent
gh("/users/hadley/repos")
gh("/users/:username/repos", username = "hadley")
## Starred repositories of a user
gh("/users/hadley/starred")
gh("/users/:username/starred", username = "hadley")
\dontshow{\}) # examplesIf}
\dontshow{if (FALSE) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
## Create a repository, needs a token in GITHUB_PAT (or GITHUB_TOKEN)
## environment variable
gh("POST /user/repos", name = "foobar")
\dontshow{\}) # examplesIf}
\dontshow{if (identical(Sys.getenv("IN_PKGDOWN"), "true")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
## 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)
\dontshow{\}) # examplesIf}
\dontshow{if (FALSE) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
## 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")
\dontshow{\}) # examplesIf}
\dontshow{if (FALSE) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
## 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")
\dontshow{\}) # examplesIf}
\dontshow{if (FALSE) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
## 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))
\dontshow{\}) # examplesIf}
}
\seealso{
Useful links:
\itemize{
\item \url{https://github.com/r-lib/gh#readme}
\item Report bugs at \url{https://github.com/r-lib/gh/issues}
}
\code{\link[=gh_gql]{gh_gql()}} if you want to use the GitHub GraphQL API,
\code{\link[=gh_whoami]{gh_whoami()}} for details on GitHub API token management.
}
\author{
\strong{Maintainer}: Gábor Csárdi \email{csardi.gabor@gmail.com} [contributor]
Authors:
\itemize{
\item Jennifer Bryan
\item Hadley Wickham
}
}
gh/man/gh_token.Rd 0000644 0001762 0000144 00000011202 13612445240 013505 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/gh_token.R
\name{gh_token}
\alias{gh_token}
\title{Return the local user's GitHub Personal Access Token (PAT)}
\usage{
gh_token(api_url = NULL)
}
\arguments{
\item{api_url}{Github API url. Defaults to \code{GITHUB_API_URL}
environment variable if set, otherwise \url{https://api.github.com}.}
}
\value{
A string, with the token, or a zero length string scalar,
if no token is available.
}
\description{
You can read more about PATs here:
\url{https://help.github.com/articles/creating-a-personal-access-token-for-the-command-line/}
and you can access your PATs here (if logged in to GitHub):
\url{https://github.com/settings/tokens}.
}
\details{
Set the \code{GITHUB_PAT} environment variable to avoid having to include
your PAT in the code. If you work with multiple GitHub deployments,
e.g. via GitHub Enterprise, then read 'PATs for GitHub Enterprise' below.
If you want a more secure solution than putting authentication tokens
into environment variables, read 'Storing PATs in the system keyring'
below.
}
\section{NA}{
gh supports storing your PAT in the system keyring, on Windows, macOS
and Linux, using the keyring package. To turn on keyring support, you
need to set the \code{GH_KEYRING} environment variables to \code{true}, in your
\code{.Renviron} file or profile.
If keyring support is turned on, then for each PAT environment variable,
gh first checks whether the key with that value is set in the system
keyring, and if yes, it will use its value as the PAT. I.e. without a
custom \code{GITHUB_API_URL} variable, it checks the
\code{GITHUB_PAT_API_GITHUB_COM} key first, then the env var with the same
name, then the \code{GITHUB_PAT} key, etc. Such a check looks like this:\if{html}{\out{}}\preformatted{keyring::key_get("GITHUB_PAT_API_GITHUB_COM")
}\if{html}{\out{
}}
and it uses the default keyring backend and the default keyring within
that backend. See \code{\link[keyring:default_backend]{keyring::default_backend()}} for details and changing
these defaults.
If the selected keyring is locked, and the session is interactive,
then gh will try to unlock it. If the keyring is locked, and the session
is not interactive, then gh will not use the keyring. Note that some
keyring backends cannot be locked (e.g. the one that uses environment
variables).
On some OSes, e.g. typically on macOS, you need to allow R to access the
system keyring. You can allow this separately for each access, or for
all future accesses, until you update or re-install R. You typically
need to give access to each R GUI (e.g. RStudio) and the command line
R program separately.
To store your PAT on the keyring run\if{html}{\out{}}\preformatted{keyring::key_set("GITHUB_PAT")
}\if{html}{\out{
}}
}
\section{Storing PATs in the system keyring}{
gh supports storing your PAT in the system keyring, on Windows, macOS
and Linux, using the keyring package. To turn on keyring support, you
need to set the \code{GH_KEYRING} environment variables to \code{true}, in your
\code{.Renviron} file or profile.
If keyring support is turned on, then for each PAT environment variable,
gh first checks whether the key with that value is set in the system
keyring, and if yes, it will use its value as the PAT. I.e. without a
custom \code{GITHUB_API_URL} variable, it checks the
\code{GITHUB_PAT_API_GITHUB_COM} key first, then the env var with the same
name, then the \code{GITHUB_PAT} key, etc. Such a check looks like this:\if{html}{\out{}}\preformatted{keyring::key_get("GITHUB_PAT_API_GITHUB_COM")
}\if{html}{\out{
}}
and it uses the default keyring backend and the default keyring within
that backend. See \code{\link[keyring:default_backend]{keyring::default_backend()}} for details and changing
these defaults.
If the selected keyring is locked, and the session is interactive,
then gh will try to unlock it. If the keyring is locked, and the session
is not interactive, then gh will not use the keyring. Note that some
keyring backends cannot be locked (e.g. the one that uses environment
variables).
On some OSes, e.g. typically on macOS, you need to allow R to access the
system keyring. You can allow this separately for each access, or for
all future accesses, until you update or re-install R. You typically
need to give access to each R GUI (e.g. RStudio) and the command line
R program separately.
To store your PAT on the keyring run\if{html}{\out{}}\preformatted{keyring::key_set("GITHUB_PAT")
}\if{html}{\out{
}}
}
\seealso{
\code{\link[=slugify_url]{slugify_url()}} for computing the environment variables that
gh uses to search for API URL specific PATs.
}
gh/man/print.gh_response.Rd 0000644 0001762 0000144 00000000567 13243233512 015367 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/print.R
\name{print.gh_response}
\alias{print.gh_response}
\title{Print the result of a GitHub API call}
\usage{
\method{print}{gh_response}(x, ...)
}
\arguments{
\item{x}{The result object.}
\item{...}{Ignored.}
}
\value{
The JSON result.
}
\description{
Print the result of a GitHub API call
}
gh/man/gh_tree_remote.Rd 0000644 0001762 0000144 00000001230 13611545611 014701 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/git.R
\name{gh_tree_remote}
\alias{gh_tree_remote}
\title{Find the GitHub remote associated with a path}
\usage{
gh_tree_remote(path = ".")
}
\arguments{
\item{path}{Path that is contained within a git repo.}
}
\value{
If the repo has a github remote, a list containing \code{username}
and \code{repo}. Otherwise, an error.
}
\description{
This is handy helper if you want to make gh requests related to the
current project.
}
\examples{
\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
gh_tree_remote()
\dontshow{\}) # examplesIf}
}
gh/man/slugify_url.Rd 0000644 0001762 0000144 00000001106 13612361004 014250 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/gh_token.R
\name{slugify_url}
\alias{slugify_url}
\title{Compute the suffix that gh uses for GitHub API URL specific PATs}
\usage{
slugify_url(url)
}
\arguments{
\item{url}{Character vector HTTP/HTTPS URLs.}
}
\value{
Character vector of suffixes.
}
\description{
Compute the suffix that gh uses for GitHub API URL specific PATs
}
\examples{
# The main GH site
slugify_url("https://api.github.com")
# A custom one
slugify_url("https://github.acme.com")
}
\seealso{
\code{\link[=gh_token]{gh_token()}}
}
gh/DESCRIPTION 0000644 0001762 0000144 00000001462 13612511651 012362 0 ustar ligges users Package: gh
Title: 'GitHub' 'API'
Version: 1.1.0
Authors@R:
c(person("Gábor", "Csárdi",, "csardi.gabor@gmail.com", c("cre", "ctb")),
person("Jennifer", "Bryan", role = "aut"),
person("Hadley", "Wickham", role = "aut"))
Description: Minimal client to access the 'GitHub' 'API'.
License: MIT + file LICENSE
LazyData: true
URL: https://github.com/r-lib/gh#readme
BugReports: https://github.com/r-lib/gh/issues
Suggests: covr, keyring, pingr, testthat, withr
Imports: cli, ini, jsonlite, httr (>= 1.2)
RoxygenNote: 7.0.2.9000
Encoding: UTF-8
NeedsCompilation: no
Packaged: 2020-01-24 01:39:13 UTC; gaborcsardi
Author: Gábor Csárdi [cre, ctb],
Jennifer Bryan [aut],
Hadley Wickham [aut]
Maintainer: Gábor Csárdi
Repository: CRAN
Date/Publication: 2020-01-24 06:50:17 UTC
gh/tests/ 0000755 0001762 0000144 00000000000 13612361004 012006 5 ustar ligges users gh/tests/testthat/ 0000755 0001762 0000144 00000000000 13612511651 013653 5 ustar ligges users gh/tests/testthat/test-github_remote.R 0000644 0001762 0000144 00000001716 13243233512 017612 0 ustar ligges users context("github_remote")
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-mock-repos.R 0000644 0001762 0000144 00000006742 13446505601 017046 0 ustar ligges users
context("repos")
test_that("repos, some basics", {
skip_if_offline()
skip_on_cran()
skip("needs mocking")
res <- gh("/user/repos", .token = tt())
expect_true(all(c("id", "name", "full_name") %in% names(res[[1]])))
res <- gh("/users/:username/repos", username = "gaborcsardi", .token = tt())
expect_true(all(c("id", "name", "full_name") %in% names(res[[1]])))
res <- gh("/orgs/:org/repos", org = "r-lib", type = "sources", .token = tt())
expect_true("desc" %in% vapply(res, "[[", "name", FUN.VALUE = ""))
res <- gh("/repositories", .token = tt())
expect_true(all(c("id", "name", "full_name") %in% names(res[[1]])))
res <- gh(
"POST /user/repos",
name = "gh-testing",
description = "Test repo for gh",
homepage = "https://github.com/r-lib/gh",
private = FALSE,
has_issues = FALSE,
has_wiki = FALSE,
.token = tt()
)
expect_equal(res$name, "gh-testing")
expect_equal(res$description, "Test repo for gh")
expect_equal(res$homepage, "https://github.com/r-lib/gh")
expect_false(res$private)
expect_false(res$has_issues)
expect_false(res$has_wiki)
## TODO: POST /orgs/:org/repos
res <- gh(
"/repos/:owner/:repo",
owner = gh_test_owner,
repo = "gh-testing",
.token = tt()
)
expect_equal(res$name, "gh-testing")
expect_equal(res$description, "Test repo for gh")
expect_equal(res$homepage, "https://github.com/r-lib/gh")
expect_false(res$private)
expect_false(res$has_issues)
expect_false(res$has_wiki)
res <- gh(
"PATCH /repos/:owner/:repo",
owner = gh_test_owner,
repo = "gh-testing",
name = "gh-testing",
description = "Still a test repo",
.token = tt()
)
expect_equal(res$name, "gh-testing")
expect_equal(res$description, "Still a test repo")
res <- gh(
"GET /repos/:owner/:repo/contributors",
owner = gh_test_owner,
repo = "myrepo",
.token = tt()
)
expect_true("gh-testing" %in% vapply(res, "[[", "", "login"))
res <- gh(
"GET /repos/:owner/:repo/languages",
owner = "r-lib",
repo = "desc",
.token = tt()
)
expect_true("R" %in% names(res))
## TODO: GET /repos/:owner/:repo/teams does not seem to work
res <- gh(
"GET /repos/:owner/:repo/teams",
owner = "gh-testing-org",
repo = "org-repo",
.token = tt()
)
expect_true("myteam" %in% vapply(res, "[[", "", "name"))
res <- gh(
"GET /repos/:owner/:repo/tags",
owner = "gh-testing",
repo = "myrepo",
.token = tt()
)
expect_true(res[[1]]$name == "v0.0.1")
res <- gh(
"DELETE /repos/:owner/:repo",
owner = "gh-testing",
repo = "gh-testing",
.token = tt()
)
expect_equal(res[[1]], "") # TODO: better return value here?
})
test_that("repo files", {
skip_if_offline()
skip_on_cran()
skip("needs mocking")
res <- gh(
"GET /repos/:owner/:repo/contents/:path",
owner = "r-lib",
repo = "gh",
path = "DESCRIPTION",
.send_headers = c(Accept = "application/vnd.github.v3.raw"),
.token = tt()
)
expect_equal(attr(res, "response")[["x-github-media-type"]],
"github.v3; param=raw")
expect_equal(class(res), c("gh_response", "raw"))
tmp <- tempfile()
res <- gh("/orgs/:org/repos", org = "r-lib", type = "sources", .token = tt())
res_file <- gh("/orgs/:org/repos", org = "r-lib", type = "sources",
destfile = tmp, .token = tt())
expect_equal(class(res_file), c("gh_response", "path"))
expect_equivalent(res, jsonlite::fromJSON(res_file, simplifyVector = FALSE))
})
gh/tests/testthat/test-token.R 0000644 0001762 0000144 00000004752 13612445240 016103 0 ustar ligges users
test_that("api specific token is used", {
env <- c(
GH_KEYRING = "false",
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")
})
env2 <- c(
GH_KEYRING = "false",
GITHUB_API_URL = NA,
GITHUB_PAT_API_GITHUB_COM = "good",
GITHUB_PAT = "bad",
GITHUB_TOKEN = "bad2"
)
withr::with_envvar(env2, {
expect_equal(gh_token(), "good")
expect_equal(gh_token("https://api.github.com"), "good")
})
})
test_that("fall back to GITHUB_PAT", {
env <- c(
GH_KEYRING = "false",
GITHUB_API_URL = "https://github.acme.com",
GITHUB_PAT_GITHUB_ACME2_COM = "acme2",
GITHUB_PAT = "pat",
GITHUB_TOKEN = "token"
)
withr::with_envvar(env, {
expect_equal(gh_token(), "pat")
expect_equal(gh_token("https://github.acme4.com"), "pat")
})
env2 <- c(
GH_KEYRING = "false",
GITHUB_API_URL = "https://github.acme.com",
GITHUB_PAT = "pat",
GITHUB_TOKEN = "token"
)
withr::with_envvar(env2, {
expect_equal(gh_token(), "pat")
expect_equal(gh_token("https://github.acme4.com"), "pat")
})
env3 <- c(
GH_KEYRING = "false",
GITHUB_API_URL = NA,
GITHUB_PAT_API_GITHUB_COM = NA,
GITHUB_PAT = "pat",
GITHUB_TOKEN = "token"
)
withr::with_envvar(env3, {
expect_equal(gh_token(), "pat")
expect_equal(gh_token("https://api.github.com"), "pat")
})
})
test_that("fall back to GITHUB_TOKEN", {
env <- c(
GH_KEYRING = "false",
GITHUB_API_URL = "https://github.acme.com",
GITHUB_PAT_GITHUB_ACME2_COM = "acme2",
GITHUB_PAT = NA,
GITHUB_TOKEN = "token"
)
withr::with_envvar(env, {
expect_equal(gh_token(), "token")
expect_equal(gh_token("https://github.acme4.com"), "token")
})
env2 <- c(
GH_KEYRING = "false",
GITHUB_API_URL = "https://github.acme.com",
GITHUB_PAT = NA,
GITHUB_TOKEN = "token"
)
withr::with_envvar(env2, {
expect_equal(gh_token(), "token")
expect_equal(gh_token("https://github.acme4.com"), "token")
})
env3 <- c(
GH_KEYRING = "false",
GITHUB_API_URL = NA,
GITHUB_PAT_API_GITHUB_COM = NA,
GITHUB_PAT = NA,
GITHUB_TOKEN = "token"
)
withr::with_envvar(env3, {
expect_equal(gh_token(), "token")
expect_equal(gh_token("https://api.github.com"), "token")
})
})
gh/tests/testthat/test-na-null.R 0000644 0001762 0000144 00000001400 13611545611 016316 0 ustar ligges users
test_that("named NULL is dropped", {
tcs <- list(
list(list(), list()),
list(list(a = 1), list(a = 1)),
list(list(NULL), list(NULL)),
list(list(a = NULL), list()),
list(list(NULL, a = NULL, 1), list(NULL, 1)),
list(list(a = NULL, b = 1, 5), list(b = 1, 5))
)
for (tc in tcs) {
expect_identical(
drop_named_nulls(tc[[1]]),
tc[[2]],
info = tc
)
}
})
test_that("named NA is error", {
goodtcs <- list(
list(),
list(NA),
list(NA, NA_integer_, a = 1)
)
badtcs <- list(
list(b = NULL, a = NA),
list(a = NA_integer_),
list(NA, c = NA_real_)
)
for (tc in goodtcs) {
expect_silent(check_named_nas(tc))
}
for (tc in badtcs) {
expect_error(check_named_nas(tc))
}
})
gh/tests/testthat/test-mock-error.R 0000644 0001762 0000144 00000001011 13243233512 017021 0 ustar ligges users context("github_error")
test_that("errors return a github_error object", {
skip_if_offline()
skip_on_cran()
e <- tryCatch(gh("/missing", .token = tt()), error = identity)
expect_s3_class(e, "github_error")
expect_s3_class(e, "http_error_404")
})
test_that("can catch a given status directly", {
skip_if_offline()
skip_on_cran()
e <- tryCatch(
gh("/missing", .token = tt()),
"http_error_404" = identity
)
expect_s3_class(e, "github_error")
expect_s3_class(e, "http_error_404")
})
gh/tests/testthat/helper-offline.R 0000644 0001762 0000144 00000000623 13243233512 016673 0 ustar ligges users
skip_if_offline <- (function() {
offline <- NA
function() {
if (is.na(offline)) {
offline <<- tryCatch(
is.na(pingr::ping_port("github.com", count = 1, timeout = 1)),
error = function(e) TRUE
)
}
if (offline) skip("Offline")
}
})()
skip_if_no_token <- function() {
if (is.na(Sys.getenv("GH_TESTING", NA_character_))) {
skip("No GitHub token")
}
}
gh/tests/testthat/helper.R 0000644 0001762 0000144 00000000757 13243233512 015263 0 ustar ligges users
## If there is no GH_TESTING env var, then
## * we are replaying previously recorded responses
## * we are performing unseen requests, but this should not happen.
##
## If there is a GH_TESTING env var, then we are in dev mode.
## * It's still being sorted out exactly what this means re:
## replaying and recording. For now, same default as above.
## https://github.com/gaborcsardi/httrmock/issues/5
## * Reveal debugging info from httrmock.
tt <- function() Sys.getenv("GH_TESTING", NA)
gh/tests/testthat/test-build_request.R 0000644 0001762 0000144 00000001751 13243233512 017623 0 ustar ligges users context("build_request")
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)
})
gh/tests/testthat/test-utils.R 0000644 0001762 0000144 00000001227 13243233512 016112 0 ustar ligges users context("utils")
test_that("can detect presence vs absence names", {
expect_identical(has_name(list("foo", "bar")), c(FALSE, FALSE))
expect_identical(has_name(list(a = "foo", "bar")), c(TRUE, FALSE))
expect_identical(has_name({
x <- list("foo", "bar"); names(x)[1] <- "a"; x
}), c(TRUE, FALSE))
expect_identical(has_name({
x <- list("foo", "bar"); names(x)[1] <- "a"; names(x)[2] <- ""; x
}), c(TRUE, FALSE))
expect_identical(has_name({
x <- list("foo", "bar"); names(x)[1] <- ""; x
}), c(FALSE, FALSE))
expect_identical(has_name({
x <- list("foo", "bar"); names(x)[1] <- ""; names(x)[2] <- ""; x
}), c(FALSE, FALSE))
})
gh/tests/testthat/test-mock-whoami.R 0000644 0001762 0000144 00000001762 13243233512 017171 0 ustar ligges users context("whoami")
test_that("whoami works in presence of PAT", {
skip_if_offline()
skip_on_cran()
skip_if_no_token()
res <- gh_whoami(.token = tt())
expect_s3_class(res, "gh_response")
expect_identical(res[["login"]], "gh-testing")
expect_match(res[["scopes"]], "\\brepo\\b")
expect_match(res[["scopes"]], "\\buser\\b")
})
test_that("whoami works in absence of PAT", {
skip_if_offline()
skip_on_cran()
expect_message(res <- gh_whoami(.token = ""),
"No personal access token \\(PAT\\) available.")
expect_null(res)
})
test_that("whoami errors with bad PAT", {
skip("re-activate when request matching sorted out (gaborcsardi/httrmock#3)")
skip_if_offline()
skip_on_cran()
e <- tryCatch(gh_whoami(.token = NA), error = identity)
expect_s3_class(e, "github_error")
expect_s3_class(e, "http_error_401")
e <- tryCatch(gh_whoami(.token = "blah"), error = identity)
expect_s3_class(e, "github_error")
expect_s3_class(e, "http_error_401")
})
gh/tests/testthat.R 0000644 0001762 0000144 00000000212 13612361004 013764 0 ustar ligges users library(testthat)
library(gh)
# Don't want to use keyrings on CRAN
withr::with_envvar(
c(GH_NO_KEYRING = "true"),
test_check("gh")
)
gh/R/ 0000755 0001762 0000144 00000000000 13612445243 011055 5 ustar ligges users gh/R/print.R 0000644 0001762 0000144 00000000761 13446505601 012340 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"))) {
attr(x, c("method")) <- NULL
attr(x, c("response")) <- NULL
attr(x, ".send_headers") <- NULL
print.default(x)
} else {
print(toJSON(unclass(x), pretty = TRUE, auto_unbox = TRUE))
}
}
gh/R/utils.R 0000644 0001762 0000144 00000004606 13612361004 012336 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])
}
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 (tolower(getOption("rstudio.notebook.executing", "false")) == "true") {
FALSE
} else if (identical(Sys.getenv("TESTTHAT"), "true")) {
FALSE
} else {
interactive()
}
}
gh/R/gh_request.R 0000644 0001762 0000144 00000007150 13612423127 013346 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,
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)
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_dest(working)
working[c("method", "url", "headers", "query", "body", "dest")]
}
## gh_set_*(x)
## x = a list in which we build up an httr 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)
}
x$method <- gsub("^([^/ ]+)\\s+.*$", "\\1", x$endpoint)
stopifnot(x$method %in% c("GET", "POST", "PATCH", "PUT", "DELETE"))
x$endpoint <- gsub("^[A-Z]+ ", "", x$endpoint)
x
}
gh_set_endpoint <- function(x) {
params <- x$params
if (!grepl(":", 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) {
n <- names(params)[i]
p <- params[[i]][1]
endpoint2 <- gsub(paste0(":", n, "\\b"), p, endpoint)
if (endpoint2 != endpoint) {
endpoint <- endpoint2
done[i] <- TRUE
}
}
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 <- toJSON(x$params, auto_unbox = TRUE)
}
x
}
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_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 <- x$api_url %||% default_api_url()
x$url <- URLencode(paste0(x$api_url, x$endpoint))
}
x
}
#' @importFrom httr write_disk write_memory
gh_set_dest <- function(x) {
if (is.null(x$dest)) {
x$dest <- write_memory()
} else {
x$dest <- write_disk(x$dest, overwrite = x$overwrite)
}
x
}
gh_send_headers <- function(accept_header = NULL, headers = NULL) {
modify_vector(
modify_vector(default_send_headers, accept_header),
headers
)
}
gh/R/gh_whoami.R 0000644 0001762 0000144 00000005311 13612361004 013132 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. The token itself is a string of 40 letters and digits. You
#' can store it any way you like and provide explicitly via the `.token`
#' argument to [gh()].
#'
#' However, many prefer to define an environment variable `GITHUB_PAT` (or
#' `GITHUB_TOKEN`) with this value in their `.Renviron` file. Add a
#' line that looks like this, substituting your PAT:
#'
#' ```
#' GITHUB_PAT=8c70fd8419398999c9ac5bacf3192882193cadf2
#' ```
#'
#' Put a line break at the end! If you’re using an editor that shows line
#' numbers, there should be (at least) two lines, where the second one is empty.
#' Restart R for this to take effect. Call `gh_whoami()` to confirm
#' success.
#'
#' To get complete information on the authenticated user, call
#' `gh("/user")`.
#'
#' For token management via API (versus the browser), use the
#' [Authorizations API](https://developer.github.com/v3/oauth_authorizations).
#' This API requires Basic Authentication using your username and password,
#' not tokens, and is outside the scope of the gh package.
#'
#' @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 <- obfuscate(.token)
## 'gh_response' class has to be restored
class(res) <- c("gh_response", "list")
res
}
obfuscate <- function(x, first = 2, last = 0) {
paste0(substr(x, start = 1, stop = first),
"...",
substr(x, start = nchar(x) - last + 1, stop = nchar(x)))
}
gh/R/git.R 0000644 0001762 0000144 00000004710 13611545611 011764 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))
}
github_remote <- function(x) {
remotes <- lapply(x, github_remote_parse)
remotes <- remotes[!vapply(remotes, is.null, logical(1))]
if (length(remotes) == 0) {
throw(new_error("No github remotes found", call. = FALSE))
}
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)) {
throw(new_error("git config does not exist", call. = FALSE))
}
ini::read.ini(config_path, "UTF-8")
}
repo_root <- function(path = ".") {
if (!file.exists(path)) {
throw(new_error("Can't find '", path, "'.", call. = FALSE))
}
# Walk up to root directory
while (!has_git(path)) {
if (is_root(path)) {
throw(new_error("Could not find git root.", call. = FALSE))
}
path <- dirname(path)
}
path
}
has_git <- function(path) {
file.exists(file.path(path, ".git"))
}
is_root <- function(path) {
identical(path, dirname(path))
}
gh/R/errors.R 0000644 0001762 0000144 00000045003 13611545611 012515 0 ustar ligges users
# # Standalone file for better error handling ----------------------------
#
# If can allow package dependencies, then you are probably better off
# using rlang's functions for errors.
#
# The canonical location of this file is in the processx package:
# https://github.com/r-lib/processx/master/R/errors.R
#
# ## Features
#
# - Throw conditions and errors with the same API.
# - Automatically captures the right calls and adds them to the conditions.
# - Sets `.Last.error`, so you can easily inspect the errors, even if they
# were not caught.
# - It only sets `.Last.error` for the errors that are not caught.
# - Hierarchical errors, to allow higher level error messages, that are
# more meaningful for the users, while also keeping the lower level
# details in the error object. (So in `.Last.error` as well.)
# - `.Last.error` always includes a stack trace. (The stack trace is
# common for the whole error hierarchy.) The trace is accessible within
# the error, e.g. `.Last.error$trace`. The trace of the last error is
# also at `.Last.error.trace`.
# - Can merge errors and traces across multiple processes.
# - Pretty-print errors and traces, if the crayon package is loaded.
# - Automatically hides uninformative parts of the stack trace when
# printing.
#
# ## API
#
# ```
# new_cond(..., call. = TRUE, domain = NULL)
# new_error(..., call. = TRUE, domain = NULL)
# throw(cond, parent = NULL)
# catch_rethrow(expr, ...)
# rethrow(expr, cond)
# rethrow_call(.NAME, ...)
# add_trace_back(cond)
# ```
#
# ## Roadmap:
# - better printing of anonymous function in the trace
#
# ## NEWS:
#
# ### 1.0.0 -- 2019-06-18
#
# * First release.
#
# ### 1.0.1 -- 2019-06-20
#
# * Add `rlib_error_always_trace` option to always add a trace
#
# ### 1.0.2 -- 2019-06-27
#
# * Internal change: change topenv of the functions to baseenv()
err <- local({
# -- condition constructors -------------------------------------------
#' Create a new condition
#'
#' @noRd
#' @param ... Parts of the error message, they will be converted to
#' character and then concatenated, like in [stop()].
#' @param call. A call object to include in the condition, or `TRUE`
#' or `NULL`, meaning that [throw()] should add a call object
#' automatically.
#' @param domain Translation domain, see [stop()].
#' @return Condition object. Currently a list, but you should not rely
#' on that.
new_cond <- function(..., call. = TRUE, domain = NULL) {
message <- .makeMessage(..., domain = domain)
structure(
list(message = message, call = call.),
class = c("condition"))
}
#' Create a new error condition
#'
#' It also adds the `rlib_error` class.
#'
#' @noRd
#' @param ... Passed to [new_cond()].
#' @param call. Passed to [new_cond()].
#' @param domain Passed to [new_cond()].
#' @return Error condition object with classes `rlib_error`, `error`
#' and `condition`.
new_error <- function(..., call. = TRUE, domain = NULL) {
cond <- new_cond(..., call. = call., domain = domain)
class(cond) <- c("rlib_error", "error", "condition")
cond
}
# -- throwing conditions ----------------------------------------------
#' Throw a condition
#'
#' If the condition is an error, it will also call [stop()], after
#' signalling the condition first. This means that if the condition is
#' caught by an exiting handler, then [stop()] is not called.
#'
#' @noRd
#' @param cond Condition object to throw. If it is an error condition,
#' then it calls [stop()].
#' @param parent Parent condition. Use this within [rethrow()] and
#' [catch_rethrow()].
throw <- function(cond, parent = NULL) {
if (!inherits(cond, "condition")) {
throw(new_error("You can only throw conditions"))
}
if (!is.null(parent) && !inherits(parent, "condition")) {
throw(new_error("Parent condition must be a condition object"))
}
if (is.null(cond$call) || isTRUE(cond$call)) {
cond$call <- sys.call(-1) %||% sys.call()
}
# Eventually the nframe numbers will help us print a better trace
# When a child condition is created, the child will use the parent
# error object to make note of its own nframe. Here we copy that back
# to the parent.
if (is.null(cond$`_nframe`)) cond$`_nframe` <- sys.nframe()
if (!is.null(parent)) {
cond$parent <- parent
cond$call <- cond$parent$`_childcall`
cond$`_nframe` <- cond$parent$`_childframe`
cond$`_ignore` <- cond$parent$`_childignore`
}
# We can set an option to always add the trace to the thrown
# conditions. This is useful for example in context that always catch
# errors, e.g. in testthat tests or knitr. This options is usually not
# set and we signal the condition here
always_trace <- isTRUE(getOption("rlib_error_always_trace"))
if (!always_trace) signalCondition(cond)
# If this is not an error, then we'll just return here. This allows
# throwing interrupt conditions for example, with the same UI.
if (! inherits(cond, "error")) return(invisible())
if (is.null(cond$`_pid`)) cond$`_pid` <- Sys.getpid()
if (is.null(cond$`_timestamp`)) cond$`_timestamp` <- Sys.time()
# If we get here that means that the condition was not caught by
# an exiting handler. That means that we need to create a trace.
cond <- add_trace_back(cond)
# Set up environment to store .Last.error, it will be just before
# baseenv(), so it is almost as if it was in baseenv() itself, like
# .Last.value. We save the print methos here as well, and then they
# will be found automatically.
if (! "org:r-lib" %in% search()) {
do.call("attach", list(new.env(), pos = length(search()),
name = "org:r-lib"))
}
env <- as.environment("org:r-lib")
env$print.rlib_error <- print_rlib_error
env$print.rlib_trace <- print_rlib_trace
env$.Last.error <- cond
env$.Last.error.trace <- cond$trace
# If we always wanted a trace, then we signal the condition here
if (always_trace) signalCondition(cond)
# Top-level handler, this is intended for testing only for now,
# and its design might change.
if (!is.null(th <- getOption("rlib_error_handler")) &&
is.function(th)) {
th(cond)
} else {
# Dropping the classes and adding "duplicate_condition" is a workaround
# for the case when we have non-exiting handlers on throw()-n
# conditions. These would get the condition twice, because stop()
# will also signal it. If we drop the classes, then only handlers
# on "condition" objects (i.e. all conditions) get duplicate signals.
# This is probably quite rare, but for this rare case they can also
# recognize the duplicates from the "duplicate_condition" extra class.
class(cond) <- c("duplicate_condition", "condition")
stop(cond)
}
}
# -- rethrowing conditions --------------------------------------------
#' Catch and re-throw conditions
#'
#' See [rethrow()] for a simpler interface that handles `error`
#' conditions automatically.
#'
#' @noRd
#' @param expr Expression to evaluate.
#' @param ... Condition handler specification, the same way as in
#' [withCallingHandlers()]. You are supposed to call [throw()] from
#' the error handler, with a new error object, setting the original
#' error object as parent. See examples below.
#' @examples
#' f <- function() {
#' ...
#' err$catch_rethrow(
#' ... code that potentially errors ...,
#' error = function(e) {
#' throw(new_error("This will be the child error"), parent = e)
#' }
#' )
#' }
catch_rethrow <- function(expr, ...) {
realcall <- sys.call(-1) %||% sys.call()
realframe <- sys.nframe()
parent <- parent.frame()
cl <- match.call()
cl[[1]] <- quote(withCallingHandlers)
handlers <- list(...)
for (h in names(handlers)) {
cl[[h]] <- function(e) {
# This will be NULL if the error is not throw()-n
if (is.null(e$`_nframe`)) e$`_nframe` <- sys.parent()
e$`_childcall` <- realcall
e$`_childframe` <- realframe
# We drop after realframe, until the first withCallingHandlers
wch <- find_call(sys.calls(), quote(withCallingHandlers))
if (!is.na(wch)) e$`_childignore` <- list(c(realframe + 1L, wch))
handlers[[h]](e)
}
}
eval(cl, envir = parent)
}
find_call <- function(calls, call) {
which(vapply(
calls, function(x) length(x) >= 1 && identical(x[[1]], call),
logical(1)))[1]
}
#' Catch and re-throw conditions
#'
#' `rethrow()` is similar to [catch_rethrow()], but it has a simpler
#' interface. It catches conditions with class `error`, and re-throws
#' `cond` instead, using the original condition as the parent.
#'
#' @noRd
#' @param expr Expression to evaluate.
#' @param ... Condition handler specification, the same way as in
#' [withCallingHandlers()].
rethrow <- function(expr, cond) {
realcall <- sys.call(-1) %||% sys.call()
realframe <- sys.nframe()
withCallingHandlers(
expr,
error = function(e) {
# This will be NULL if the error is not throw()-n
if (is.null(e$`_nframe`)) e$`_nframe` <- sys.parent()
e$`_childcall` <- realcall
e$`_childframe` <- realframe
# We just ignore the withCallingHandlers call, and the tail
e$`_childignore` <- list(
c(realframe + 1L, realframe + 1L),
c(e$`_nframe` + 1L, sys.nframe() + 1L))
throw(cond, parent = e)
}
)
}
#' Version of .Call that throw()s errors
#'
#' It re-throws error from interpreted code. If the error had class
#' `simpleError`, like all errors, thrown via `error()` in C do, it also
#' adds the `c_error` class.
#'
#' @noRd
#' @param .NAME Compiled function to call, see [.Call()].
#' @param ... Function arguments, see [.Call()].
#' @return Result of the call.
rethrow_call <- function(.NAME, ...) {
call <- sys.call()
nframe <- sys.nframe()
withCallingHandlers(
# do.call to work around an R CMD check issue
do.call(".Call", list(.NAME, ...)),
error = function(e) {
e$`_nframe` <- nframe
e$call <- call
if (inherits(e, "simpleError")) {
class(e) <- c("c_error", "rlib_error", "error", "condition")
}
e$`_ignore` <- list(c(nframe + 1L, sys.nframe() + 1L))
throw(e)
}
)
}
# -- create traceback -------------------------------------------------
#' Create a traceback
#'
#' [throw()] calls this function automatically if an error is not caught,
#' so there is currently not much use to call it directly.
#'
#' @param cond Condition to add the trace to
#'
#' @return A condition object, with the trace added.
add_trace_back <- function(cond) {
idx <- seq_len(sys.parent(1L))
frames <- sys.frames()[idx]
parents <- sys.parents()[idx]
calls <- as.list(sys.calls()[idx])
envs <- lapply(frames, env_label)
topenvs <- lapply(
seq_along(frames),
function(i) env_label(topenv(environment(sys.function(i)))))
nframes <- if (!is.null(cond$`_nframe`)) cond$`_nframe` else sys.parent()
messages <- list(conditionMessage(cond))
ignore <- cond$`_ignore`
classes <- class(cond)
pids <- rep(cond$`_pid` %||% Sys.getpid(), length(calls))
if (is.null(cond$parent)) {
# Nothing to do, no parent
} else if (is.null(cond$parent$trace)) {
# If the parent does not have a trace, that means that it is using
# the same trace as us.
parent <- cond
while (!is.null(parent <- parent$parent)) {
nframes <- c(nframes, parent$`_nframe`)
messages <- c(messages, list(conditionMessage(parent)))
ignore <- c(ignore, parent$`_ignore`)
}
} else {
# If it has a trace, that means that it is coming from another
# process or top level evaluation. In this case we'll merge the two
# traces.
pt <- cond$parent$trace
parents <- c(parents, pt$parents + length(calls))
nframes <- c(nframes, pt$nframes + length(calls))
ignore <- c(ignore, lapply(pt$ignore, function(x) x + length(calls)))
envs <- c(envs, pt$envs)
topenvs <- c(topenvs, pt$topenvs)
calls <- c(calls, pt$calls)
messages <- c(messages, pt$messages)
pids <- c(pids, pt$pids)
}
cond$trace <- new_trace(
calls, parents, envs, topenvs, nframes, messages, ignore, classes,
pids)
cond
}
new_trace <- function (calls, parents, envs, topenvs, nframes, messages,
ignore, classes, pids) {
indices <- seq_along(calls)
structure(
list(calls = calls, parents = parents, envs = envs, topenvs = topenvs,
indices = indices, nframes = nframes, messages = messages,
ignore = ignore, classes = classes, pids = pids),
class = "rlib_trace")
}
env_label <- function(env) {
nm <- env_name(env)
if (nzchar(nm)) {
nm
} else {
env_address(env)
}
}
env_address <- function(env) {
class(env) <- "environment"
sub("^.*(0x[0-9a-f]+)>$", "\\1", format(env), perl = TRUE)
}
env_name <- function(env) {
if (identical(env, globalenv())) {
return("global")
}
if (identical(env, baseenv())) {
return("namespace:base")
}
if (identical(env, emptyenv())) {
return("empty")
}
nm <- environmentName(env)
if (isNamespace(env)) {
return(paste0("namespace:", nm))
}
nm
}
# -- printing ---------------------------------------------------------
print_rlib_error <- function(x, ...) {
msg <- conditionMessage(x)
call <- conditionCall(x)
cl <- class(x)[1L]
if (!is.null(call)) {
cat("<", cl, " in ", format_call(call), ":\n ", msg, ">\n", sep = "")
} else {
cat("<", cl, ": ", msg, ">\n", sep = "")
}
print_srcref(x$call)
if (!identical(x$`_pid`, Sys.getpid())) {
cat(" in process", x$`_pid`, "\n")
}
if (!is.null(x$parent)) {
cat("-->\n")
print(x$parent)
}
invisible(x)
}
print_rlib_trace <- function(x, ...) {
cl <- setdiff(x$classes, c("error", "condition"))
cl <- paste0(" ERROR TRACE for ", paste(cl, collapse = ", "), "")
cat(sep = "", "\n", style_trace_title(cl), "\n\n")
calls <- map2(x$calls, x$topenv, namespace_calls)
callstr <- vapply(calls, format_call_src, character(1))
callstr[x$nframes] <-
paste0(callstr[x$nframes], "\n", style_error(x$messages), "\n")
callstr <- enumerate(callstr)
# Ignore what we were told to ignore
ign <- integer()
for (iv in x$ignore) {
if (iv[2] == Inf) iv[2] <- length(callstr)
ign <- c(ign, iv[1]:iv[2])
}
# Plus always ignore the tail. This is not always good for
# catch_rethrow(), but should be good otherwise
last_err_frame <- x$nframes[length(x$nframes)]
if (!is.na(last_err_frame) && last_err_frame < length(callstr)) {
ign <- c(ign, (last_err_frame+1):length(callstr))
}
ign <- unique(ign)
if (length(ign)) callstr <- callstr[-ign]
# Add markers for subprocesses
if (length(unique(x$pids)) >= 2) {
pids <- x$pids[-ign]
pid_add <- which(!duplicated(pids))
pid_str <- style_process(paste0("Process ", pids[pid_add], ":"))
callstr[pid_add] <- paste0(" ", pid_str, "\n", callstr[pid_add])
}
cat(callstr, sep = "\n")
invisible(x)
}
namespace_calls <- function(call, env) {
if (length(call) < 1) return(call)
if (typeof(call[[1]]) != "symbol") return(call)
pkg <- strsplit(env, "^namespace:")[[1]][2]
if (is.na(pkg)) return(call)
call[[1]] <- substitute(p:::f, list(p = as.symbol(pkg), f = call[[1]]))
call
}
print_srcref <- function(call) {
src <- format_srcref(call)
if (length(src)) cat(sep = "", " ", src, "\n")
}
`%||%` <- function(l, r) if (is.null(l)) r else l
format_srcref <- function(call) {
if (is.null(call)) return(NULL)
file <- utils::getSrcFilename(call)
if (!length(file)) return(NULL)
dir <- utils::getSrcDirectory(call)
if (length(dir) && nzchar(dir) && nzchar(file)) {
srcfile <- attr(utils::getSrcref(call), "srcfile")
if (isTRUE(srcfile$isFile)) {
file <- file.path(dir, file)
} else {
file <- file.path("R", file)
}
} else {
file <- "??"
}
line <- utils::getSrcLocation(call) %||% "??"
col <- utils::getSrcLocation(call, which = "column") %||% "??"
style_srcref(paste0(file, ":", line, ":", col))
}
format_call <- function(call) {
width <- getOption("width")
str <- format(call)
callstr <- if (length(str) > 1 || nchar(str[1]) > width) {
paste0(substr(str[1], 1, width - 5), " ...")
} else {
str[1]
}
style_call(callstr)
}
format_call_src <- function(call) {
callstr <- format_call(call)
src <- format_srcref(call)
if (length(src)) callstr <- paste0(callstr, "\n ", src)
callstr
}
enumerate <- function(x) {
paste0(style_numbers(paste0(" ", seq_along(x), ". ")), x)
}
map2 <- function (.x, .y, .f, ...) {
mapply(.f, .x, .y, MoreArgs = list(...), SIMPLIFY = FALSE,
USE.NAMES = FALSE)
}
# -- printing, styles -------------------------------------------------
has_crayon <- function() "crayon" %in% loadedNamespaces()
style_numbers <- function(x) {
if (has_crayon()) crayon::silver(x) else x
}
style_srcref <- function(x) {
if (has_crayon()) crayon::italic(crayon::cyan(x))
}
style_error <- function(x) {
sx <- paste0("\n x ", x, " ")
if (has_crayon()) crayon::bold(crayon::red(sx)) else sx
}
style_trace_title <- function(x) {
if (has_crayon()) crayon::bold(x) else x
}
style_process <- function(x) {
if (has_crayon()) crayon::bold(x) else x
}
style_call <- function(x) {
if (!has_crayon()) return(x)
call <- sub("^([^(]+)[(].*$", "\\1", x)
rest <- sub("^[^(]+([(].*)$", "\\1", x)
if (call == x || rest == x) return(x)
paste0(crayon::yellow(call), rest)
}
env <- environment()
parent.env(env) <- baseenv()
structure(
list(
.internal = env,
new_cond = new_cond,
new_error = new_error,
throw = throw,
rethrow = rethrow,
catch_rethrow = catch_rethrow,
rethrow_call = rethrow_call,
add_trace_back = add_trace_back
),
class = c("standalone_errors", "standalone"))
})
# These are optional, and feel free to remove them if you prefer to
# call them through the `err` object.
new_cond <- err$new_cond
new_error <- err$new_error
throw <- err$throw
rethrow <- err$rethrow
rethrow_call <- err$rethrow_call
gh/R/gh_response.R 0000644 0001762 0000144 00000004651 13611712326 013520 0 ustar ligges users gh_process_response <- function(response) {
stopifnot(inherits(response, "response"))
if (status_code(response) >= 300) {
gh_error(response)
}
content_type <- http_type(response)
gh_media_type <- headers(response)[["x-github-media-type"]]
is_raw <- content_type == "application/octet-stream" ||
isTRUE(grepl("param=raw$", gh_media_type, ignore.case = TRUE))
is_ondisk <- inherits(response$content, "path")
if (is_ondisk) {
res <- response$content
} else if (grepl("^application/json", content_type, ignore.case = TRUE)) {
res <- fromJSON(content(response, as = "text"), simplifyVector = FALSE)
} else if (is_raw) {
res <- content(response, as = "raw")
} else if (content_type == "application/octet-stream" &&
length(content(response, as = "raw")) == 0) {
res <- NULL
} else {
if (grepl("^text/html", content_type, ignore.case = TRUE)) {
warning("Response came back as html :(", call. = FALSE)
}
res <- list(message = content(response, as = "text"))
}
attr(res, "method") <- response$request$method
attr(res, "response") <- headers(response)
attr(res, ".send_headers") <- response$request$headers
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
}
## https://developer.github.com/v3/#client-errors
gh_error <- function(response, call = sys.call(-1)) {
heads <- headers(response)
res <- content(response)
status <- status_code(response)
msg <- c(
"",
paste0("GitHub API error (", status, "): ", heads$status),
paste0("Message: ", res$message)
)
doc_url <- res$documentation_url
if (!is.null(doc_url)) {
msg <- append(msg, paste0("Read more at ", doc_url))
}
if (status == 404) {
msg <- append(msg, c("", paste0("URL not found: ", response$request$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 <- append(
msg,
c("",
"Errors:",
capture.output(print(errors[nms], row.names = FALSE))
)
)
}
cond <- structure(list(
call = call,
message = paste0(msg, collapse = "\n")
),
class = c(
"github_error",
paste0("http_error_", status),
"error",
"condition"
))
throw(cond)
}
gh/R/gh_gql.R 0000644 0001762 0000144 00000001502 13611547126 012441 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 }}")
gh_gql <- function(query, ..., .token = NULL, .destfile = NULL,
.overwrite = FALSE, .api_url = NULL, .send_headers = NULL) {
if (".limit" %in% names(list(...))) {
stop("`.limit` does not work with the GraphQL API")
}
gh(endpoint = "POST /graphql", query = query, ..., .token = .token)
}
gh/R/gh_token.R 0000644 0001762 0000144 00000014162 13612445243 013002 0 ustar ligges users
#' Return the local user's GitHub Personal Access Token (PAT)
#'
#' You can read more about PATs here:
#'
#' and you can access your PATs here (if logged in to GitHub):
#' .
#'
#' Set the `GITHUB_PAT` environment variable to avoid having to include
#' your PAT in the code. If you work with multiple GitHub deployments,
#' e.g. via GitHub Enterprise, then read 'PATs for GitHub Enterprise' below.
#'
#' If you want a more secure solution than putting authentication tokens
#' into environment variables, read 'Storing PATs in the system keyring'
#' below.
#'
#' @section: PATs for GitHub Enterprise:
#'
#' gh lets you use different PATs for different GitHub API URLs, by looking
#' for the PAT in an URL specific environment variable first. It uses
#' [slugify_url()] to compute a suffix from the API URL, by extracting the
#' host name and removing the protocol and the path from it, and replacing
#' special characters with underscores. This suffix is added to
#' `GITHUB_PAT_` then. For example for the default API URL:
#' , the `GITHUB_PAT_API_GITHUB_COM` environment
#' variable is consulted first.
#'
#' You can set the default API URL via the `GITHUB_API_URL` environment
#' variable.
#'
#' If the API URL specific environment variable is not set, then gh falls
#' back to `GITHUB_PAT` and then to `GITHUB_TOKEN'.
#'
#' @section Storing PATs in the system keyring:
#'
#' gh supports storing your PAT in the system keyring, on Windows, macOS
#' and Linux, using the keyring package. To turn on keyring support, you
#' need to set the `GH_KEYRING` environment variables to `true`, in your
#' `.Renviron` file or profile.
#'
#' If keyring support is turned on, then for each PAT environment variable,
#' gh first checks whether the key with that value is set in the system
#' keyring, and if yes, it will use its value as the PAT. I.e. without a
#' custom `GITHUB_API_URL` variable, it checks the
#' `GITHUB_PAT_API_GITHUB_COM` key first, then the env var with the same
#' name, then the `GITHUB_PAT` key, etc. Such a check looks like this:
#'
#' ```r
#' keyring::key_get("GITHUB_PAT_API_GITHUB_COM")
#' ```
#'
#' and it uses the default keyring backend and the default keyring within
#' that backend. See [keyring::default_backend()] for details and changing
#' these defaults.
#'
#' If the selected keyring is locked, and the session is interactive,
#' then gh will try to unlock it. If the keyring is locked, and the session
#' is not interactive, then gh will not use the keyring. Note that some
#' keyring backends cannot be locked (e.g. the one that uses environment
#' variables).
#'
#' On some OSes, e.g. typically on macOS, you need to allow R to access the
#' system keyring. You can allow this separately for each access, or for
#' all future accesses, until you update or re-install R. You typically
#' need to give access to each R GUI (e.g. RStudio) and the command line
#' R program separately.
#'
#' To store your PAT on the keyring run
#' ```r
#' keyring::key_set("GITHUB_PAT")
#' ```
#'
#' @param api_url Github API url. Defaults to `GITHUB_API_URL`
#' environment variable if set, otherwise .
#'
#' @return A string, with the token, or a zero length string scalar,
#' if no token is available.
#'
#' @seealso [slugify_url()] for computing the environment variables that
#' gh uses to search for API URL specific PATs.
#' @export
gh_token <- function(api_url = NULL) {
api_url <- api_url %||% default_api_url()
token_env_var <- paste0("GITHUB_PAT_", slugify_url(api_url))
get_first_token_found(c(token_env_var, "GITHUB_PAT", "GITHUB_TOKEN"))
}
#' @importFrom cli cli_alert_info
should_use_keyring <- function() {
# Opt in?
if (tolower(Sys.getenv("GH_KEYRING", "")) != "true") return(FALSE)
# Can we load the package?
if (!can_load("keyring")) {
cli_alert_info("{.pkg gh}: the {.pkg keyring} package is not available")
return(FALSE)
}
# If is_locked() errors, the keyring cannot be locked, and we'll use it
err <- FALSE
tryCatch(
locked <- keyring::keyring_is_locked(),
error = function(e) err <- TRUE
)
if (err) return(TRUE)
# Otherwise if locked, and non-interactive session, we won't use it
if (locked && ! is_interactive()) {
cli_alert_info("{.pkg gh}: default keyring is locked")
return(FALSE)
}
# Otherwise if locked, we try to unlock it here. Otherwise key_get()
# would unlock it, but if that fails, we'll get multiple unlock dialogs
# It is better to fail here, once and for all.
if (locked) {
err <- FALSE
tryCatch(keyring::keyring_unlock(), error = function(e) err <- TRUE)
if (err) {
cli_alert_info("{.pkg gh}: failed to unlock default keyring")
return(FALSE)
}
}
TRUE
}
get_first_token_found <- function(vars) {
if (length(vars) == 0) return("")
has_keyring <- should_use_keyring()
val <- ""
key_get <- function(v) {
if (has_keyring) tryCatch(keyring::key_get(v), error = function(e) NULL)
}
for (var in vars) {
if ((val <- key_get(var) %||% "") != "") break
if ((val <- Sys.getenv(var, "")) != "") break
}
val
}
gh_auth <- function(token) {
if (isTRUE(token != "")) {
c("Authorization" = paste("token", token))
} else {
character()
}
}
#' Compute the suffix that gh uses for GitHub API URL specific PATs
#'
#' @param url Character vector HTTP/HTTPS URLs.
#' @return Character vector of suffixes.
#'
#' @seealso [gh_token()]
#' @export
#' @examples
#' # The main GH site
#' slugify_url("https://api.github.com")
#'
#' # A custom one
#' slugify_url("https://github.acme.com")
slugify_url <- function(url) {
if (!any(grepl("^https?://", url))) {
stop("Only works with HTTP(S) protocols")
}
x2 <- sub("^.*://([^/]*@)?", "", url)
x3 <- sub("/+$", "", x2)
x4 <- gsub("[./]+", "_", x3)
x5 <- gsub("[^-a-zA-Z0-9_]", "", x4)
toupper(x5)
}
get_baseurl <- function(x) {
if (!any(grepl("^https?://", x))) stop("Only works with HTTP(S) protocols")
prot <- sub("^(https?://).*$", "\\1", x)
rest <- sub("^https?://(.*)$", "\\1", x)
host <- sub("/.*$", "", rest)
paste0(prot, host)
}
gh/R/pagination.R 0000644 0001762 0000144 00000006440 13611606335 013335 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) {
stopifnot(inherits(gh_response, "gh_response"))
url <- extract_link(gh_response, link)
if (is.na(url)) throw(new_error("No ", link, " page"))
list(method = attr(gh_response, "method"),
url = url,
headers = attr(gh_response, ".send_headers"))
}
gh_link <- function(gh_response, link) {
req <- gh_link_request(gh_response, link)
raw <- gh_make_request(req)
gh_process_response(raw)
}
gh_extract_pages <- function(gh_response) {
last <- extract_link(gh_response, "last")
if (grepl("&page=[0-9]+$", last)) {
as.integer(sub("^.*page=([0-9]+)$", "\\1", last))
}
}
#' 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.
#' @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) gh_link(gh_response, "next")
#' @name gh_next
#' @export
gh_prev <- function(gh_response) gh_link(gh_response, "prev")
#' @name gh_next
#' @export
gh_first <- function(gh_response) gh_link(gh_response, "first")
#' @name gh_next
#' @export
gh_last <- function(gh_response) gh_link(gh_response, "last")
make_progress_bar <- function(gh_request) {
state <- new.env(parent = emptyenv())
state$pageno <- 0L
state$got <- 0L
state$status <- NULL
state
}
update_progress_bar <- function(state, gh_response) {
state$pageno <- state$pageno + 1L
state$got <- state$got + length(gh_response)
state$pages <- gh_extract_pages(gh_response) %||% state$pages
if (is.null(state$status)) {
state$status <- cli_status(
"{.alert-info Running gh query}",
.envir = parent.frame()
)
}
total <- NULL
if (!is.null(state$pages)) {
est <- state$pages * (state$got / state$pageno)
if (est >= state$got) total <- est
}
cli_status_update(
state$status,
c("{.alert-info Running gh query, got {state$got} record{?s}}",
if (!is.null(total)) " of about {total}")
)
invisible(state)
}
gh/R/package.R 0000644 0001762 0000144 00000016465 13612423653 012610 0 ustar ligges users
#' GitHub API
#'
#' Minimal wrapper to access GitHub's API.
#'
#' @docType package
#' @name gh
"_PACKAGE"
#' 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,
#' and named `NA` values trigger an error.
#' @param 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.
#' @param .overwrite if `.destfile` is provided, whether to overwrite an
#' existing file. Defaults to FALSE.
#' @param .token Authentication token. Defaults to `GITHUB_PAT` or
#' `GITHUB_TOKEN` environment variables, in this order if any is set.
#' See [gh_token()] if you need more flexibility, e.g. different tokens
#' for different GitHub Enterprise deployments.
#' @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 paramter 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.
#'
#' @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.
#'
#' @importFrom httr content add_headers headers
#' status_code http_type GET POST PATCH PUT DELETE
#' @importFrom jsonlite fromJSON toJSON
#' @importFrom utils URLencode capture.output
#' @importFrom cli cli_status cli_status_update
#' @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")
#' gh("/users/:username/repos", username = "hadley")
#'
#' ## Starred repositories of a user
#' gh("/users/hadley/starred")
#' gh("/users/:username/starred", username = "hadley")
#'
#' @examplesIf FALSE
#' ## Create a repository, needs a token in GITHUB_PAT (or GITHUB_TOKEN)
#' ## environment variable
#' 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))
gh <- function(endpoint, ..., 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(...)
params <- drop_named_nulls(params)
check_named_nas(params)
if (is.null(per_page)) {
if (!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,
api_url = .api_url, method = .method)
if (.progress) prbr <- make_progress_bar(req)
raw <- gh_make_request(req)
res <- gh_process_response(raw)
while (!is.null(.limit) && length(res) < .limit && gh_has_next(res)) {
update_progress_bar(prbr, res)
res2 <- gh_next(res)
res3 <- c(res, res2)
attributes(res3) <- attributes(res2)
res <- res3
}
if (! is.null(.limit) && length(res) > .limit) {
res_attr <- attributes(res)
res <- res[seq_len(.limit)]
attributes(res) <- res_attr
}
res
}
gh_make_request <- function(x) {
method_fun <- list("GET" = GET, "POST" = POST, "PATCH" = PATCH,
"PUT" = PUT, "DELETE" = DELETE)[[x$method]]
if (is.null(method_fun)) throw(new_error("Unknown HTTP verb"))
raw <- do.call(method_fun,
compact(list(url = x$url, query = x$query, body = x$body,
add_headers(x$headers), x$dest)))
raw
}
gh/NEWS.md 0000644 0001762 0000144 00000002042 13612445256 011754 0 ustar ligges users
# 1.1.0
* Raw reponses from GitHub are now returned as raw vector.
* Responses may be wrtten 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).
# 1.0.1
First public release.
gh/MD5 0000644 0001762 0000144 00000003462 13612511651 011166 0 ustar ligges users 7b61827ddae52e0618e0501a55e22a52 *DESCRIPTION
6e2bfe8ab7185ace1e16748eccf00613 *LICENSE
ed7849e5e0ca9ee8dcfc8c3e0f6e994d *NAMESPACE
f3c966135e202e782267f730affc2ff7 *NEWS.md
c6d0d6bfd3ec2dab7a5043e04e68dee8 *R/errors.R
203a372f4efd1b61abd02ef34ffa4fe5 *R/gh_gql.R
cea2564f6ebdb0f6487be88a0ab97881 *R/gh_request.R
cc851d1bbfca4bd66af479724083e567 *R/gh_response.R
a340e854a21a9a6aae0e81159e5ae494 *R/gh_token.R
251f84ea4af2c05665f6b6554eaf4d99 *R/gh_whoami.R
fe9a5d8826ad1065d035d0cf85fd40dc *R/git.R
3928ede0346c3fc83d0d98d5396315b8 *R/package.R
542fa9d9cc103c75f40de12112d535d5 *R/pagination.R
d16c16e9652ab1df46ff973edc657f47 *R/print.R
88081c19eb1d86e4be381272e865d502 *R/utils.R
7d8f8f8b5685982abb3e563ab40d0219 *README.md
1852a1b0a8ecf888797468f15cef7d4b *man/gh.Rd
df7fa8e0c06cbfcbccbc87df0e533d52 *man/gh_gql.Rd
e5358b38e37815d75c80ead3edadc2eb *man/gh_next.Rd
ecb4afe5ca4aebef0c69e3e404a839ba *man/gh_token.Rd
8dc288d4beadb347828028716153ed0c *man/gh_tree_remote.Rd
81592cce152507de14e33b343ab75d6d *man/gh_whoami.Rd
016da8202cc86b463da849981d5d309a *man/print.gh_response.Rd
efac233ae44c51449f01d323dfee841e *man/slugify_url.Rd
d0c90d0eb37412ad3921eb75aebb6dde *tests/testthat.R
ef66d955bc844f203b685ea981f621af *tests/testthat/helper-offline.R
9e259b79838b74792d363f5b5c7d94ec *tests/testthat/helper.R
edd42bb707098d64a1571c079bbbeabc *tests/testthat/test-build_request.R
bf0ee44e0b27e0a51cac15fa5737dfe4 *tests/testthat/test-github_remote.R
a4b92720497e669a65ce913af6350222 *tests/testthat/test-mock-error.R
c7723b901c2147f7720916420b24c12e *tests/testthat/test-mock-repos.R
f15bf29d803b86071b167897e268e22f *tests/testthat/test-mock-whoami.R
6c40a447b90ccb2b4ff789c361f1a3a3 *tests/testthat/test-na-null.R
965555aa5c97a176289ee2c21203ee92 *tests/testthat/test-token.R
4a295eeb98f175301e985e3275010d0f *tests/testthat/test-utils.R