Currently using httr package
Files <- c("mypath.png", “test.png”)
R <- POST(url, body = list(x = upload_file(#FIles),b = “test” ))
Trying to post multiple files with same key
Similar to the script below from python
files = [('file', open('report.xls', 'rb')), ('file', open('report2.xls', 'rb'))]
Need to be done in curl
#Workaround in curl library.
params=list()
for (file in embImgList)
{params <- append(params, list(FILES= form_file(path = file)))}
I found a solution that worked
httr::POST(url = upload_url,
add_headers(`Authorization` = authorization),
body = list(files = upload_file(file_location[1]),
files = upload_file(file_location[2]),
files = upload_file(file_location[3]),
files = upload_file(file_location[4]),
files = upload_file(file_location[5])),
encode = "multipart",
verbose()
)
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 would like to download a grib2 file data in a range, as done in this Python notebook:
https://nbviewer.org/github/microsoft/AIforEarthDataSets/blob/main/data/noaa-hrrr.ipynb
(see cell 5)
I have tried the following code, but it seems to download the whole GRIB file instead of the range:
using HTTP
url = "https://noaahrrr.blob.core.windows.net/hrrr/hrrr.20210513/conus/hrrr.t12z.wrfsfcf01.grib2"
range_start = 38448330
range_end = 39758083
grib2_bytes = HTTP.request("GET", url; headers = Dict("Range" => Dict("bytes" => [range_start; range_end]) ) );
# save bytes to file
io = open("variable.grib2", "w");
write(io, grib2_bytes); # I can see the file is too big (148 MB)
close(io)
# rest of the code is just to read the data
# The downloaded file subset is a valid GRIB2 file.
using GRIB
f = GribFile("variable.grib2")
msg = Message(f)
To mimic the python code you should use string interpolation:
range_start = 38448330
range_end = 39758083
headers = Dict(
"Range" => "bytes=$(range_start)-$(range_end)"
)
I'm trying to use the httr R package to place orders on BitMex through their API.
I found some guidance over here, and after specifying both my API key and secret in respectively the objects K and S, I've tried the following
verb <- 'POST'
expires <- floor(as.numeric(Sys.time() + 10000))
path <- '/api/v1/order'
data <- '{"symbol":"XBTUSD","price":4500,"orderQty":10}'
body <- paste0(verb, path, expires, data)
signature <- hmac(S, body, algo = 'sha256')
body_l <- list(verb = verb, expires = expires, path = path, data = data)
And then both:
msg <- POST('https://www.bitmex.com/api/v1/order', encode = 'json', body = body_l, add_headers('api-key' = K, 'api-signature' = signature, 'api-expires' = expires))
and:
msg <- POST('https://www.bitmex.com/api/v1/order', body = body, add_headers('api-key' = K, 'api-signature' = signature, 'api-expires' = expires))
Give me the same error message when checked:
rawToChar(msg$content)
[1] "{\"error\":{\"message\":\"Signature not valid.\",\"name\":\"HTTPError\"}}"
I've tried to set it up according to how BitMex explains to use their API, but I appear to be missing something. They list out a couple of issues that might underly my invalid signature issue, but they don't seem to help me out. When following their example I get the exact same hashes, so that seems to be in order.
bit late to the party here but hopefully this helps!
Your POST call just needs some minor changes:
add content_type_json()
include .headers = c('the headers') in add_headers(). See example below:
library(httr)
library(digest)
S <- "your api secret"
K <- "your api key"
verb <- 'POST'
expires <- floor(as.numeric(Sys.time() + 10))
path <- '/api/v1/order'
data <- '{"symbol":"XBTUSD","price":4500,"orderQty":10}'
body <- paste0(verb, path, expires, data)
signature <- hmac(S, body, algo = 'sha256')
msg <- POST('https://www.bitmex.com/api/v1/order',
encode = 'json',
body = data,
content_type_json(),
add_headers(.headers = c('api-key' = K,
'api-signature' = signature,
'api-expires' = expires)))
content(msg, "text")
I have a package on CRAN - bitmexr - that provides a wrapper around the majority of BitMEX's API endpoints that you might be interested in. Still quite a "young" package so I would welcome any feedback!
I'm using slackr to send alert messages to a Slack channel. It works great except the message format is not great and I want to improve it.
install_github("hrbrmstr/slackr")
library(slackr)
slackr_setup(channel="#alerts", username="Mark Davis",
incoming_webhook_url = "https://hooks.slack.com/services/T31P8UDAB/BCH4HKQSC/*********",
api_token = "*********", echo = F)
alert="On Monday, 2018-09-03 # 2pm Pacific..."
slackr(alert)
Here is an example of how a message from slackr looks in Slack:
Here is an example of how I'd like it to look:
slackr doesn't seem to have many options in the way of formatting. I was thinking of building an image and inserting that, but I'm having trouble building an image out of a text file using R.
Perhaps there is another api I could call that could take my text and format it for slack?
I'm open to any suggestions.
Addendum:
Slackr has an option to upload files, so my latest attempt is to create an image from the text message and upload that object.
I am able to create a png file from the text message using the magick library. I created an image with a colored background, and I simply add the message text to the image:
library(magick)
alert_picture <- image_read('alert_480x150_dark_red.png')
alert_picture=image_annotate(alert_picture, DreamCloud_Alert, size = 20, gravity = "southwest",
color = "white", location = "+10+10")
image_write(alert_picture, path = "alert_picture.png", format = "png")
The image looks pretty good (although there doesn't seem to be an easy way to bold or underline specific words in the message), but the obstacle now is that I can't get the upload command to work.
slackr_upload(filename = "alert_picture.png")
I don't get any error messages but nothing is uploaded to slack.
I got around this issue by using the httr package to execute the post image function to slack.
Thanks to Adil B. for providing the solution:
Post Image to Slack Using HTTR package in R
I am not sure this is what you meant, but I solved allowing formatting like in a regular slack message by altering the slackr_bot() function and just removing the 2 sets of 3 back-ticks at the end of the code where it says text. Then just call it slackr_bot1() or something, and then you can post formatted messages. This is the function after the back-ticks removal:
slackr_bot1 <- function(...,
channel=Sys.getenv("SLACK_CHANNEL"),
username=Sys.getenv("SLACK_USERNAME"),
icon_emoji=Sys.getenv("SLACK_ICON_EMOJI"),
incoming_webhook_url=Sys.getenv("SLACK_INCOMING_URL_PREFIX")) {
if (incoming_webhook_url == "") {
stop("No incoming webhook URL specified. Did you forget to call slackr_setup()?", call. = FALSE)
}
if (icon_emoji != "") { icon_emoji <- sprintf(', "icon_emoji": "%s"', icon_emoji) }
resp_ret <- ""
if (!missing(...)) {
# mimics capture.output
# get the arglist
args <- substitute(list(...))[-1L]
# setup in-memory sink
rval <- NULL
fil <- textConnection("rval", "w", local = TRUE)
sink(fil)
on.exit({
sink()
close(fil)
})
# where we'll need to eval expressions
pf <- parent.frame()
# how we'll eval expressions
evalVis <- function(expr) withVisible(eval(expr, pf))
# for each expression
for (i in seq_along(args)) {
expr <- args[[i]]
# do something, note all the newlines...Slack ``` needs them
tmp <- switch(mode(expr),
# if it's actually an expresison, iterate over it
expression = {
cat(sprintf("> %s\n", deparse(expr)))
lapply(expr, evalVis)
},
# if it's a call or a name, eval, printing run output as if in console
call = ,
name = {
cat(sprintf("> %s\n", deparse(expr)))
list(evalVis(expr))
},
# if pretty much anything else (i.e. a bare value) just output it
integer = ,
double = ,
complex = ,
raw = ,
logical = ,
numeric = cat(sprintf("%s\n\n", as.character(expr))),
character = cat(sprintf("%s\n\n", expr)),
stop("mode of argument not handled at present by slackr"))
for (item in tmp) if (item$visible) { print(item$value, quote = FALSE); cat("\n") }
}
on.exit()
sink()
close(fil)
# combined all of them (rval is a character vector)
output <- paste0(rval, collapse="\n")
loc <- Sys.getlocale('LC_CTYPE')
Sys.setlocale('LC_CTYPE','C')
on.exit(Sys.setlocale("LC_CTYPE", loc))
resp <- POST(url = incoming_webhook_url, encode = "form",
add_headers(`Content-Type` = "application/x-www-form-urlencoded",
Accept = "*/*"), body = URLencode(sprintf("payload={\"channel\": \"%s\", \"username\": \"%s\", \"text\": \"%s\"%s}",
channel, username, output, icon_emoji)))
warn_for_status(resp)
}
return(invisible())
}
slackr_bot1("*test* on time")
I am trying to export a 3D plot that was made using the plot3d function from the rgl package using the WrtieWebGL function for web viewing. I don't really understand the example in the WriteWebGL documentation because it saves to a temp directory. Could someone please provide an example on how to use this function and/or point out my error(s) with usage? Thank you for your time and help.
attach(dataset1)
plot3d(Days_Prep_Time,ACT_Score,Coffee,size=5,col="blue", type="s")
writeWebGL(dir = "webGL", filename = file.path(dir, "index.html"),
template = system.file(file.path("WebGL", "template.html"), package = "rgl",
snapshot = TRUE, font = "Arial")
I get the following error:
Error in writeWebGL(dir = "webGL", filename = file.path(dir, "index.html"), :
template ‘’ does not contain %WebGL%
In addition: Warning message:
In file(con, "r") :
file("") only supports open = "w+" and open = "w+b": using the former
You are adding the snapshot and font parameters to the system.file function, not the writeWebGL function:
writeWebGL(dir = "webGL", filename = file.path(dir, "index.html"),
template = system.file(file.path("WebGL", "template.html"), package = "rgl"),
snapshot = TRUE, font = "Arial")
In particular, note that
system.file(file.path("WebGL", "template.html"), package = "rgl")
returns the correct path from console, whereas
system.file(file.path("WebGL", "template.html"), package = "rgl", snapshot = TRUE, font = "Arial")
returns "".