<- RSQLite::dbConnect(RSQLite::SQLite(), "users.sql")
users
<-
users_values ::tribble(
tibble~name, ~user, ~password, ~token, ~token_expiry,
'John','jbrown','1234','','',
'Sally','sblue', '4321','',''
)
::dbWriteTable(users, name = 'users', value = users_values)
RSQLite::dbDisconnect(users) RSQLite
Plumber token authentication
I’m working on a project that involves using a server to take in user data to run a bioinformatics pipeline with R and blast+. I am using plumber as the HTTP API to receive the user data and send data to background R processes. To add a layer of (clandestine) security, I tried making a token authentication system.
Background
I have worked with HTTP APIs many times before - from free to highly secure. One involved POSTing user credentials + a key in order to receive a time-expiring token for downstream use. I had a go at creating something similar using plumber.
Now, there is this thing called a RESTful API (google it!) which is a set of architectural constraints. Ideally we want our API to follow these constraints. This following API voids the stateless criteria, as we keep a DB of information. But that is ok here.
The logic
- A plumber HTTP API is up and running (‘the API’)
- Users can request a token by POSTing credentials. The API validates the credentials using a local DB*. If valid, it creates a token (a value of 24 random “0:9, letter, LETTERS”) and token_expiry time (time + X time, here 10 seconds). It updates the DB with token and token_expiry of the user, then returns a response with the header ‘token’ and token value.
- the DB contains user credentials, tokens and token expiry times
- Another request is made .. it must include the header ‘token’ with the token value
- The API checks the request for a header ‘token’, and if present, compares it to the DB
- If the token is found, the expiry time is checked, and if valid, the user request is carried out
- Where any of the validation steps fail, a response is sent with various 400 status codes.
- Having a DB means this thing is not stateless .. there are other token options, but more exploratory time is required by myself.
The setup
The API itself required plumber
, dplyr
and RSQLite
. I used dplyr
as it simplified some SQL code (which could otherwise be properly written as SQL statements). For development, I used httr2
for interacting with the API and callr
to run the API within the same RStudio session.
User DB
A simple local SQL DB.
Plumber script
library(plumber)
suppressPackageStartupMessages(library(dplyr))
library(RSQLite)
#* @apiTitle Plumber Example API for token authentication
#* @apiDescription A simple example of creating and verifying a token. It uses
#* a local DB, plumber filters, and returns user data if token verified.
#* API setup
#*
#* Change default serializer
#*
#* @plumber
function(pr){
%>%
pr pr_set_serializer(serializer_unboxed_json())
}
#* @filter token_check
#*
#* Check that a token is provided and is valid for carrying out request. This
#* filter is run for every request unless a `@preempt token_check` is used.
#*
#* @param req,res plumber request and response objects
function(req, res) {
if (is.null(req$HTTP_TOKEN)){
$status <- 401
resreturn(list(error = 'token not found in request header'))
}
<- RSQLite::dbConnect(RSQLite::SQLite(), "users.sql")
users
= req$HTTP_TOKEN
req_token
<-
token_row ::tbl(users, 'users') %>%
dplyr::filter(token == req_token) %>%
dplyr::collect()
dplyr
if (nrow(token_row) == 0){
$status <- 401
resreturn(list(error = 'token not allocated to user'))
}
<- as.numeric(token_row$token_expiry) - as.numeric(Sys.time()) < 0
token_expired
if (is.na(token_expired) || token_expired) {
$status <- 401
resreturn(list(error = 'token expired, please refesh token'))
}
::forward()
plumber
}
#* Refresh user token
#*
#* Return token in HTTP header 'token'. This function excludes the `token_check`
#* filter.
#*
#* @param req,res plumber request and response objects
#*
#* Expects a request body with `user` and `password`
#*
#* @preempt token_check
#* @post /refresh-token
function(req, res) {
<- any( is.null(req$body$user) | is.null(req$body$password) )
any_missing_credentials
if (any_missing_credentials){
$status <- 400
resreturn(list(error = 'user or password not included in request body'))
}
<- RSQLite::dbConnect(RSQLite::SQLite(), "users.sql")
users
<- req$body$user
req_user
<-
user_row ::tbl(users, 'users') %>%
dplyr::filter(user == req_user) %>%
dplyr::collect()
dplyr
if (nrow(user_row) == 0){
$status <- 401
resreturn(list(error = 'user not found'))
}
<- req$body$password != user_row$password
password_incorrect
if (password_incorrect){
$status <- 401
resreturn(list(error = 'password incorrect'))
}
<- paste(sample(c(0:9, letters, LETTERS), size = 24, replace = TRUE), collapse = '')
token
# A 10 second expiry time
<- Sys.time() + 10
token_expiry
::dbExecute(users, "UPDATE users SET token = ?, token_expiry = ? where user = ? and password = ?",
RSQLiteparams = c(token, token_expiry, user_row$user, user_row$password))
::dbDisconnect(users)
RSQLite
$setHeader('token', token)
res
}
#* A simple function to return user data in DB
#*
#* This endpoint will only be reached if a user supplies a valid token
#*
#* @param req,res plumber request and response objects
#*
#* @get /return-data
function(req, res) {
<- RSQLite::dbConnect(RSQLite::SQLite(), "users.sql")
users
= req$HTTP_TOKEN
req_token
<-
token_row ::tbl(users, 'users') %>%
dplyr::filter(token == req_token) %>%
dplyr::collect()
dplyr
if (nrow(token_row) == 0){
$status <- 500
resreturn(list(error = 'token not allocated to user'))
}
return(as.list(token_row))
}
Testing
I used callr
to create a background process with the API running
<-
rp ::r_bg(function(){
callr::pr_run(plumber::pr('token-plumber-api.R'), port = 8989)
plumber })
$is_alive() rp
[1] TRUE
cat(rp$read_error())
Running plumber API at http://127.0.0.1:8989
Running swagger Docs at http://127.0.0.1:8989/__docs__/
Then query the API using httr2
library(httr2)
<- httr2::request('http://127.0.0.1:8989') requrl
The endpoint /return-data
will be reached after the request goes through the token_check
filter. Here, no token is provided. Note that if an error is sent by the server to the client, httr2
will by default throw an R error and we do not want that here hence the req_error
line - we would otherwise not be able to see what the error message sent was.
# The response
<-
resp_no_token %>%
requrl req_url_path_append('return-data') %>%
req_error(is_error = function(res) FALSE) %>%
req_perform() %>%
print()
<httr2_response>
GET http://127.0.0.1:8989/return-data
Status: 401 Unauthorized
Content-Type: application/json
Body: In memory (45 bytes)
# The response message
%>%
resp_no_token resp_body_json() %>%
print()
$error
[1] "token not found in request header"
Thus a user needs to submit their credentials to the end point /refresh-token
to receive a (time-limited) token. Remember this endpoint does not go through the token_check
filter due to the @preempt
directive used. We then extract the value of the header token
<-
token %>%
requrl req_url_path_append('refresh-token') %>%
req_body_json(
list(user = 'jbrown',
password = '1234')
%>%
) req_perform() %>%
resp_header('token') %>%
print()
[1] "8dP3V3DQIvSTBmHcda9Ysnyl"
And then include it in future requests
<-
resp_with_token %>%
requrl req_url_path_append('return-data') %>%
req_headers(token = token) %>%
req_error(is_error = function(res) FALSE) %>%
req_perform() %>%
print()
<httr2_response>
GET http://127.0.0.1:8989/return-data
Status: 200 OK
Content-Type: application/json
Body: In memory (118 bytes)
%>%
resp_with_token resp_body_json() %>%
print()
$name
[1] "John"
$user
[1] "jbrown"
$password
[1] "1234"
$token
[1] "8dP3V3DQIvSTBmHcda9Ysnyl"
$token_expiry
[1] "1721890161.48539"
Since the token is time-limited (10 seconds here), what if we wait 12 seconds and try again?
Sys.sleep(12)
<-
resp_with_token %>%
requrl req_url_path_append('return-data') %>%
req_headers(token = token) %>%
req_error(is_error = function(res) FALSE) %>%
req_perform() %>%
print()
<httr2_response>
GET http://127.0.0.1:8989/return-data
Status: 401 Unauthorized
Content-Type: application/json
Body: In memory (46 bytes)
%>%
resp_with_token resp_body_json() %>%
print()
$error
[1] "token expired, please refesh token"
A call to /refresh-token
is required to move forward …
Kill background R process (the API)
$kill() rp
[1] TRUE
Conclusion
Here we explored a HTTP API using plumber and attempted to create an authentication system. It involved using API filters and endpoints, sending and receiving HTTP headers, sending HTTP response codes, and using a local SQL database for credential storage.
Obviously there are better ways to handle security (type of token, where does token go - in cookies?, encrypted cookies), or do what we did above is a better way (ensure credential DB is more secure - set permissions on the server) but we have a simple working API with a security layer happening.