Add header authentication to the swagger UI in R plumber

Question

I have created a plumber API in R that authenticates user requests via a bearer token in the header.

The code for the authentication is a filter that looks like this:

#* @filter checkAuthentication
function(req, res) {
  if (!req$PATH_INFO %in% c("/__docs__/", "/__swagger__/", "/openapi.json")) {
    tryCatch({
    token = req$HEADERS['authorization'][1]
    secret_api_token = Sys.getenv("SECRET_TOKEN")


drop_bearer_token_string <- function(tokenString) {
  # Use regex to drop the string "Bearer"
  # and empty spaces before or after the token
  return(gsub("^Bearer\\s+|\\s+Bearer$", "", tokenString))
}



if (drop_bearer_token_string(req$HEADERS['authorization'][1]) == drop_bearer_token_string(secret_api_token)) {
  plumber::forward() #User authenticated, continue
}

  },
  
error = function(cond) {
    return(list(
      status = "Failed.",
      code = 401,
      message = "No or wrong authentication provided."
    ))
    
    
  })
  } else {
    plumber::forward()
    }
}

Then I start the api with plumber like this:

pr("api.R") %>% pr_run(host = '0.0.0.0', port = 8000)

As a default this will create a swagger UI with default settings that can be accessed even without authentication due to the filter above.

However when opening the swagger UI there is no field to input the bearer token for authentication so all example calls will fail the authentication filter.

How can I add header fields to the swagger UI within the code/framework?

Answer 1

A quick background before I jump into the solution:

Swagger is based on an openapi.yaml/json file, which dictates what is shown in the web UI. Changing the way the openapi file is created using plumber allows you to add authentication to the UI. The options you have are outlined here.

To achieve this in plumber, you have to define a function to take the existing openapi structure (its R-based list implementation) and add the authentication yourself. This can be done using the plumber::pr_set_api_spec(my_function) function.

An example is this:

library(plumber)

# Adds authentication to a given set of paths (if paths = NULL, apply to all)
add_auth <- function(x, paths = NULL) {
  
  # Adds the components element to openapi (specifies auth method)
  x[["components"]] <- list(
    securitySchemes = list(
      ApiKeyAuth = list(
        type = "apiKey",
        `in` = "header",
        name = "X-API-KEY",
        description = "Here goes something"
      )
    )
  )
  
  # Add the security element to each path
  # Eg add the following yaml to each path
  # ...
  # paths:
  #   /ping:
  #     get:
  #       security:               #< THIS
  #         - ApiKeyAuth: []      #< THIS
  
  if (is.null(paths)) paths <- names(x$paths)
  for (path in paths) {
    nn <- names(x$paths[[path]])
    for (p in intersect(nn, c("get", "head", "post", "put", "delete"))) {
      x$paths[[path]][[p]] <- c(
        x$paths[[path]][[p]],
        list(security = list(list(ApiKeyAuth = vector())))
      )
    }
  }
  
  # cat(yaml::as.yaml(x)) # for debugging purposes
  
  x
}

APIKEY <- "mysecret"

pr() %>%
  pr_set_api_spec(add_auth) %>%          #< This adds the authentication
  pr_get("/ping", function(req, res) {
    # handle auth
    if (!"HTTP_X_API_KEY" %in% names(req) || req$HTTP_X_API_KEY != APIKEY) {
      res$body <- "Unauthorized"
      res$status <- 401
      return()
    }
    
    return("OK")
  }) %>%
  pr_run()

Which results in this Swagger UI

with this Authorization

If you try out the endpoint without an APIKey, you get a 401 error

If you set the correct credentials, you get the results

Bearer Authentication

Use this function for Bearer Authentication

add_auth <- function(x, paths = NULL) {
  # Adds the components element to openapi (specifies auth method)
  x[["components"]] <- list(
    securitySchemes = list(
      BearerAuth = list(
        type = "http",
        scheme = "bearer",
        description = "Here goes something"
      )
    )
  )
  
  # Add the security element to each path
  if (is.null(paths)) paths <- names(x$paths)
  for (path in paths) {
    nn <- names(x$paths[[path]])
    for (p in intersect(nn, c("get", "head", "post", "put", "delete"))) {
      x$paths[[path]][[p]] <- c(
        x$paths[[path]][[p]],
        list(security = list(list(BearerAuth = vector())))
      )
    }
  }
  
  x
}

and then this in the route function

if (!"HTTP_AUTHORIZATION" %in% names(req) || req$HTTP_AUTHORIZATION != TOKEN) {
  # same as before