Guess OpenAPI response type from serializer (#684)

Co-authored-by: Bruno Tremblay <bruno.tremblay@lacapitale.com>

NEWS.md

@@ -7,6 +7,8 @@ plumber 1.0.0.9999 Development version
 
 ### New features
 
+* Guess OpenApi response content type from serializer (@meztez #684)
+
 * Passing `edit = TRUE` to `plumb_api()` will open the API source file (#699)
 
 * OpenAPI Specification can be set using a file path. (@meztez #696)

R/openapi-spec.R

@@ -23,7 +23,7 @@ endpointSpecification <- function(routerEndpointEntry, path = routerEndpointEntr
     # If we haven't already documented a path param, we should add it here.
     # FIXME: warning("Undocumented path parameters: ", paste0())
 
-    resps <- responsesSpecification(routerEndpointEntry$responses)
+    resps <- responsesSpecification(routerEndpointEntry)
 
     endptSpec <- list(
       summary = routerEndpointEntry$comments,
@@ -40,15 +40,44 @@ endpointSpecification <- function(routerEndpointEntry, path = routerEndpointEntr
 }
 
 defaultResponse <- list(
+  "200" = list(
+    description = "OK"
+  ),
+  "500" = list(
+    description = "Internal Server Error",
+    content = list("application/json" = list(schema = list(type = "string")))
+  ),
   "default" = list(
     description = "Default response."
   )
 )
-responsesSpecification <- function(resps){
-  if (is.null(resps) || is.na(resps)){
-    resps <- defaultResponse
-  } else if (!("default" %in% names(resps))){
-    resps <- c(resps, defaultResponse)
+responsesSpecification <- function(endpts){
+  if (!inherits(endpts, "PlumberEndpoint")) {
+    return(defaultResponse)
+  }
+  resps <- defaultResponse
+  if (is.list(endpts$responses)){
+    resps <- utils::modifyList(defaultResponse, endpts$responses)
+  }
+  for (resp in names(resps)) {
+    if (!length(resps[[resp]]$content)) {
+      ctype <- NULL
+      if (is.function(endpts$serializer)) {
+        ctype <- formals(endpts$serializer)$type
+        if (is.null(ctype)) {
+          ctype <- tryCatch({
+            get("type", envir =
+                  environment(get("serialize_fn", envir =
+                                    environment(endpts$serializer))))},
+            error = function(e) {NULL})
+        }
+      }
+      if (isTRUE(nchar(ctype) > 0)) {
+        ctype <- stri_split_regex(ctype, "[ ;]")[[1]][1]
+        schema <- list(type = ifelse(grepl("^text", ctype), "string", "object"))
+        resps[[resp]]$content <- setNames(list(list(schema = schema)), ctype)
+      }
+    }
   }
   resps
 }

tests/testthat/test-zzz-openapi.R

@@ -128,11 +128,17 @@ test_that("responsesSpecification works", {
   expect_equal(r, defaultResponse)
 
   # Responses with no default
-  customResps <- list("200" = list())
-  r <- responsesSpecification(customResps)
-  expect_length(r, 2)
+  customResps <- list("400" = list())
+  endpts <- plumber::PlumberEndpoint$new(
+    path = "/a",
+    responses = customResps,
+    verbs = "GET",
+    expr = function() {},
+    envir = new.env(parent = globalenv()))
+  r <- responsesSpecification(endpts)
+  expect_length(r, 4)
   expect_equal(r$default, defaultResponse$default)
-  expect_equal(r$`200`, customResps$`200`)
+  expect_equal(r$`400`, customResps$`400`)
 })
 
 test_that("parametersSpecification works", {
@@ -328,6 +334,15 @@ test_that("no params plumber router still produces spec when there is a func par
   expect_equal(spec$paths$`/sum`$get$parameters[[1]]$name, "num")
 })
 
+test_that("Response content type set with serializer", {
+  a <- pr()
+  pr_get(a, "/json", function() {"OK"}, serializer = serializer_json)
+  pr_get(a, "/csv", function() {"OK"}, serializer = serializer_csv())
+  spec <- a$getApiSpec()
+  expect_equal(spec$paths$`/json`$get$responses$`200`$content, list("application/json" = list(schema = list(type = "object"))))
+  expect_equal(spec$paths$`/csv`$get$responses$`200`$content, list("text/csv" = list(schema = list(type = "string"))))
+})
+
 test_that("Api spec can be set using a file path", {
   pr <- pr() %>% pr_set_api_spec(test_path("files/openapi.yaml"))
   expect_equal(pr$getApiSpec()$paths$`/health-check`$get$summary, " Determine if the API is running and listening as expected")