tests/testthat/test-guard_oauth2.R

In fireproof: Authentication and Authorization for 'fiery' Servers

test_that("guard_oauth2 can be constructed with authorization_code grant", {
  auth <- guard_oauth2(
    token_url = "https://example.com/oauth/token",
    redirect_url = "https://myapp.com/auth/callback",
    client_id = "my_client_id",
    client_secret = "my_client_secret",
    auth_url = "https://example.com/oauth/authorize",
    grant_type = "authorization_code",
    oauth_scopes = c("read", "write"),
    user_info = function(token_info) {
      new_user_info(
        provider = "example",
        name_given = "Test User"
      )
    },
    name = "test"
  )

  expect_equal(
    auth$open_api,
    list(
      type = "oauth2",
      flows = list(
        authorizationCode = list(
          authorizationUrl = "https://example.com/oauth/authorize",
          tokenUrl = "https://example.com/oauth/token",
          refreshUrl = "https://example.com/oauth/token",
          scopes = c(read = "", write = "")
        )
      )
    )
  )
})

test_that("guard_oauth2 can be constructed with password grant", {
  auth <- guard_oauth2(
    token_url = "https://example.com/oauth/token",
    redirect_url = "https://myapp.com/auth/callback",
    client_id = "my_client_id",
    client_secret = "my_client_secret",
    grant_type = "password",
    oauth_scopes = c("read"),
    name = "password_test"
  )

  expect_equal(
    auth$open_api,
    list(
      type = "oauth2",
      flows = list(
        password = list(
          tokenUrl = "https://example.com/oauth/token",
          refreshUrl = "https://example.com/oauth/token",
          scopes = c(read = "")
        )
      )
    )
  )
})

test_that("guard_oauth2 check_request validates session info", {
  auth <- guard_oauth2(
    token_url = "https://example.com/oauth/token",
    redirect_url = "https://myapp.com/auth/callback",
    client_id = "my_client_id",
    client_secret = "my_client_secret",
    auth_url = "https://example.com/oauth/authorize",
    grant_type = "authorization_code",
    name = "test"
  )

  datastore <- new.env()
  no_auth <- reqres::Request$new(fiery::fake_request("http://example.com"))

  pass <- auth$check_request(
    request = no_auth,
    response = no_auth$respond(),
    keys = list(),
    .datastore = datastore
  )
  expect_false(pass)
  expect_null(datastore$session$fireproof$test)

  # Simulate authenticated session
  datastore$session$fireproof$test <- new_user_info(
    provider = "example",
    id = "user123",
    scopes = c("read")
  )

  pass <- auth$check_request(
    request = no_auth,
    response = no_auth$respond(),
    keys = list(),
    .datastore = datastore
  )
  expect_true(pass)
})

test_that("guard_oauth2 reject_response clears failed session", {
  auth <- guard_oauth2(
    token_url = "https://example.com/oauth/token",
    redirect_url = "https://myapp.com/auth/callback",
    client_id = "my_client_id",
    client_secret = "my_client_secret",
    auth_url = "https://example.com/oauth/authorize",
    grant_type = "authorization_code",
    name = "test"
  )

  datastore <- new.env()
  datastore$session$fireproof$test <- new_user_info(
    provider = "example",
    id = "user123"
  )

  no_auth <- reqres::Request$new(fiery::fake_request("http://example.com"))

  auth$reject_response(no_auth$respond(), scope = NULL, .datastore = datastore)
  expect_equal(no_auth$response$status, 403L)
  expect_null(datastore$session$fireproof$test)
})

test_that("guard_oauth2 reject_response initiates authorization for authorization_code", {
  auth <- guard_oauth2(
    token_url = "https://example.com/oauth/token",
    redirect_url = "https://myapp.com/auth/callback",
    client_id = "my_client_id",
    client_secret = "my_client_secret",
    auth_url = "https://example.com/oauth/authorize",
    grant_type = "authorization_code",
    oauth_scopes = c("read", "write"),
    name = "test"
  )

  datastore <- new.env()
  no_auth <- reqres::Request$new(fiery::fake_request(
    "http://example.com/api/data"
  ))

  auth$reject_response(no_auth$respond(), scope = NULL, .datastore = datastore)
  expect_equal(no_auth$response$status, 303L)
  location <- no_auth$response$get_header("location")
  expect_true(grepl("^https://example.com/oauth/authorize", location))
  expect_true(grepl("client_id=my_client_id", location))
  expect_true(grepl(
    paste0("state=", datastore$session$fireproof$oauth_state$state),
    location,
    fixed = TRUE
  ))
  expect_true(grepl("redirect_uri=", location))
  expect_true(grepl("code_challenge=", location))
  expect_true(grepl("code_challenge_method=S256", location))
})

test_that("guard_oauth2 custom redirect_path can be set", {
  auth <- guard_oauth2(
    token_url = "https://example.com/oauth/token",
    redirect_url = "https://myapp.com/auth/callback",
    client_id = "my_client_id",
    client_secret = "my_client_secret",
    auth_url = "https://example.com/oauth/authorize",
    grant_type = "authorization_code",
    redirect_path = "/custom/oauth/path",
    name = "test"
  )

  expect_equal("/custom/oauth/path", auth$.__enclos_env__$private$REDIRECT_PATH)
})

test_that("guard_oauth2 service_params are included in auth URL", {
  auth <- guard_oauth2(
    token_url = "https://example.com/oauth/token",
    redirect_url = "https://myapp.com/auth/callback",
    client_id = "my_client_id",
    client_secret = "my_client_secret",
    auth_url = "https://example.com/oauth/authorize",
    grant_type = "authorization_code",
    service_params = list(
      prompt = "consent",
      access_type = "offline"
    ),
    name = "test"
  )

  datastore <- new.env()
  no_auth <- reqres::Request$new(fiery::fake_request("http://example.com"))

  auth$reject_response(no_auth$respond(), scope = NULL, .datastore = datastore)
  location <- no_auth$response$get_header("location")
  expect_true(grepl("prompt=consent", location))
  expect_true(grepl("access_type=offline", location))
})

test_that("guard_oauth2 requires auth_url for authorization_code grant", {
  expect_snapshot(
    guard_oauth2(
      token_url = "https://example.com/oauth/token",
      redirect_url = "https://myapp.com/auth/callback",
      client_id = "my_client_id",
      client_secret = "my_client_secret",
      grant_type = "authorization_code",
      name = "test"
    ),
    error = TRUE
  )
})

test_that("guard_oauth2 does not require auth_url for password grant", {
  expect_no_error(
    guard_oauth2(
      token_url = "https://example.com/oauth/token",
      redirect_url = "https://myapp.com/auth/callback",
      client_id = "my_client_id",
      client_secret = "my_client_secret",
      grant_type = "password",
      name = "test"
    )
  )
})

test_that("guard_oauth2 reject_response for password grant requests basic auth", {
  auth <- guard_oauth2(
    token_url = "https://example.com/oauth/token",
    redirect_url = "https://myapp.com/auth/callback",
    client_id = "my_client_id",
    client_secret = "my_client_secret",
    grant_type = "password",
    name = "test"
  )

  datastore <- new.env()
  no_auth <- reqres::Request$new(fiery::fake_request("http://example.com"))

  expect_snapshot(
    auth$reject_response(
      no_auth$respond(),
      scope = NULL,
      .datastore = datastore
    ),
    error = TRUE
  )
})

test_that("guard_oauth2 respects existing response status on rejection", {
  auth <- guard_oauth2(
    token_url = "https://example.com/oauth/token",
    redirect_url = "https://myapp.com/auth/callback",
    client_id = "my_client_id",
    client_secret = "my_client_secret",
    auth_url = "https://example.com/oauth/authorize",
    grant_type = "authorization_code",
    name = "test"
  )

  datastore <- new.env()
  datastore$session$fireproof$test <- new_user_info(provider = "example")

  no_auth <- reqres::Request$new(fiery::fake_request("http://example.com"))
  response <- no_auth$respond()
  response$status <- 500L

  auth$reject_response(response, scope = NULL, .datastore = datastore)
  # Should still process rejection even with non-default status
  expect_null(datastore$session$fireproof$test)
})

test_that("guard_oauth2 register_handler adds redirect endpoint", {
  auth <- guard_oauth2(
    token_url = "https://example.com/oauth/token",
    redirect_url = "https://myapp.com/auth/callback",
    client_id = "my_client_id",
    client_secret = "my_client_secret",
    auth_url = "https://example.com/oauth/authorize",
    grant_type = "authorization_code",
    redirect_path = "/auth/callback",
    name = "test"
  )

  handlers_added <- list()
  mock_add_handler <- function(method, path, handler) {
    handlers_added[[length(handlers_added) + 1]] <<- list(
      method = method,
      path = path,
      handler = handler
    )
  }

  auth$register_handler(mock_add_handler)

  expect_equal(length(handlers_added), 2)
  expect_equal(handlers_added[[1]]$method, "get")
  expect_equal(handlers_added[[1]]$path, "/auth/callback")
  expect_type(handlers_added[[1]]$handler, "closure")
})

test_that("guard_oauth2 with NULL scopes works", {
  auth <- guard_oauth2(
    token_url = "https://example.com/oauth/token",
    redirect_url = "https://myapp.com/auth/callback",
    client_id = "my_client_id",
    client_secret = "my_client_secret",
    auth_url = "https://example.com/oauth/authorize",
    grant_type = "authorization_code",
    oauth_scopes = NULL,
    name = "test"
  )

  expect_equal(
    auth$open_api$flows$authorizationCode$scopes,
    structure(character(0), names = character(0))
  )
})

test_that("guard_oauth2 forbid_user clears session", {
  auth <- guard_oauth2(
    token_url = "https://example.com/oauth/token",
    redirect_url = "https://myapp.com/auth/callback",
    client_id = "my_client_id",
    client_secret = "my_client_secret",
    auth_url = "https://example.com/oauth/authorize",
    grant_type = "authorization_code",
    name = "test"
  )

  datastore <- new.env()
  datastore$session$fireproof$test <- new_user_info(
    provider = "example",
    id = "user123",
    scopes = c("read")
  )

  good_auth <- reqres::Request$new(fiery::fake_request("http://example.com"))
  auth$forbid_user(good_auth$respond(), .datastore = datastore)
  expect_equal(good_auth$response$status, 403L)
  expect_null(datastore$session$fireproof$test)
})

test_that("guard_oauth2 passes if session already has valid user info", {
  auth <- guard_oauth2(
    token_url = "https://example.com/oauth/token",
    redirect_url = "https://myapp.com/auth/callback",
    client_id = "my_client_id",
    client_secret = "my_client_secret",
    auth_url = "https://example.com/oauth/authorize",
    grant_type = "authorization_code",
    name = "session_test"
  )

  datastore <- new.env()
  # Pre-populate session with user info from previous OAuth authentication
  datastore$session$fireproof$session_test <- new_user_info(
    provider = "github",
    id = "oauth_user789",
    name_given = "OAuth",
    name_family = "User",
    oauth_scopes = c("read:user", "repo"),
    token = list(
      access_token = "oauth_access_token_xyz",
      token_type = "bearer",
      expires_in = 3600,
      refresh_token = "refresh_token_abc",
      timestamp = Sys.time()
    )
  )

  # Request without any authentication (OAuth already happened)
  no_auth <- reqres::Request$new(fiery::fake_request("http://example.com"))

  pass <- auth$check_request(
    request = no_auth,
    response = no_auth$respond(),
    keys = list(),
    .datastore = datastore
  )
  # Should pass because session already has valid OAuth info
  expect_true(pass)
  # Session should remain unchanged
  expect_equal(datastore$session$fireproof$session_test$provider, "github")
  expect_equal(
    datastore$session$fireproof$session_test$token$access_token,
    "oauth_access_token_xyz"
  )
})

test_that("guard_oauth2 handles successful code exchange", {
  skip_on_cran()
  skip_on_ci()

  oauth_service <- webfakes::oauth2_resource_app()
  oauth_process <- webfakes::new_app_process(oauth_service)
  on.exit(oauth_process$stop())

  auth_url <- oauth_process$url("/authorize")
  token_url <- oauth_process$url("/token")

  port <- 60123L
  redirect_url <- paste0("http://127.0.0.1:", port, "/auth")
  register_url <- oauth_process$url(
    "/register",
    list(
      name = "oauth_test",
      redirect_uri = redirect_url
    )
  )
  registration <- curl::curl_fetch_memory(register_url)
  registration <- jsonlite::fromJSON(rawToChar(registration$content))

  r_proc <- callr::r_bg(
    function(port, auth_url, token_url, redirect_url, registration) {
      app <- fiery::Fire$new(port = port)

      auth <- fireproof::guard_oauth2(
        token_url = token_url,
        redirect_url = redirect_url,
        client_id = registration$client_id,
        client_secret = registration$client_secret,
        auth_url = auth_url
      )
      fp <- fireproof::Fireproof$new()
      fp$add_guard(auth, "mock")
      fp$add_auth("all", "/*", mock)

      fs <- firesale::FireSale$new(storr::driver_environment(new.env()))

      app$attach(fs)
      app$attach(fp)

      route <- routr::Route$new()
      route$add_handler("all", "/*", function(request, response, keys, ...) {
        response$status <- 200L
        response$set_header("x-test", request$path)
        TRUE
      })
      app$plugins$request_routr$add_route(route, "main")

      app$ignite()
    },
    args = list(
      port = port,
      auth_url = auth_url,
      token_url = token_url,
      redirect_url = redirect_url,
      registration = registration
    )
  )
  on.exit(r_proc$kill(), add = TRUE)

  test_url <- paste0("http://127.0.0.1:", port, "/")

  Sys.sleep(5)

  first_res <- oauth2_login(test_url)

  expect_equal(first_res$login_response$status_code, 200)
  login_content <- rawToChar(first_res$login_response$content)
  expect_match(
    login_content,
    "<title>Webfakes OAuth 2.0 resource server</title>",
    fixed = TRUE
  )

  expect_equal(first_res$token_response$status_code, 200)
  expect_true(any(grepl(
    "x-test: /",
    curl::parse_headers(first_res$token_response$headers),
    fixed = TRUE
  )))
})