#| include: false
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
#| label: setup
library(webfakes)

In this vignette, we shall look at how to implement a flow using both apps, or the server app together with httr's OAuth tools. In both cases we shall use the httr package as HTTP client. We shall end with a case study for OAuth2.0 testing. For an example using the curl package instead, look at the test file test-oauth.R of webfakes instead.

The OAuth2.0 resource and authorization server

First we need to create the resource server, which also performs the authorization, and we create variables holding its different URLs.

#| label: resource-server-creation
templog <- tempfile()
rsapp <- new_app_process(
  oauth2_resource_app(
    refresh_duration = .Machine$integer.max,
    access_duration = 10L,
  ),
  opts = server_opts(num_threads = 3)
)

regi_url <- rsapp$url("/register")
auth_url <- rsapp$url("/authorize")
toke_url <- rsapp$url("/token")

rsapp

Fake third party application

OAuth2.0 app creation & registration

Then we create the third-party app, and we create variables holding its different URLs.

#| label: third-party-app-creation
tpapp <- new_app_process(
  oauth2_third_party_app("3P app"),
  opts = server_opts(num_threads = 3)
)

redi_url <- tpapp$url("/login/redirect")
conf_url <- tpapp$url("/login/config")

tpapp

We then need to register the third-party app at the resource server. In real life this is done by the admin of the third party app. Our fake resource server provides an endpoint at /register (in regi_url) to do this automatically, without user interaction. We need to send the name of our third party app, and its redirect URL, as query parameters.

#| label: register
url <- paste0(
  regi_url,
  "?name=3P%20app",
  "&redirect_uri=", redi_url
)
reg_resp <- httr::GET(url)
reg_resp
regdata <- httr::content(reg_resp)
regdata

The resource app replies with the client id and the client secret. We'll use them to authenticate the third party app. In real life they are included in the config of the third party app by its admin. Our third party app has an API endpoint, /login/config (already in conf_url) to configure them.

#| label: register-data
auth_data <- list(
  auth_url = auth_url,
  token_url = toke_url,
  client_id = regdata$client_id[[1]],
  client_secret = regdata$client_secret[[1]]
)

httr::POST(
  conf_url,
  body = auth_data,
  encode = "json"
)

The OAuth2.0 dance

Now a user can go to the login URL of the third party app, /login in our fake app, to authenticate. To start the web page from R, you can run

#| eval: false
browseURL(tpapp$url("/login"))
#| include: false
login <- oauth2_login(tpapp$url("/login"))

The third party app now has a token, that it can use to authenticate to the resource app. See the test-oauth.R file within webfakes to see how to do this part programmatically, without a browser.

By default our fake third party app saves the token(s) into a local variable, and also returns in JSON, so you can see that in the browser:

#| echo: false
cat(rawToChar(login$token_response$content))

If you want to change this behavior, you can define the redirect_hook function in the third party app. For example:

#| label: hook
thirdp <- oauth2_third_party_app("3P app")
thirdp$redirect_hook <- function(res, tokens) {
  res$
    set_status(200L)$
    send("Authentication complete, return to R!")
}

tpapp2 <- new_app_process(
  thirdp,
  opts = server_opts(num_threads = 3)
)

redi_url2 <- tpapp2$url("/login/redirect")
conf_url2 <- tpapp2$url("/login/config")

tpapp2

url2 <- paste0(
  regi_url,
  "?name=3P%20app2",
  "&redirect_uri=", redi_url2
)
reg_resp2 <- httr::GET(url2)
reg_resp2
regdata2 <- httr::content(reg_resp2)
regdata2
auth_data2 <- list(
  auth_url = auth_url,
  token_url = toke_url,
  client_id = regdata2$client_id[[1]],
  client_secret = regdata2$client_secret[[1]]
)

httr::POST(
  conf_url2,
  body = auth_data2,
  encode = "json"
)

Then again you can authenticate at the new app with

#| eval: false
browseURL(tpapp2$url("/login"))
#| include: false
login2 <- oauth2_login(tpapp2$url("/login"))
#| echo: false
cat(rawToChar(login2$token_response$content))

The fake third party app also has an endpoint to return the saved tokens:

httr::content(httr::GET(tpapp2$url("/locals")))

Now the third-party app can get data on your behalf (the whole goal of OAuth!) --- it could also post data on your behalf if the resource app had endpoints for that.

For example the /data endpoint of the third party app queries the resource app and needs authentication. If you run the following without the OAuth dance, your access is denied. But now it works fine:

resp_data <- httr::GET(tpapp2$url("/data"))
resp_data
httr::content(resp_data, as = "text")

In real life, access by the third-party app might be limited to some scopes, but the fake apps shipped with webfakes do not handle that.

The fake resource server and httr

When you use httr's OAuth tool, there's some gymnastics happening as R is playing the role of a third-party app via httr and httpuv (to listen to the redirect URI).

OAuth2.0 app creation & registration

What's crucial here is setting httr::oauth_callback() as redirect URI, which is what you do when creating an app for an R package that uses OAuth2.0 to authenticate to a resource server.

#| label: httr
url3 <- paste0(
  regi_url,
  "?name=3P%20app2",
  "&redirect_uri=", httr::oauth_callback()
)
reg_resp3 <- httr::GET(url3)
reg_resp3
regdata3 <- httr::content(reg_resp3)
regdata3

Now we set the registration data on the third-party app.

#| label: httr-dance
app <- httr::oauth_app(
  "3P app2",
  key = regdata3$client_id[[1]],
  secret = regdata3$client_secret[[1]],
  redirect_uri = httr::oauth_callback()
)

endpoint <- httr::oauth_endpoint(
  authorize = auth_url,
  access = toke_url
)

Now we can launch the token creation.

#| label: httr-dance2
token <- oauth2_httr_login(
  httr::oauth2.0_token(endpoint, app, cache = FALSE)
)
#| label: refresh
token

Without the token, the query to the resource server fails:

httr::GET(rsapp$url("/data"))

With the token, it is successful. httr also automatically refreshes the token if needed.

httr::content(
  httr::GET(rsapp$url("/data"), config = token),
  as = "text"
)

Advanced topics

Applications

With these apps, or only the resource server app, you can now test your code that helps users create and store an OAuth2.0 token.

Like all webfakes apps, OAuth2.0 apps are extensible: you can add your own endpoints and middleware to it. E.g. here we add logging via mw_log() and a new endpoint.

rsapp2 <- oauth2_resource_app(
  refresh_duration = .Machine$integer.max,
  access_duration = 10L
)
logfile <- tempfile("oauth-rs-", fileext = ".log")
rsapp2$use(mw_log(stream = logfile), .first = TRUE)
rsapp2$get("/docs", function(req, res) {
  res$
    set_status(200L)$
    send("See vignette('oauth', package = 'webfakes')")
})

rsapp2_process <- new_app_process(
  rsapp2,
  opts = server_opts(num_threads = 3)
)

If you want to customize one of the apps or both apps a lot, it might make sense to use their source code as starting point or inspiration.

Debugging

See the usual debugging advice for webfakes apps. In particular, you can add the mw_log() middleware to write the log of the app to a file, like we did above.

The resource app has a /locals endpoint, that returns all data stored in the app, this includes the tokens and the refresh tokens:

httr::content(
  httr::GET(rsapp$url("/locals"))
)

Case study for OAuth2.0 testing

Consider a package that has a function that uses OAuth2.0 to access GitHub. In this section we'll show how you can use webfakes to test this function.

gh_base <- function() {
  Sys.getenv("FAKE_GH_API_BASE", "https://api.github.com")
}
gh_oauth_base <- function() {
  Sys.getenv(
    "FAKE_GH_AUTH_BASE",
    "https://github.com/login/oauth"
  )
}
gh_repos <- function() {
  ghapp <- httr::oauth_app(
    "gh_repos",
    key = Sys.getenv("GH_CLIENT_ID"),
    secret = Sys.getenv("GH_CLIENT_SECRET")
  )
  endpoints <- httr::oauth_endpoint(
    base_url = gh_oauth_base(),
    request = NULL,
    authorize = "authorize",
    access = "access_token"
  )
  gh_token <- httr::oauth2.0_token(
    endpoints,
    ghapp,
    cache = FALSE
  )
  httr_token <- httr::config(token = gh_token)
  response <- httr::GET(
    paste0(gh_base(), "/user/repos?visibility=public"),
    httr::add_headers(Accept = "application/vnd.github.v3+json"),
    config = httr_token
  )
  httr::stop_for_status(response)
  json <- httr::content(response, as = "text")
  repos <- jsonlite::fromJSON(json, simplifyVector = FALSE)
  vapply(repos, function(r) r$full_name, character(1))
}

gh_repos() uses an OAuth2.0 app to get a token from GitHub, and then uses that token to authenticate and list the public repositories of the current user. In a real package you would probably get the token in a separate function, cache it, and re-use it for multiple queries. (Also, you don't actually need authorization for listing public repositories, so this is a somewhat artificial example.)

To run this function, you would need to register an app at https://github.com/settings/developers. Make sure that you set http://localhost:1410 as the authorization callback URL. You can set the other options as you please. Then in R set the GH_CLIENT_ID and GH_CLIENT_SECRET environment variables to the client id and client secret of the app:

Sys.setenv(GH_CLIENT_ID = "<your client id here>")
Sys.setenv(GH_CLIENT_SECRET = "<your client secret here>")
#| echo: false
#| include: false
tryCatch({
  Sys.setenv(GH_CLIENT_ID = "283f205145036793ba0b")
  Sys.setenv(
    GH_CLIENT_SECRET = keyring::key_get("WEBFAKES_CLIENT_SECRET"))
}, error = function(x) NULL)

When you run this function it opens a Window in your browser, where you can authorize the app to access your public information on GitHub. For the subsequent runs that browser window still opens, but the authorization is automatic. In a real package you could cache the OAuth2.0 tokens on the machine, e.g. using the keyring package.

#| eval: false
gh_repos()
#| echo: false
#| eval: true
# Ideally we would only run this when we don't have a real
# secret, but httr's OAuth does not work well in non-interactive
# sessions.
message('Waiting for authentication in browser...')
message('Press Esc/Ctrl + C to abort')
message('Authentication complete.')
print(c(
  "gaborcsardi/altlist", "gaborcsardi/argufy",
  "gaborcsardi/async", "gaborcsardi/disposables",
  "gaborcsardi/dotenv", "gaborcsardi/falsy",
  "gaborcsardi/franc", "gaborcsardi/ISA",
  "gaborcsardi/keypress", "gaborcsardi/lpSolve",
  "gaborcsardi/macBriain", "gaborcsardi/maxygen",
  "gaborcsardi/MISO", "gaborcsardi/msgtools",
  "gaborcsardi/notifier", "gaborcsardi/odbc",
  "gaborcsardi/parr", "gaborcsardi/parsedate",
  "gaborcsardi/prompt", "gaborcsardi/r-font",
  "gaborcsardi/r-source", "gaborcsardi/rcorpora",
  "gaborcsardi/roxygenlabs", "gaborcsardi/sankey",
  "gaborcsardi/secret", "gaborcsardi/spark",
  "gaborcsardi/standalones"
))

Let's write a test case now for gh_repos(). We will use oauth2_repource_app() to fake GitHub.

testthat::test_that("gh_repos", {
  testthat::skip_on_cran()
  fake_app <- oauth2_resource_app(token_endpoint = "/access_token")
  fake_app$get("/user/repos", function(req, res) {
    if (!app$is_authorized(req, res)) return()
    res$send_json(list(
      list(full_name = "user/repo1"),
      list(full_name = "user/repo2")
    ), auto_unbox = TRUE)
  })

  fake_proc <- local_app_process(
    fake_app,
    opts = server_opts(num_threads = 3)
  )

  # register the app to our fake GH server
  reg_url <- paste0(
    fake_proc$url("/register"),
    "?name=gh_repos&redirect_uri=http://localhost:1410/"
  )
  regdata <- httr::content(httr::GET(reg_url))
  withr::local_envvar(
    GH_CLIENT_ID = regdata$client_id[[1]],
    GH_CLIENT_SECRET = regdata$client_secret[[1]],
    FAKE_GH_API_BASE = fake_proc$url(),
    FAKE_GH_AUTH_BASE = fake_proc$url()
  )

  ret <- suppressMessages(webfakes::oauth2_httr_login(
    gh_repos()
  ))
  testthat::expect_equal(ret, c("user/repo1", "user/repo2"))
})

Some important points about this test case:

This test case ensures that the OAuth2.0 setup in gh_repos() stays correct.



gaborcsardi/presser documentation built on June 13, 2025, 2:54 p.m.