tests/testthat/test-annotation-request.R

In plumber2: Easy and Powerful Web Servers

test_that("docs get generated correctly", {
  pa <- api("annotations/request_handlers.R")
  doc <- private(pa, "OPENAPI")
  expect_named(
    doc$paths,
    c("/hello/{test}/", "/hello/", "/plot/", "/type/{param}/")
  )
  expect_equal(doc$paths[[1]]$get$summary, "A get endpoint")
  expect_equal(
    doc$paths[[1]]$get$description,
    "description\n\nmore description"
  )
  expect_equal(doc$paths[[1]]$get$operationId, "/hello/{test}/-get")
  expect_equal(doc$paths[[1]]$get$tags, list("my_tag"))

  # Parameters
  expect_length(doc$paths[[1]]$get$parameters, 3)
  expect_equal(doc$paths[[1]]$get$parameters[[1]]$name, "test")
  expect_equal(doc$paths[[1]]$get$parameters[[1]]$`in`, "path")
  expect_equal(doc$paths[[1]]$get$parameters[[1]]$description, "test")
  expect_true(doc$paths[[1]]$get$parameters[[1]]$required)
  expect_equal(doc$paths[[1]]$get$parameters[[1]]$schema, list(type = "string"))
  expect_equal(doc$paths[[1]]$get$parameters[[1]]$style, "simple")
  expect_equal(doc$paths[[1]]$get$parameters[[2]]$name, "test2")
  expect_equal(doc$paths[[1]]$get$parameters[[2]]$`in`, "query")
  expect_equal(doc$paths[[1]]$get$parameters[[2]]$description, "test2 and more")
  expect_false(doc$paths[[1]]$get$parameters[[2]]$required)
  expect_equal(
    doc$paths[[1]]$get$parameters[[2]]$schema,
    list(type = "array", items = list(type = "integer"))
  )
  expect_equal(doc$paths[[1]]$get$parameters[[2]]$style, "form")
  expect_equal(doc$paths[[1]]$get$parameters[[3]]$name, "test3")
  expect_equal(doc$paths[[1]]$get$parameters[[3]]$`in`, "query")
  expect_equal(doc$paths[[1]]$get$parameters[[3]]$description, "test3")
  expect_true(doc$paths[[1]]$get$parameters[[3]]$required)
  expect_equal(doc$paths[[1]]$get$parameters[[3]]$schema, list(type = "number"))
  expect_equal(doc$paths[[1]]$get$parameters[[3]]$style, "form")

  # Response
  expect_equal(doc$paths[[1]]$get$responses$`200`$description, "test4")
  expect_equal(doc$paths[[1]]$get$responses$`404`$description, "test5")
  expect_named(
    doc$paths[[1]]$get$responses$`200`$content,
    c(
      "text/csv",
      "application/json",
      "text/html",
      "application/rds",
      "text/tab-separated-values",
      "text/xml",
      "text/plain",
      "text/yaml"
    )
  )
  expect_equal(
    doc$paths[[1]]$get$responses$`200`$content[[1]]$schema,
    list(
      type = "object",
      properties = list(
        mpg = list(type = "array", items = list(type = "number")),
        cyl = list(type = "array", items = list(type = "integer")),
        disp = list(type = "array", items = list(type = "number"))
      ),
      required = character()
    )
  )

  # body
  expect_true(all(
    names(doc$paths[[2]]$post$requestBody$content) %in%
      c(registry$parsers$json$types, registry$parsers$yaml$types)
  ))
  expect_equal(
    doc$paths[[2]]$post$requestBody$content[[1]]$schema,
    list(
      type = "object",
      properties = list(
        test = list(
          type = "integer",
          description = "an integer"
        ),
        test2 = list(
          type = "array",
          items = list(type = "string"),
          description = "an array of strings"
        )
      )
    )
  )
  expect_equal(
    doc$paths[[4]]$post$parameters[[1]],
    list(
      name = "param",
      `in` = "path",
      description = "",
      required = TRUE,
      schema = list(type = "string", enum = c("a", "b", "c")),
      style = "simple"
    )
  )
  expect_equal(
    doc$paths[[4]]$post$parameters[[2]],
    list(
      name = "required",
      `in` = "query",
      description = "",
      required = TRUE,
      schema = list(type = "string"),
      style = "form"
    )
  )
  expect_equal(
    doc$paths[[4]]$post$parameters[[3]],
    list(
      name = "range",
      `in` = "query",
      description = "",
      required = FALSE,
      schema = list(type = "integer", minimum = 2, maximum = 9),
      style = "form"
    )
  )
  expect_equal(
    doc$paths[[4]]$post$parameters[[4]],
    list(
      name = "default",
      `in` = "query",
      description = "",
      required = FALSE,
      schema = list(
        type = "string",
        default = "test"
      ),
      style = "form"
    )
  )
  expect_equal(
    doc$paths[[4]]$post$parameters[[5]],
    list(
      name = "array",
      `in` = "query",
      description = "",
      required = FALSE,
      schema = list(type = "array", items = list(type = "string")),
      style = "form"
    )
  )
  expect_equal(
    doc$paths[[4]]$post$parameters[[6]],
    list(
      name = "regex",
      `in` = "query",
      description = "",
      required = FALSE,
      schema = list(type = "string", pattern = "\\d-\\d{2}"),
      style = "form"
    )
  )

  expect_equal(
    doc$paths[[4]]$post$requestBody$content[[1]]$schema,
    list(
      type = "object",
      properties = list(
        upper = list(
          type = "number",
          maximum = 10,
          default = 5,
          description = ""
        ),
        today = list(type = "string", format = "date", description = ""),
        now = list(type = "string", format = "date-time", description = ""),
        data = list(type = "string", format = "byte", description = ""),
        bin = list(type = "string", format = "binary", description = ""),
        flag = list(type = "boolean", description = "")
      )
    )
  )
})

test_that("handlers gets constructed correctly", {
  pa <- api("annotations/request_handlers.R")
  pa |> api_logger(function(event, message, request, ...) NULL)

  req <- fiery::fake_request("http://127.0.0.1:8080/hello/you")
  res <- pa$test_request(req)

  expect_equal(res$status, 200L)
  expect_equal(
    res$headers$`content-disposition`,
    "attachment; filename=\"testfile\""
  )
  expect_equal(res$headers$`content-type`, "text/csv")
  expect_equal(res$body, readr::format_csv(mtcars[, 1:3], col_names = FALSE))

  req <- fiery::fake_request(
    "http://127.0.0.1:8080/hello/you",
    headers = list("Accept" = "application/dart")
  )
  res <- pa$test_request(req)
  expect_equal(res$status, 406L)
  expect_equal(res$headers$`content-type`, "application/problem+json")
  expect_equal(
    jsonlite::fromJSON(res$body)$detail,
    "Only text/csv, application/json, text/html, application/rds, text/tab-separated-values, text/xml, text/plain, or text/yaml content types supported."
  )

  good_body <- list(test = 2, test2 = letters[1:4])
  bad_body <- list(test = "fail", test2 = letters[1:4])

  req <- fiery::fake_request(
    "http://127.0.0.1:8080/hello/",
    "post",
    content = jsonlite::toJSON(good_body),
    headers = list("Content_Type" = "application/json")
  )
  res <- pa$test_request(req)
  expect_equal(res$headers$`content-type`, "application/json")
  expect_equal(res$body, unclass(jsonlite::toJSON(good_body)))

  req <- fiery::fake_request(
    "http://127.0.0.1:8080/hello/",
    "post",
    content = jsonlite::toJSON(bad_body),
    headers = list("Content_Type" = "application/json")
  )
  res <- pa$test_request(req)
  expect_equal(res$status, 400L)
  expect_equal(res$headers$`content-type`, "application/problem+json")
  expect_equal(
    jsonlite::fromJSON(res$body)$detail,
    "`test` must match the type {\"type\":\"integer\",\"description\":\"an integer\"}"
  )

  req <- fiery::fake_request("http://127.0.0.1:8080/header/")
  res <- pa$test_header(req)
  expect_equal(res$status, 406L)

  req <- fiery::fake_request("http://127.0.0.1:8080/type/a/", "post")
  res <- pa$test_request(req)
  expect_equal(
    jsonlite::fromJSON(res$body)$detail,
    "`required` is a required query parameter but is missing"
  )

  req <- fiery::fake_request("http://127.0.0.1:8080/type/d/", "post")
  res <- pa$test_request(req)
  expect_equal(
    jsonlite::fromJSON(res$body)$detail,
    "`param` must be one of \"a\", \"b\", or \"c\""
  )

  req <- fiery::fake_request(
    "http://127.0.0.1:8080/type/a/?required=test",
    "post"
  )
  res <- pa$test_request(req)
  expect_equal(
    unserialize(res$body),
    list(
      param = factor("a", levels = c("a", "b", "c")),
      query = list(required = "test", default = "test"),
      body = list(upper = 5)
    )
  )

  req <- fiery::fake_request(
    "http://127.0.0.1:8080/type/a/?required=test&range=1",
    "post"
  )
  res <- pa$test_request(req)
  expect_equal(
    jsonlite::fromJSON(res$body)$detail,
    "`range` must be between 2 and 9"
  )

  req <- fiery::fake_request(
    "http://127.0.0.1:8080/type/a/?required=test&range=3",
    "post"
  )
  res <- pa$test_request(req)
  expect_equal(unserialize(res$body)$query$range, 3L)
  expect_type(unserialize(res$body)$query$range, "integer")

  req <- fiery::fake_request(
    "http://127.0.0.1:8080/type/a/?required=test&array=1&array=2&array=3",
    "post"
  )
  res <- pa$test_request(req)
  expect_equal(unserialize(res$body)$query$array, c("1", "2", "3"))

  req <- fiery::fake_request(
    "http://127.0.0.1:8080/type/a/?required=test&array=1,2,3",
    "post"
  )
  res <- pa$test_request(req)
  expect_equal(unserialize(res$body)$query$array, c("1", "2", "3"))

  req <- fiery::fake_request(
    "http://127.0.0.1:8080/type/a/?required=test&required=1",
    "post"
  )
  res <- pa$test_request(req)
  expect_equal(
    jsonlite::fromJSON(res$body)$detail,
    "`required` must be a scalar value"
  )

  req <- fiery::fake_request(
    "http://127.0.0.1:8080/type/a/?required=test&regex=1",
    "post"
  )
  res <- pa$test_request(req)
  expect_equal(
    jsonlite::fromJSON(res$body)$detail,
    "`regex` must match the pattern \"\\\\d-\\\\d2\""
  )
  req <- fiery::fake_request(
    "http://127.0.0.1:8080/type/a/?required=test&regex=1-23",
    "post"
  )
  res <- pa$test_request(req)
  expect_equal(unserialize(res$body)$query$regex, "1-23")

  expect_equal(unserialize(res$body)$body$upper, 5)
  body <- list(
    upper = -7,
    today = "2017-07-21",
    now = "2017-07-21T17:32:28Z",
    data = base64enc::base64encode(serialize(letters, NULL)),
    bin = serialize(LETTERS, NULL),
    flag = TRUE
  )
  req <- fiery::fake_request(
    "http://127.0.0.1:8080/type/a/?required=test",
    "post",
    content = serialize(body, NULL),
    headers = list("Content_Type" = "application/rds")
  )
  res <- pa$test_request(req)
  expect_equal(unserialize(res$body)$body$upper, -7)
  expect_type(unserialize(res$body)$body$upper, "double")
  expect_equal(unserialize(res$body)$body$today, as.Date("2017-07-21"))
  expect_equal(
    unserialize(res$body)$body$now,
    as.POSIXlt("2017-07-21T17:32:28+0000", format = "%FT%T%z")
  )
  expect_equal(unserialize(unserialize(res$body)$body$data), letters)
  expect_equal(unserialize(unserialize(res$body)$body$bin), LETTERS)
  expect_true(unserialize(res$body)$body$flag)

  req <- fiery::fake_request("http://127.0.0.1:8080/plot/")
  res <- pa$test_request(req)
  expect_true(promises::is.promise(res))
  res <- extract(res)
  expect_true(pa$get_data("async_then"))
  expect_equal(res$status, 200L)
  expect_equal(res$headers$`content-type`, "image/svg+xml")
  svg_file <- tempfile(fileext = ".svg")
  writeLines(rawToChar(res$body), svg_file, sep = "\n")

  skip_on_cran()
  skip_on_os("windows")
  expect_snapshot_file(svg_file, "async_svg")
})