I'm trying to build a plumber API in R. Have started with this example from the docs...
pr() %>%
pr_post("/echo", function(req, res) {
if (is.null(req$body)) return("No input")
list(
input = req$body
)
}) %>%
pr_run(port = 8080)
API starts OK. However, I want my handler function to use JSON in the body of the request as inputs.
Is it possible to programmatically define a JSON schema such that it's populated as the example in the swagger docs for the API?
Thanks.
Looks like this post Plumber: getting request body/schema in UI has the solution.
This is (unless anyone can tell me it's bad practice) the example I was looking for...
v <- data.frame(a = c(2, 3),
b = c(3, 4))
pr() %>%
pr_post("/add_up", function(input = v) {
input <- input[[1]]
return(list(rowSums(input)))
}) %>%
pr_run(port = 8080)
This gives the following example JSON in the swagger docs...
{
"input": [
[
{
"a": 2,
"b": 3
},
{
"a": 3,
"b": 4
}
]
]
}
...and returns the following response...
[
[
5,
7
]
]
Can anyone offer any improvement? Might be nice to remove the 'input' from the JSON schema if possible.
Related
I am trying to mock the output of a gh API request:
httptest2::with_mock_dir("gh", {
test_that("api works", {
gh::gh("GET /repos/r-lib/gh")
})
})
I am trying to set up testing for custom functions that routinely make API calls to GitHub and I am using gh to make these requests. I am following this tutorial as guidance: https://books.ropensci.org/http-testing/
However, no directory is created when this function is run. Is there anyway to capture the output of gh::gh and store it as a mock API return so that I can run my tests without needing GitHub authentication or even an internet connection?
httptest2 is specifically designed to test httr2 requests:
This package helps with writing tests for packages that use httr2
Unfortunately, gh uses httr:
Imports:
cli (>= 3.0.1),
gitcreds,
httr (>= 1.2),
ini,
jsonlite
This means that you can't directly use httptest2 with gh.
However, using gh source code, you can extract the parameters of the GET request sent to httr by gh:
gh_get <- function(endpoint, ..., per_page = NULL, .token = NULL, .destfile = NULL,
.overwrite = FALSE, .api_url = NULL, .method = "GET",
.limit = NULL, .accept = "application/vnd.github.v3+json",
.send_headers = NULL, .progress = TRUE, .params = list()) {
params <- c(list(...), .params)
params <- gh:::drop_named_nulls(params)
if (is.null(per_page)) {
if (!is.null(.limit)) {
per_page <- max(min(.limit, 100), 1)
}
}
if (!is.null(per_page)) {
params <- c(params, list(per_page = per_page))
}
req <- gh:::gh_build_request(
endpoint = endpoint, params = params,
token = .token, destfile = .destfile,
overwrite = .overwrite, accept = .accept,
send_headers = .send_headers,
api_url = .api_url, method = .method
)
req
}
req <- gh_get("GET /repos/r-lib/gh")
req
#$method
#[1] "GET"
#$url
#[1] "https://api.github.com/repos/r-lib/gh"
#$headers
# User-Agent Accept
# "https://github.com/r-lib/gh" "application/vnd.github.v3+json"
#$query
#NULL
#$body
#NULL
#$dest
#<request>
#Output: write_memory
This allows with the example you provided to use httr2 to send the same request :
library(httr2)
resp_httr2 <- request(base_url=req$url) %>%
req_perform() %>%
resp_body_json()
If you are mainly interested in json content, the results are the same, only the attributes differ :
resp_gh <- gh::gh("GET /repos/r-lib/gh")
all.equal(resp_gh,resp_httr2,check.attributes=FALSE)
#[1] TRUE
If you want to use httptest2, switching to httr2 would work:
with_mock_dir("gh", {
test_that("api works", {
resp <- request(base_url=req$url) %>%
req_perform() %>%
resp_body_json()
expect_equal(resp$full_name,"r-lib/gh")})
})
#Test passed 🎉
#[1] TRUE
Offline testing now works because gh\api.github.com directory was created by httptest2.
Maybe you can take inspiration from tests/testthat/test-mock-repos.R
res <- gh(
TMPL("/repos/{owner}/{repo}"),
owner = "gh-testing",
repo = test_repo,
.token = tt()
)
expect_equal(res$name, test_repo)
expect_equal(res$description, "Test repo for gh")
expect_equal(res$homepage, "https://github.com/r-lib/gh")
expect_false(res$private)
expect_false(res$has_issues)
expect_false(res$has_wiki)
A GET method would not create any directory.
I am moving from plain R code to R functions. In order to use R closure I have wrapped in 2 functions (authentication and download), whereof (download) has a dependency of needing input from authentication.
My understanding is that if I create a closure the variables inside the closure should be accessible for the entire inside of closure. If that is the case howcome function [downloadData] cannot fetch the variables from [authenticationKeys] ?
Currently I am solving the problem by having (authenticate) and (download) in separate R files and sourcing them into a main.R. Problem is though that I then get the result of the variables into global scope which seems to be not recommended. Furthen on, by sourcing the files I cannot utilize the function arguments and I cannot utilize the functional programming benefits by calling only parts of code when needed.
runAll <- function() {
# Authentication
authenticate <- function() {
auhtenticationKeys <- list (
"key1" = 1,
"key2" = 2,
"key3" = 3
)
}
authenticate()
# Download
downloadData <- function() {
# Access authentication keys:
auhtenticationKeys$key1
auhtenticationKeys$key2
auhtenticationKeys$key3
myData <- list (
"open" = 10,
"high" = 11,
"low" = 12,
"close" = 13
)
}
downloadData()
}
runAll()
You can always assign variables you are interested in to other environments outside the closure you are working on:
runAll <- function() {
# Authentication
authenticate <- function() {
auhtenticationKeys <- list (
"key1" = 1,
"key2" = 2,
"key3" = 3
)
assign("auhtenticationKeys",auhtenticationKeys, envir=parent.frame())
}
authenticate()
# Download
downloadData <- function() {
# Access authentication keys:
auhtenticationKeys$key1
auhtenticationKeys$key2
auhtenticationKeys$key3
myData <- list (
"open" = 10,
"high" = 11,
"low" = 12,
"close" = 13
)
}
downloadData()
}
runAll()
By this line:
assign("auhtenticationKeys",auhtenticationKeys, envir=parent.frame()) your keys are available inside download data and you can run your code.
You can see more here: http://adv-r.had.co.nz/Environments.html#function-envs
I want to send a post request with a few variables in the body, using the httr package.
What the body would look like if it was in JSON format:
{a:"1", b:"2", c:[{d:"3", e:"4"}]}
What I tried with httr::POST()
r <- POST("http://httpbin.org/post", body = list(a = 1, b = 2, c = list(d=3, e=4)))
The error I got:
Error in curl::handle_setform(handle, .list = req$fields) :
Unsupported value type for form field 'c'.
How would I need to structure my POST() statement to send it in the format that I want mentioned above?
EDIT: On trying #renny's solution (I added verbose() for viewability) i.e. the following line
r <- POST("http://httpbin.org/post", body = json_array, encode="json", verbose())
I am able to observe that the JSON that's generated in the output is of the following format:
{"post":{"a":1,"b":2,"c":{"d":3,"e":4}}}
As you can see, the "c" variable does not have [] around it and there is a "post" variable. The following is what I want.
{"a":1,"b":2,"c":[{"d":3,"e":4}]}
I know it is an old question, but maybe someone will end up here like me. The problem was a missing list.
To create a json array instead of an object, list must be unnamed. So in your example:
> json_array <- list(a = 1, b = 2, c = list(list(d=3, e=4)))
> jsonlite::toJSON(json_array)
{"a":[1],"b":[2],"c":[{"d":[3],"e":[4]}]}
# auto_unbox extracts values from unnecessary arrays, not explicit lists
> jsonlite::toJSON(json_array, auto_unbox = T)
{"a":1,"b":2,"c":[{"d":3,"e":4}]}
Then you will not need to use jsonlite, since encode does the work:
httr::POST("http://httpbin.org/post", body = json_array, encode="json")
returning the response
{
"args": {},
"data": "{\"a\":1,\"b\":2,\"c\":[{\"d\":3,\"e\":4}]}",
"files": {},
"form": {},
"headers": {
"Accept": "application/json, text/xml, application/xml, */*",
"Accept-Encoding": "deflate, gzip",
"Content-Length": "33",
"Content-Type": "application/json",
...
}
library(httr)
json_array <- list(
post = list(a = 1, b = 2, c = list(d=3, e=4))
)
r <- POST("http://httpbin.org/post", body = json_array, encode="json")
app_data <- content(r)
Try this.
This might work out!
So the solution to this problem that I had to use was a JSON string in the body parameter.
If for example, the following is the JSON string under consideration:
json <- {"a":1,"b":2,"c":[{"d":3,"e":4}]}
I had to pass this JSON string as the value for the "body" parameter for httr::POST()
So the function call would look like:
r <- POST(url=url, body=json, encode="json", verbose())
My web developers cannot work with the JSON format generated by the MRSDeploy found in Microsoft ML Service Server.
Example:
The Data frame to be returned:
foo bar prediction
1 a .98
2 b .75
3 c .55
The PublishService code:
# Publish as service using publishService() function from
api <- publishService(
"MyPrediction_v1",
code = function_InOut,
inputs = list(foo = "numeric", bar = "character"),
outputs = list(OutputDataSet = "data.frame"),
v = version
)
The Current Return
{
"foo": [1, 2, 3],
"bar": ["a", "b", "c"]
"prediction" [.98,.75,.55]
}
The Preferred Return
{"Results": [
{
"foo": 1,
"bar":"a",
"prediction":.98
},
{
"foo": 2,
"bar":"b",
"prediction":.75
},
{
"foo": 2,
"bar":"c",
"prediction":.55
}
]
}
How do I get a row-by-row return? column-by-column is not desired?
I'm using the following code to perform multiple simultaneous requests.
urls <- c("https://httpbin.org/status/301", "https://httpbin.org/status/302", "https://httpbin.org/status/200")
result <- list()
p <- curl::new_pool(total_con = 10, host_con = 5, multiplex = T)
cb <- function(res) {
result <<- append(result, list(res))
cat("requested URL: ", url, "last URL: ", res$url, "\n\n")
}
for (url in urls) {
curl::curl_fetch_multi(url, done = cb, handle = curl::new_handle(failonerror = F, nobody = F, followlocation = T, ssl_verifypeer = 0), pool = p)
}
curl::multi_run(pool = p)
As you can see, I would like to print to the console the requested URL and the URL, that finally answered with 200 ok.
The following is printed to the console:
requested URL: https://httpbin.org/status/200 last URL: https://httpbin.org/status/200
requested URL: https://httpbin.org/status/200 last URL: https://httpbin.org/get
requested URL: https://httpbin.org/status/200 last URL: https://httpbin.org/get
The requested URL in the console output is always https://httpbin.org/status/200, because it's the last URL that used in the for-loop. So, that is the wrong way to do it.
How can I retain information about the initial requested URL when using curl_fetch_multi to use it after multi_run returned? That means it would be ideal if the requested URL would be added to the res-list to query it with something like cat("requested URL: ", res$requested_url, "last URL: ", res$url, "\n\n").
I had a similar issue where I wanted to do asynchronous POST requests using curl_fetch_multi and check which requests succeeded and which failed. However, due to the structure of the POST statement (all fields are in the request body) there is no identifying information whatsoever in the response object. My solution was to generate custom callback functions which carried an identifier.
urls <- c("https://httpbin.org/status/301", "https://httpbin.org/status/302", "https://httpbin.org/status/200")
result <- list()
# create an identifier for each url
url.ids = paste0("request_", seq_along(urls))
# custom callback function generator: generate a unique function for each url
cb = function(id){
function(res){
result[[id]] <<- res
}
}
# create the list of callback functions
cbfuns = lapply(url.ids, cb)
p <- curl::new_pool(total_con = 10, host_con = 5, multiplex = T)
for (i in seq_along(urls)) {
curl::curl_fetch_multi(urls[i], done = cbfuns[[i]], handle = curl::new_handle(failonerror = F, nobody = F, followlocation = T, ssl_verifypeer = 0), pool = p)
}
curl::multi_run(pool = p)
In this example, the custom callback functions are simply used to name the elements of result:
names(result)
## [1] "request_3" "request_1" "request_2"
which can then be used to tie each response back to the original request.