Using the openpaths.cc API with R - r

I tried to pull my location data from openpaths.cc to use it with R.
The API uses OAuth and is documented here, however, it only provides an example in Python.
After looking around how to handle OAuth (which I am barely familiar with) in R, I found ROAuth, so I used the usage example provided as a basis.
According to the API-documentation, the endpoint for all requests is https://openpaths.cc/api/1, and I have my access key and access secret, so I naively plugged them in for cKey, cSecret, reqURL, accessURL, authURL, and testURL, but only got "bad request" as a result from the credentials$handshake() line.
reqURL <- "https://openpaths.cc/api/1"
accessURL <- "https://openpaths.cc/api/1"
authURL <- "https://openpaths.cc/api/1"
cKey <- "key"
cSecret <- "secret"
testURL <- "https://openpaths.cc/api/1"
credentials <- OAuthFactory$new(consumerKey=cKey,
consumerSecret=cSecret,
requestURL=reqURL,
accessURL=accessURL,
authURL=authURL,
needsVerifier=TRUE)
credentials$handshake()
## the GET isn’t strictly necessary as that’s the default
credentials$OAuthRequest(testURL, "GET")
While I feel like I have no idea what I'm doing, I at least verified that ROAuth is capable of using the HMAC-SHA1 method, wich is required by openpaths.
EDIT: I have ROAuth version 0.9.3 installed
EDIT2: After learning about httr, I thought this might be the appropriate library for the task, however I still could not produce any usable results, since the token creation via oauth1.0_token only lead to a Bad request again.
I think my primary problem is the lack of API documentation from openpaths.cc. With all these tools, I still have no idea how to properly use them.

Here is as far as I got. I receive a "400 Not Authorized", maybe this is due to the fact that my openpaths account is not connected to foursquare, maybe something is wrong with the code. Please try it out!
Required packages:
library(RCurl)
library(digest)
library(base64)
Some functions borrowed/adapted from ROAuth:
## Get a random sequence of characters.
## Nonce - number used only once.
genNonce <- function(len = 15L + sample(1:16, 1L)) {
els <- c(letters, LETTERS, 0:9, "_")
paste(sample(els, len, replace = TRUE), collapse = "")
}
## this function is derived from utils::URLencode
## Characters not in the unreserved character set ([RFC3986] section 2.3) MUST be encoded
## unreserved = ALPHA, DIGIT, '-', '.', '_', '~'
## cf. http://oauth.net/core/1.0/#encoding_parameters
encodeURI <- function(URI, ...) {
if (!is.character(URI)) {
URI
} else {
OK <- "[^-A-Za-z0-9_.~]"
x <- strsplit(URI, "")[[1L]]
z <- grep(OK, x)
if (length(z)) {
y <- sapply(x[z], function(x) paste("%", toupper(as.character(charToRaw(x))),
sep = "", collapse = ""))
x[z] <- y
}
paste(x, collapse = "")
}
}
## we escape the values of the parameters in a special way that escapes
## the resulting % prefix in the escaped characters, e.g. %20 becomes
## %2520 as %25 is the escape for %
## cf. http://tools.ietf.org/html/rfc5849#section-3.4.1.3.2
normalizeParams <- function(params, escapeFun) {
names(params) <- sapply(names(params), escapeFun, post.amp = TRUE)
params <- sapply(params, escapeFun, post.amp = TRUE)
## If two or more parameters share the same name, they are sorted by their value.
params <- params[order(names(params), params)]
return(paste(names(params), params, sep = "=", collapse = "&"))
}
## From Ozaki Toru's code at https://gist.github.com/586468
signWithHMAC <- function(key, data) {
blockSize <- 64
hashlength <- 20
innerpad <- rawToBits(as.raw(rep(0x36, blockSize)))
outerpad <- rawToBits(as.raw(rep(0x5C, blockSize)))
zero <- rep(0 ,64)
HexdigestToDigest <- function(digest) {
as.raw(strtoi(substring(digest, (1:hashlength)*2-1,
(1:hashlength)*2), base=16))
}
mac <- function(pad, text) {
HexdigestToDigest(digest(append(packBits(xor(key, pad)), text),
algo='sha1', serialize=FALSE))
}
if(nchar(key) >= 64) {
keyDigested <- digest(key, algo="sha1", serialize=FALSE)
key <- intToUtf8(strtoi(HexdigestToDigest(keyDigested), base=16))
}
key <- rawToBits(as.raw(append(utf8ToInt(key), zero)[1:blockSize]))
base64(mac(outerpad, mac(innerpad, charToRaw(data))))[1]
}
## Sign an request made up of the URL, the parameters as a named character
## vector the consumer key and secret and the token and token secret.
signRequest <- function(uri, consumerKey, consumerSecret, params=character(),
oauthKey = "", oauthSecret = "", httpMethod = "GET",
nonce = genNonce(),
timestamp = Sys.time()) {
httpMethod <- toupper(httpMethod)
params["oauth_nonce"] <- nonce
params["oauth_timestamp"] <- as.integer(timestamp)
params["oauth_consumer_key"] <- consumerKey
params["oauth_signature_method"] <- 'HMAC-SHA1'
params["oauth_version"] <- '1.0'
if(oauthKey != "") params["oauth_token"] <- oauthKey
odat <- paste(
encodeURI(httpMethod), encodeURI(uri),
encodeURI(normalizeParams(params, encodeURI), post.amp = TRUE),
sep = "&"
)
okey <- encodeURI(consumerSecret)
if(oauthSecret != "") okey <- paste(okey, encodeURI(oauthSecret), sep = "&")
params["oauth_signature"] <- signWithHMAC(okey, odat)
return(params)
}
Now this function tries to replicate the example at the openpaths website:
openpaths <- function(
access_key=getOption("openpaths.access_key"),
secret_key=getOption("openpaths.secret_key"),
curl=getCurlHandle()) {
uri <- 'https://openpaths.cc/api/1'
params <- signRequest(uri, consumerKey=access_key, consumerSecret=secret_key)
oa_header <- paste(names(params), params, sep="=", collapse=",")
ret <- getURL(
uri,
curl=curl,
.opts=list(
header=TRUE,
verbose=TRUE,
httpheader=c(Authorization=paste("OAuth ", oa_header, sep="")),
ssl.verifypeer = TRUE,
ssl.verifyhost = TRUE,
cainfo = system.file("CurlSSL", "cacert.pem", package = "RCurl")
)
)
return(ret)
}

I've made some progress on this problem, although it's challenging due
to the flakiness of the site, and the custom OAuth process that they're
using. First you'll need to install development version of httr - this
exports some previously internal functions.
devtools::install_github("hadley/httr")
OpenPaths is unusual in that the app secret and key are the same as the
token and token secret. This means we need to write a custom auth
header:
library(httr)
app <- oauth_app("OpenPaths", "JSLEKAPZIMFVFROHBDT4KNBVSI")
#> Using secret stored in environment variable OPENPATHS_CONSUMER_SECRET
# Implement custom header for 2-leg authentication, and oauth_body_hash
auth_header <- function(url, method = "GET") {
oauth_signature(url, method, app, app$key, app$secret,
# Use sha1 of empty string since http request body is empty
body_hash = "da39a3ee5e6b4b0d3255bfef95601890afd80709")
}
Then you can use this to sign your request. This is currently failing
for me because the site seems to be down (again).
url <- "https://openpaths.cc/api/1"
r <- GET(url, oauth_header(auth_header(url)))
stop_for_status(r)
content(r)

Related

How do I fix "The query parameter [expansion] is not one of [usernames,expansions,tweet.fields,user.fields]" in twitter R Script

I am running the following code which is taken from https://developer.twitter.com/en/docs/tutorials/getting-started-with-r-and-v2-of-the-twitter-ap with some slight changes because it is doesn't seem to work.
library(rjson)
#https://developer.twitter.com/en/docs/tutorials/getting-started-with-r-and-v2-of-the-twitter-ap
Sys.setenv(BEARER_TOKEN="{mybearertoken}")
require(httr)
require(jsonlite)
require(dplyr)
bearer_token <- Sys.getenv("TWITTER_BEARER")
headers <- c(`Authorization` = sprintf('Bearer %s', bearer_token))
params <- list(`user.fields` = 'description',
`expansion` = 'pinned_tweet_id')
handle <- "codewryte"
url_handle <- paste("https://api.twitter.com/2/tweets/", handle)
#url_handle <-"https://twitter.com/TwitterDev/status/1228393702244134912"
response <-
httr::GET(url = url_handle,
httr::add_headers(.headers = headers),
query = params)
obj <- httr::content(response, as = "text")
x <- fromJSON(obj)
I get the following error:
$errors[[2]]$message
[1] "The query parameter [expansion] is not one of [usernames,expansions,tweet.fields,user.fields]"
$title
[1] "Invalid Request"
$detail
[1] "One or more parameters to your request was invalid."
$type
[1] "https://api.twitter.com/2/problems/invalid-request"
I also tried https://api.twitter.com/2/users/by/username/codewryte which is my user handle with the same message.
Does anyone understand what this message means and how I can fix it?
The problem was I was sending a list where a string needed to be sent.
response <-httr::GET(url = url_handle,
httr::add_headers(.headers = headers),
query="expansions=pinned_tweet_id&user.fields=created_at&tweet.fields=created_at")
I am not sure why the tutorial had this list.

API OAuth 2.0 - XERO acces with R receiving status 400

We have to migrate to Oauth 2.0. However, I am facing the following issues. Status 400 I believe due to some parameters that may not be entered right. If anyone know what could be wrong or have any idea please let me know.
and this is my code:
pack <- c('curl','xml2','XML', 'plyr', 'dplyr','tidyr', 'httr', 'tools', 'lubridate',
'jsonlite', 'stringr', 'data.table', 'anytime')
sapply(pack, function(x){
if(!require(x,character.only = T, quietly = T)) {install.packages(x, quiet = T)}
require(x, quietly = T, character.only = T)
})
#New Xero & WFM Api OAuth 2.0 credentials
Client_ID <- 'YOUR_CLIENT_ID'
Client_secret<- 'YOUR_CLIENT_SECRET'
XTID <- 'YOUR_REFERAL_ID'#Referral_ID
Redirect_URI <- 'https://xero.com/' #OAuth 2.0 redirect URI
response <- GET(paste0('https://login.xero.com/identity/connect/authorize?response_type=code&client_id=',
Client_ID,'&redirect_uri=',Redirect_URI,'&scope=workflowmax%20offline_access'))
browseURL(response$url)
It works till here I am able to retrieve the first code, but I can't get the tokens
This is what Xero Doc said:
Xero Doc request:
POST https://identity.xero.com/connect/token
authorization: "Basic " + base64encode(client_id + ":" + client_secret)
Content-Type: application/x-www-form-urlencoded
grant_type=authorization_code
&code=xxxxxx
&redirect_uri=https://myapp.com/redirect
Now trying to get the token I tried several forms. however, they all look really similar.
code <- 'YOUR_CODE'
credentials = list();
credentials['grant_type'] <- "authorization_code"
credentials['code'] <- code
credentials['redirect_uri'] <- Redirect_URI
b64_id_secret <- base64_enc('YOUR_CLIENT_ID:YOUR_CLIENT_SECRET')
# user <- paste("Basic", user, sep = " ")
url <- 'https://identity.xero.com/connect/token'
POST(url, add_headers('Authorization'= paste0('Basic ', b64_id_secret)),
body = credentials,
verbose(), encode = 'form')
Response:
Response [https://identity.xero.com/connect/token?grant_type=authorization_code&code=YOUR_CODE&redirect_uri=https://waterlineprojects.com/]
Date: 2020-11-20 02:48
Status: 400
Content-Type: application/json; charset=UTF-8
Size: 27 B
XERO DOCUMENTATION: https://developer.xero.com/documentation/oauth2/overview
I did my workaround and got it running. This is the way to access the Oauth 2.0.
pack <- c('curl','xml2','XML', 'plyr', 'dplyr','tidyr', 'httr', 'tools', 'lubridate',
'jsonlite', 'stringr', 'data.table', 'anytime', 'RCurl', 'rvest', 'opnessl', 'jose')
sapply(pack, function(x){
if(!require(x,character.only = T, quietly = T)) {install.packages(x, quiet = T)}
require(x, quietly = T, character.only = T)
})
#New Xero & WFM Api OAuth 2.0 credentials
Client_ID <- 'YOUR_ID'
Client_secret<- 'YOUR_SECRET'
XTID_Xero <- 'YOUR_XTID'#Referral_ID
Redirect_URI <- 'YOUR_CALL_BACK_URL' #OAuth 2.0 redirect URI
# Create the app
app <- oauth_app("YOUR_API_NAME",
key = Client_ID,
secret = Client_secret,
redirect_uri = Redirect_URI
)
# Create the endpoint
create_endpoint <- function()
{
request <- "https://identity.xero.com/connect/token"
authorize <- "https://login.xero.com/identity/connect/authorize"
access <- "https://identity.xero.com/connect/token"
httr::oauth_endpoint(request, authorize, access)
}
api <- create_endpoint()
header <- httr::add_headers(Authorization=paste0("Basic ", RCurl::base64Encode(charToRaw(paste0(Client_ID, ":", Client_secret)))))
content_type <- httr::content_type("application/x-www-form-urlencoded")
# Define the scope
scope_WFM <- "openid profile offline_access payroll.employees.read payroll.payruns.read payroll.payslip.read payroll.timesheets.read accounting.transactions.read accounting.reports.read accounting.journals.read"
# Get the code
httr::BROWSE(oauth2.0_authorize_url(api, app, scope = scope_WFM))
#get the code from the URL displayed in your browser
code_xero <- 'YOR_CODE'
state_xero <- 'YOUR_STATE'
token <- httr::oauth2.0_token(
endpoint = api,
app = app,
scope = scope_WFM,
config_init = c(header, content_type),
use_basic_auth = TRUE,
query_authorize_extra = list(prompt = "login"),
type = "code",
credentials = oauth2.0_access_token(api, app, code_xero),
cache = FALSE
)
#get your xero-tenant-id
access <- GET("https://api.xero.com/connections", config = token)
connections <- content(access, 'text')
connections <- fromJSON(connections, flatten = T)
looks like you are close. Like MrFlick said without your client ID and starting a case with Xero API tech support (email api#xero.com with your client id and dat of log) its hard to know for sure.
One tip might be it, your redirect URI has to match exactly same value that is in your https://developer.xero.com/myapps/details?appId=<app_uuid> dashboard including an end slash.
Also - what is the body of the 400 error, there should be something like
{
"error": "invalid_grant"
}
Which will help you deduce what is wrong more easily.
https://developer.xero.com/documentation/oauth2/troubleshooting

Error in ocrFile function in AbbyyR package

While I was using Abbyy cloud SDK for OCR, I keep on getting the error below when I try to use the ocrFile function which is inside the AbbyyR package.
" Error in curl_download(finishedlist$resultUrl[res$id == finishedlist$id], :
Argument 'url' must be string. "
When I send the files to the cloud and process them everything works fine but when the cloud returns the files there is a problem in downloading them. I thought that it might be a network or certificate problem but I can't solve the problem.
Thanks in advance
There is a problem in source code, it needs as.character() function for url.
I updated ocrFile function as follows:
install.packages("curl")
library(curl)
new_ocrFile<-function (file_path = "", output_dir = "./", exportFormat = c("txt",
"txtUnstructured", "rtf", "docx", "xlsx", "pptx", "pdfSearchable",
"pdfTextAndImages", "pdfa", "xml", "xmlForCorrectedImage",
"alto"), save_to_file = TRUE)
{
exportFormat <- match.arg(exportFormat)
res <- processImage(file_path = file_path, exportFormat = exportFormat)
while (!(any(as.character(res$id) == as.character(listFinishedTasks()$id)))) {
Sys.sleep(1)
}
finishedlist <- listFinishedTasks()
res$id <- as.character(res$id)
finishedlist$id <- as.character(finishedlist$id)
if (identical(save_to_file, FALSE)) {
res <- curl_fetch_memory(as.character(finishedlist$resultUrl[res$id ==
finishedlist$id]))
return(rawToChar(res$content))
}
curl_download(as.character(finishedlist$resultUrl[res$id == finishedlist$id]),
destfile = paste0(output_dir, unlist(strsplit(basename(file_path),
"[.]"))[1], ".", exportFormat))
}
I hope, it helps.

How to get client IP address in R Plumber

I've checked GitHub Repo and doc but still couldn't figure out how to get client IP in Plumber.
Here is the implementation I tried, I want to add IP addresses for all requests into the log file,
#' #post /v1/rl
rl_v1 <- function(a, b, c){
request='rl'
start_time <- as.numeric(as.POSIXct(Sys.time()))
log_record <- paste(NULL, Sys.time(), request, "requested", NULL, NULL,
sep=",")
cat(paste(log_record, "\n", sep=""), file=log_file_name, append=T)
lhs <- data.frame(a=unlist(a),
b=unlist(b),
c=unlist(c))
pairs <- custom_function(lhs, rhs, m_w = 0.98,
ext_blk_field=c(12), international=T,
fasterWcoBlock=T, preprocessedData2=T)
input_records=nrow(lhs)
matches=nrow(pairs)
query_time <- as.numeric(as.POSIXct(Sys.time())) - start_time
status <- data.frame(query_time=query_time,
request=request,
type='POST',
api_version=api_version_v1)
log_record <- paste(NULL, Sys.time(), request, "responded",
round(matches/input_records*100, 2),
paste0(matches, '/', input_records, ' in ', query_time),
sep=",")
cat(paste(log_record, "\n", sep=""), file=log_file_name, append=T)
return(list(data=pairs, status=status))
}
Any help is highly appreciated.
To close out the question, I'll restate the comment:
Since plumber uses httpuv, it's possible you can reach the req$REMOTE_ADDR property of the request handle.

Using R to make Amazon MWS API calls

I'm using R to make a call to the Amazon MWS API and get the following error:
The request signature we calculated does not match the signature you
provided. Check your AWS Secret Access Key and signing method. Consult
the service documentation for details.
This post helped me a lot with the Product Advertising API. However, I cannot seem to make it work on the MWS side.
Here is my code:
library(digest)
library(RCurl)
base.html.string <- "https://mws.amazonservices.com/Products/2011-10-01?"
SellerID <- 'A2UZXXXXXXXXXX'
MWSAuthToken <- 'ATVPXXXXXXXXX'
MarketplaceID <- 'ATVPXXXXXXXXX'
AWSAccessKeyId <- 'AKIAXXXXXXXXXXXXXXXX'
AWSsecretkey <- 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
ActionType <- 'GetMyPriceForASIN'
version.request = '2011-10-01'
ASINList.ASIN.1 <- 'B00XXXXXXX'
pb.txt <- Sys.time()
pb.date <- as.POSIXct(pb.txt, tz = Sys.timezone)
Timestamp = strtrim(format(pb.date, tz = "GMT", usetz = FALSE, "%Y-%m-%dT%H:%M:%SZ"), 24)
str = paste('POST\nmws.amazonservices.com\n/Products/2011-10-01\n',
'ASINList.ASIN.1=', ASINList.ASIN.1,
'&AWSAccessKeyId=', AWSAccessKeyId,
'&Action=', ActionType,
'&MWSAuthToken=', MWSAuthToken,
'&MarketplaceId=', MarketplaceID,
'&SellerId=', SellerID,
'&SignatureMethod=HmacSHA256',
'&SignatureVersion=2',
'&Timestamp=', gsub('%2E','.',gsub('%2D', '-', curlEscape(Timestamp))),
'&Version=', version.request,
sep = '')
## signature test
Signature = curlEscape(base64(hmac(enc2utf8(AWSsecretkey), enc2utf8(str), algo = 'sha256', serialize = FALSE, raw = TRUE)))
AmazonURL <- paste(base.html.string,
'ASINList.ASIN.1=', ASINList.ASIN.1,
'&AWSAccessKeyId=', AWSAccessKeyId,
'&Action=', ActionType,
'&MWSAuthToken=', MWSAuthToken,
'&MarketplaceId=', MarketplaceID,
'&SellerId=', SellerID,
'&SignatureMethod=HmacSHA256',
'&SignatureVersion=2',
'&Timestamp=', Timestamp,
'&Version=', version.request,
'&Signature=', Signature,
sep = '')
AmazonResult <- getURL(AmazonURL)
I'm using the Amazon MWS Scratchpad and made sure my string to sign matches.
My secret key does contain +'s, but I thought encoding would fix that.
Any help would be appreciated!
I figured out my problem after reading this post. I took Amazon's examples literally and used a POST instead of GET. I also had tweaked unnecessarily with my time stamp calculation, which I fixed as well. Hope this helps someone down the road.

Resources