Logging variables in Plumber - r

I have followed the Rstudio example here for logging for logging requests in Plumber (R API package) and would like to add other variables to the log. However, the registerHooks statement does not recognise global variables (<<-).
# Enable CORS Filtering
#' #filter auth_filter
auth_filter <- function(req, res) {
req_user <<- req$HEADERS['authorization'] %>% as.character()
req_tenant <<- req$HTTP_TENANT
}
pr$registerHooks(
list(
preroute = function() {
# Start timer for log info
tictoc::tic()
},
postroute = function(req, res) {
end <- tictoc::toc(quiet = TRUE)
# Log details about the request and the response
log_info('{convert_empty(req_user)} {convert_empty(req_tenant)} {convert_empty(req$REMOTE_ADDR)} "{convert_empty(req$HTTP_USER_AGENT)}" {convert_empty(req$HTTP_HOST)} {convert_empty(req$REQUEST_METHOD)} {convert_empty(req$PATH_INFO)} {convert_empty(res$status)} {round(end$toc - end$tic, digits = getOption("digits", 5))}')
}))
In the above example, req_user and req_tenant change for every request. The above example gives an error message, stating that req_user and req_tenant do not exist. I have also tried preserialize as an alternative to postroute. How can these variables be logged? The don't need to be global, this was just an additional attempt to solve the problem.

I believe the error is produced because of the convert_empty function not being able to handle null's or na's.
I adjusted this function to handle null's or na's in case they do occur:
convert_empty <- function(string) {
if (is.null(string) || is.na(string) || string == "") {
"-"
} else {
string
}
}
Using the sample plumber.R code that's produced in RStudio, this should work:
#Plumber.R file
library(plumber)
library(logger)
# Specify how logs are written
log_dir <- "logs"
if (!fs::dir_exists(log_dir)) fs::dir_create(log_dir)
log_appender(appender_tee(tempfile("plumber_", log_dir, ".log")))
#* Return the sum of two numbers
#* #param a The first number to add
#* #param b The second number to add
#* #post /sum
function(a, b) {
as.numeric(a) + as.numeric(b)
}
Then we register the hooks as follows:
library(plumber)
pr <- plumb("plumber.R")
convert_empty <- function(string) {
if (is.null(string) || is.na(string) || string == "") {
"-"
} else {
string
}
}
pr$registerHooks(
list(
preroute = function() {
# Start timer for log info
tictoc::tic()
},
postroute = function(req, res) {
end <- tictoc::toc(quiet = TRUE)
# Log details about the request and the response
log_info('{convert_empty(as.character(req$HEADERS["authorization"]))} {convert_empty(req$HTTP_TENANT)} {convert_empty(req$REMOTE_ADDR)} {convert_empty(req$HTTP_USER_AGENT)} {convert_empty(req$HTTP_HOST)} {convert_empty(req$REQUEST_METHOD)} {convert_empty(req$PATH_INFO)} {convert_empty(res$status)} {round(end$toc - end$tic, digits = getOption("digits", 5))}')
}
)
)
pr
In the console, you can do:
pr$run()
so serve your API locally.
From there, go to the terminal in RStudio and do a curl. Assuming is your port, an example would be:
curl -H "Authorization: Bearer my_token" -H "TENANT: 123" -X POST "http://127.0.0.1:9520/sum?a=1&b=2"
You should see a return of 3 in the terminal, and if you look at the R console, you will see the Authorization and tenant headers logged

So it turns out my specific problem was actually the format of tenant name, e.g. req$HTTP_TENANT = "Company A/S". When this is passed by log_info, it gets split into two columns, which is more than the logging table expects. Maybe the forward slash is escaping something.
For some reason, you have to put it in quotes in log_info, so log_info('"{convert_empty(req$HTTP_TENANT)}"') instead of log_info('{convert_empty(req$HTTP_TENANT)}') as with req$HTTP_USER_AGENT in the original post.

Related

Digital Ocean post request with JSON input returns blank in plumber API

My plumber function runs properly in local ( creating two R sessions and sending post request from one to other works ). However when doing the same for digitalocean server it is returning empty sting.
Plumber API
# plumber.R
#* #post /
#* #get /
function(req){
tryCatch({
list( rawbody = req$postBody )
}, error = function(e) {
return( jsonlite::toJSON( list('error' = e), force = T ) )
})
}
POST request
rm( list = ls() )
library(httr)
library(jsonlite)
options(stringsAsFactors = FALSE)
# url for local testing
url <- "http://127.0.0.1:6531" #... have changed URL to server url when testing for server
body = list( 'msg' = 'hi' )
# set API path
path <- 'data'
# send POST Request to API
raw.result <- POST(url = url, path = path, body = body, encode = 'json')
# check status code
raw.result$status_code
# check response
fromJSON(rawToChar(raw.result$content))
Please note GET request works fine but sending data with JSON doesn't work.
Output for server url
fromJSON(rawToChar(raw.result$content))
$rawbody
[1] ""
Output from local url
fromJSON(rawToChar(raw.result$content))
$rawbody
[1] "hi"
What am I doing wrong ?

Why is the Service Unavailable Error using Lapply?

I am using the spotifyr library where I want to find audio features for multiple tracks. For example I can do this in order to find the audio features of a specific song using it's id.
analysis2 <- get_track_audio_features("2xLMifQCjDGFmkHkpNLD9h",
authorization = get_spotify_access_token())
Yesterday, I wrote this function below that takes all the tracks in a dataframe and finds the audio features for all of them and stores them in a list and it was working fine.
get_analysis <- function(track_id)
{
analysis <- get_track_audio_features(track_id,
authorization = get_spotify_access_token())
}
tracks_list <- lapply(all_tracks$track.id, get_analysis)
Now I am getting an error saying Request failed [503] and Error in get_track_audio_features(track_id, authorization = get_spotify_access_token()) : Service Unavailable (HTTP 503).
I am still able to find the audio features of a specific song so I am not sure which service is unavailable.
I suspect you are reaching a song in your data for which the response is denied from spotify. You could try adding an error-catching mechanism to see which one it is:
get_analysis <- function(track_id){
tryCatch(
expr = {
get_track_audio_features(track_id, authorization = get_spotify_access_token())
},
error = function(e){
print(track_id)
}) -> analysis
return(analysis)
}
tracks_list <- lapply(all_tracks$track.id, get_analysis)
I looked at the source code for the package and didn't see any sneaky rate-limiting issues and the Web API page shows error 503 as a generic error that needs waiting to be resolved (https://developer.spotify.com/documentation/web-api/). Thus you could also try just adding a 10 minute wait (I couldn't find how long exactly it is on Spotify's website):
get_analysis <- function(track_id){
tryCatch(
expr = {
get_track_audio_features(track_id, authorization = get_spotify_access_token()) -> output
return(output)
},
error = function(e){
print(track_id)
return(e)
}) -> output
}
wait.function <- funciton(){
Sys.sleep(600)
}
get_analysis_master <- function(all_tracks){
k <- 1
tracks_list <- list()
for(track.id in all_tracks$track.id){
get_analysis(track.id) -> output
if(!inherits(output, "error")){
tracks_list[[k]] <- output
k <- k + 1
} else {
wait.function()
}
return(tracks_list)
}
get_analysis_master(all_tracks) -> tracks_list

Multipart/form-data with RestRserve

I would like to expose an endpoint that accepts multipart/form-data, parses the multipart content and returns a csv-file. (the multipart input contains a csv dataset and processing instructions)
I’ve done this with plumber using Rook::Multipart$parse() as suggested here. Because plumber doesn’t support parallel requests, I’d like to re-implement this with RestRserve. The following won’t work – plumber’s inputs are of class environment (which Rook::Multipart$parse() assumes) whereas RestRserve’s inputs are of class Request R6.
application = Application$new(content_type = "text/plain")
application$add_post("/echo", function(req, res) {
multipart <- Rook::Multipart$parse(req$body)
dta <- read_csv(multipart$dta$tempfile, trim_ws=FALSE)
res$set_body(dta)
})
Any ideas on how to get multipart/form-data input to work with RestRserve?
RestRserve parses multipart body when process the incoming request. As result you have a raw request$body and metatdata in the request$files. Request object also provides a get_file method to extract body content. Let me show example for the app and request:
# load packages
library(readr)
library(callr)
library(httr)
# run RestRserve in the background
ps <- r_bg(function() {
library(RestRserve)
library(readr)
app = Application$new(content_type = "text/plain")
app$add_post(
path = "/echo",
FUN = function(request, response) {
# for debug
str(request$body)
str(request$files)
# extract multipart body field
cnt <- request$get_file("csv") # 'csv' from the upload form field
# parse CSV
dt <- read_csv(cnt)
# for debug
str(dt)
# do something with dt
identity(dt)
# write result to temp file
tmp <- tempfile()
write_csv(dt, tmp)
# set output body
response$set_body(c(tmpfile = tmp))
# or simply response$set_body(format_csv(dt))
}
)
backend = BackendRserve$new()
backend$start(app, http_port = 65080)
})
# wait for up
Sys.sleep(2L)
# check is alive
ps$is_alive()
# prepare CSV to upload
tmp <- tempfile()
write_csv(head(iris, 5), tmp)
# POST request with file
rs <- POST(
url = "http:/127.0.0.1:65080/echo",
body = list(csv = upload_file(tmp)),
encode = "multipart"
)
# get response content
cat(content(rs))
# read log from the RestRserve
cat(ps$read_output())
# kill background prcoess
ps$kill()
See ?Request for more details about fields and methods in this class.

Asynchronous API endpoints with plumber

How do I define asynchronous API endpoints in plumber?
I didn't really find plumber-specific documentation on the topic except this example and this GitHub issue
When I try to reproduce the example, I get an error that R doesn't know how to turn a promise into JSON (at least that's what I think the problem is):
<simpleError: No method asJSON S3 class: promise>
Example
library(promises)
sleep_count <- 5
# add 5 seconds of sleep time
add_async_sleep <- function(p) {
n <- 20
for (i in 1:(sleep_count * n)) {
p <- then(p, function(value) {
Sys.sleep(1/n)
"" # return value
})
}
p
}
# use name_ as a placeholder for name when there are extra args
time <- function(name_, name = name_) {
paste0(name, ": ", Sys.time())
}
new_promise <- function() {
promise(function(resolve, reject){ resolve(NULL) })
}
#' #get /async
function() {
new_promise() %>%
add_async_sleep() %...>%
time("async")
}
Say this code lives in file plumber.R, then you should be able to start the API server and bring up Swagger with
r <- plumber::plumb(here::here("plumber.R"))
r$run()
Once I try out the endpoint /async, my R console reports
Starting server to listen on port 7361
Running the swagger UI at http://127.0.0.1:7361/__swagger__/
<simpleError: No method asJSON S3 class: promise>
and Swagger looks like this:
Disclaimer
I'm new to future and promises and only made it mid-way through the docs on https://rstudio.github.io/promises/ yet.

Access header when header name has - in it plumber R

I am trying to pass header "X-Name" from postman then access it from API which is build using Plumber R.
However, I am not able to access it. using following code,
req$HTTP_X-NAME, then i am getting following error.
Error in (function (id, time_frame, req, res) : object 'name' not
found\n"
If I use following code, I get NULL values,
req$HTTP_X_NAME
or
req[["HTTP_X-NAME"]
or
req[["HTTP_X-Name"]
Following is my code:
#* #get /
healthCheck <- function(){
print("It's Running")
}
#* #param id:int Random Number
#* #post /test/values
#* #get /test/values
test <- function(id, req, res){
print(req[["HTTP_X-Name"]])
return(req[["HTTP_X-Name"]])
}

Resources