tests/testthat/test-endpoint.R

In plumber: An API Generator for R

context("Endpoints")

test_that("Endpoints execute in their environment", {
  env <- new.env()
  assign("a", 5, envir=env)

  foo <- parse(text="foo <- function(){ a }")

  r <- PlumberEndpoint$new('verb', 'path', foo, env, 1:2)
  expect_equal(r$exec(req = list(), res = 2), 5)
})

test_that("Missing lines are ok", {
  expect_silent({
    PlumberEndpoint$new('verb', 'path', { function() { 1 }}, new.env(parent = globalenv()))
  })
})

test_that("Endpoints are exec'able with named arguments.", {
  foo <- parse(text="foo <- function(x){ x + 1 }")
  r <- PlumberEndpoint$new('verb', 'path', foo, new.env(parent = globalenv()))
  expect_equal(r$exec(req = list(args = list(x = 3)), res = 20), 4)
})

test_that("Unnamed arguments do not throw an error", {
  foo <- parse(text="foo <- function(){ -1 }")
  r <- PlumberEndpoint$new('verb', 'path', foo, new.env(parent = globalenv()))
  expect_equal(r$exec(req = list(args = list(3)), res = 100), -1)

  foo <- parse(text="foo <- function(req, res, x, ...){ x + sum(1, ...) }")
  r <- PlumberEndpoint$new('verb', 'path', foo, new.env(parent = globalenv()))
  expect_equal(r$exec(req = list(args = list(x = 3, 1)), res = 100), 5)
})

test_that("Ellipses allow any named args through", {
  foo <- parse(text="function(req, res, ...){ sum(unlist(list(...))) }")
  r <- PlumberEndpoint$new('verb', 'path', foo, new.env(parent = globalenv()))
  expect_equal(r$exec(req = list(args = list(a=1, b=2, c=3)), res = 20), 6)

  for ( txt in c(
      "", # with no req or res formals
      "req, res, "
  )) {
    foo <- parse(text=paste0("function(", txt, "...){ ret <- list(...); ret[!names(ret) %in% c('req', 'res')] }"))
    r <- PlumberEndpoint$new('verb', 'path', foo, new.env(parent = globalenv()))
    expect_equal(r$exec(req = list(args = list(a="aa", b="ba")), res = 2), list(a="aa", b="ba"))
    expect_equal(r$exec(req = list(args = list(a="aa1", a="aa2", b = "ba")), res = 2), list(a="aa1", a="aa2", b = "ba"))

    foo <- parse(text=paste0("function(", txt, "a, ...){ ret <- list(a = a, ...); ret[!names(ret) %in% c('req', 'res')] }"))
    r <- PlumberEndpoint$new('verb', 'path', foo, new.env(parent = globalenv()))
    expect_equal(r$exec(req = list(args = list(a="aa1", a="aa2", b = "ba")), res = 2), list(a = "aa1", b = "ba"))
  }
})

test_that("If only req and res are defined, duplicated arguments do not throw an error", {
  full_req <- list(args = list(req = 1, req = 2, res = 3, res = 4))
  full_res <- list(args = list(res = 1, res = 2, res = 3, res = 4))
  foo <- parse(text="function(req){ req }")
  r <- PlumberEndpoint$new('verb', 'path', foo, new.env(parent = globalenv()))
  expect_equal(r$exec(req = full_req, res = full_res), full_req)

  foo <- parse(text="function(res){ res }")
  r <- PlumberEndpoint$new('verb', 'path', foo, new.env(parent = globalenv()))
  expect_equal(r$exec(req = full_req, res = full_res), full_res)

  foo <- parse(text="function(req, res){ list(req, res) }")
  r <- PlumberEndpoint$new('verb', 'path', foo, new.env(parent = globalenv()))
  expect_equal(r$exec(req = full_req, res = full_res), list(full_req, full_res))

  foo <- parse(text="function(req, res, ...){ list(req, res, ...) }")
  r <- PlumberEndpoint$new('verb', 'path', foo, new.env(parent = globalenv()))
  expect_equal(r$exec(req = full_req, res = full_res), list(full_req, full_res))
})

test_that("Programmatic endpoints work", {
  r <- Plumber$new()

  serializer <- "ser"
  expr <- expression(function(req, res){res$setHeader("expr", TRUE)})

  r$handle("GET", "/", expr, "queryString", serializer)
  expect_equal(length(r$endpoints), 1)

  end <- r$endpoints[[1]][[1]]
  expect_equal(end$verbs, "GET")
  expect_equal(end$path, "/")
  expect_equal(names(r$endpoints)[1], "queryString")
  expect_equal(end$serializer, serializer)

  res <- PlumberResponse$new()
  req <- list()
  end$exec(req=req, res=res)

  h <- res$headers
  expect_true(h$expr)
})

test_that("Programmatic endpoints with functions work", {
  r <- Plumber$new()

  expr <- function(req, res){res$setHeader("expr", TRUE)}

  r$handle("GET", "/", expr)
  expect_equal(length(r$endpoints), 1)

  end <- r$endpoints[[1]][[1]]
  expect_equal(end$verbs, "GET")
  expect_equal(end$path, "/")

  res <- PlumberResponse$new()
  req <- list()
  end$exec(req=req, res=res)

  h <- res$headers
  expect_true(h$expr)
})

test_that("Path rewrites correctly", {
  foo_pr <- pr() %>%
    pr_get("/foo", function() "foo")

  foo <- foo_pr$endpoints[[1]][[1]]

  expect_true("foo" %in% names(foo_pr$routes))
  expect_true(foo$matchesPath("/foo"))
  expect_false(foo$matchesPath("/bar"))

  foo$setPath("bar")

  expect_false("foo" %in% names(foo_pr$routes))
  expect_false(foo$matchesPath("/foo"))
  expect_true(foo$matchesPath("/bar"))
})