Thanks @meztez to provide me your suggestions, but actually i have find a issue with plumber + future + error message, i can open a github issue if you both prefer.
But I'll quote it below anyway the run_plumer.R and plumber.R
run_plumber.R
library(plumber)
library(mapview)
library(raster)
library(plainview)
httpStatus <- function(code) {
descriptions <- list(
"100" = "Continue",
"101" = "Switching Protocols",
"200" = "OK",
"201" = "Created",
"202" = "Accepted",
"203" = "Non-Authoritative Information",
"204" = "No Content",
"205" = "Reset Content",
"206" = "Partial Content",
"300" = "Multiple Choices",
"301" = "Moved Permanently",
"302" = "Found",
"303" = "See Other",
"304" = "Not Modified",
"305" = "Use Proxy",
"307" = "Temporary Redirect",
"400" = "Bad Request",
"401" = "Unauthorized",
"402" = "Payment Required",
"403" = "Forbidden",
"404" = "Not Found",
"405" = "Method Not Allowed",
"406" = "Not Acceptable",
"407" = "Proxy Authentication Required",
"408" = "Request Timeout",
"409" = "Conflict",
"410" = "Gone",
"411" = "Length Required",
"412" = "Precondition Failed",
"413" = "Request Entity Too Large",
"414" = "Request-URI Too Long",
"415" = "Unsupported Media Type",
"416" = "Requested Range Not Satisifable",
"417" = "Expectation Failed",
"500" = "Internal Server Error",
"501" = "Not Implemented",
"502" = "Bad Gateway",
"503" = "Service Unavailable",
"504" = "Gateway Timeout",
"505" = "HTTP Version Not Supported"
)
description <- descriptions[[as.character(code)]]
if (is.null(description)) {
description <- "Dunno"
}
paste(code, description, sep = " - ")
}
errorHandler <- function(req, res, err) {
errmsg <- as.character(err)
li <- list()
res[["serializer"]] <- serializer_unboxed_json()
if (res[["status"]] == 200L) {
res[["status"]] <- 500L
li[["error"]] <- httpStatus(500L)
if (!is.null(status <- attr(err[["message"]], "status"))) {
res[["status"]] <- status
li[["error"]] <- httpStatus(status)
}
} else {
li[["error"]] <- httpStatus(500L)
}
if (is.function(req[["pr"]][["getDebug"]]) && isTRUE(req[["pr"]][["getDebug"]]())) {
li["message"] <- errmsg
}
return(li)
}
#* @apiTitle API Error Handler
#* @apiTOS https://www.automaticfarmsolution.com/
#* @apiVersion 1.0.1
options("plumber.port" = 3000)
#* @plumber
function(pr) {
pr %>%
pr_set_error(errorHandler) %>%
plumber::pr_set_docs("swagger") %>%
pr_mount("/try", plumb("./plumber.R"))
}
plumber.R
#* @tag TryErrorHandling
#* This endpoint allow to automatically get a leaflet Html widget where inside it is rendered the colored Vegetation Index and its legend.
#* @param apikey:string The apikey
#* @param basemap:string Could be set as all or one
#* @post /TryErrorHandling
#* @serializer htmlwidget
function(res, req, apikey, basemap) {
future::future({
# check if the api key is correct
checkapi<-apikey=="123456"
if (checkapi==TRUE) {
# the api key is correct
# check if all the API parameter are provided in the request
Check_request<-data.frame(req$args)
check<-c("apikey", "basemap") %in% colnames(Check_request)
has_false <- any(!check)
if (has_false==TRUE) {
missing_msgs <- c("apikey", "basemap")[!check]
res$status<-400
res$body<-paste("The following API parameters were not provided:", paste(missing_msgs, collapse = ", "), "\n")
print(res$body)
return(res)
} else {
}
# check if the basemap API parameter is set all or one
basemap_to_check<-c("all", "one")
if (basemap %in% basemap_to_check) {
} else {
res$status<-400
res$body<-"You have setted a wrong vegetation index. Must be one of ndvi, evi2, msavi2, ipvi, msr, osavi, savi, tdvi, gari, arvi, evi, gci, gndvi, gosavi, grvi, nnir, gsavi, vdvi, wdrvi"
print(res$body)
return(res)
}
# define the type of the map
if (basemap=="all") {
my_map<-mapview::mapview(poppendorf[[5]],
legend = TRUE,
map.types=c("OpenTopoMap",
"CartoDB.Positron",
"CartoDB.DarkMatter",
"OpenStreetMap",
"Esri.WorldImagery"))
} else {
my_map<-mapview::mapview(poppendorf[[5]],
legend = TRUE,
map.types="Esri.WorldImagery")
}
my_map@map
} else {
# the api key is not correct
res$status <- 400
res$body <- message = "Your account does not have permission to use this endpoint"
print(res$body)
return(res)
}
})
}
The problem is that when i am using this url http://127.0.0.1:3000/try/TryErrorHandling?apikey=123456 that miss the basemap parameter, i am getting the follow error output in postman
{
"error": "500 - Internal server error",
"message": "Error in get(name, envir = env, inherits = FALSE): Identified global objects via static code inspection ({; checkapi <- apikey == \"123456\"; if (checkapi == TRUE) {; Check_request <- data.frame(req$args); check <- c(\"apikey\", \"basemap\") %in% colnames(Check_request); has_false <- any(!check); ...; return(res); }; }). argument \"basemap\" is missing, with no default\n"
}
while when I comment the future function (the code below) I have the following output in postman with the same url of request.
The following API parameters were not provided: basemap
#* @tag TryErrorHandling
#* This endpoint allow to automatically get a leaflet Html widget where inside it is rendered the colored Vegetation Index and its legend.
#* @param apikey:string The apikey
#* @param basemap:string Could be set as all or one
#* @post /TryErrorHandling
#* @serializer htmlwidget
function(res, req, apikey, basemap) {
#future::future({
# check if the api key is correct
checkapi<-apikey=="123456"
if (checkapi==TRUE) {
# the api key is correct
# check if all the API parameter are provided in the request
Check_request<-data.frame(req$args)
check<-c("apikey", "basemap") %in% colnames(Check_request)
has_false <- any(!check)
if (has_false==TRUE) {
missing_msgs <- c("apikey", "basemap")[!check]
res$status<-400
res$body<-paste("The following API parameters were not provided:", paste(missing_msgs, collapse = ", "), "\n")
print(res$body)
return(res)
} else {
}
# check if the basemap API parameter is set all or one
basemap_to_check<-c("all", "one")
if (basemap %in% basemap_to_check) {
} else {
res$status<-400
res$body<-"You have setted a wrong vegetation index. Must be one of ndvi, evi2, msavi2, ipvi, msr, osavi, savi, tdvi, gari, arvi, evi, gci, gndvi, gosavi, grvi, nnir, gsavi, vdvi, wdrvi"
print(res$body)
return(res)
}
# define the type of the map
if (basemap=="all") {
my_map<-mapview::mapview(poppendorf[[5]],
legend = TRUE,
map.types=c("OpenTopoMap",
"CartoDB.Positron",
"CartoDB.DarkMatter",
"OpenStreetMap",
"Esri.WorldImagery"))
} else {
my_map<-mapview::mapview(poppendorf[[5]],
legend = TRUE,
map.types="Esri.WorldImagery")
}
my_map@map
} else {
# the api key is not correct
res$status <- 400
res$body <- message = "Your account does not have permission to use this endpoint"
print(res$body)
return(res)
}
#})
}
Is this a issue/bug or am i doing something wrong?