R Brilliant Authentication Using AWS Cognito

You can use AWS Cognito API for authentication. I wrote a post about this here .

To make this answer self-contained, here are the details in a nutshell. essentially, you need to use this code in global.r

your application file :

base_cognito_url <- "https://YOUR_DOMAIN.YOUR_AMAZON_REGION.amazoncognito.com/"
app_client_id <- "YOUR_APP_CLIENT_ID"
app_client_secret <- "YOUR_APP_CLIENT_SECRET"
redirect_uri <- "https://YOUR_APP/redirect_uri"

library(httr)

app <- oauth_app(appname = "my_shiny_app",
                 key = app_client_id,
                 secret = app_client_secret,
                 redirect_uri = redirect_uri)
cognito <- oauth_endpoint(authorize = "authorize",
                          access = "token",
                          base_url = paste0(base_cognito_url, "oauth2"))


retrieve_user_data <- function(user_code){

  failed_token <- FALSE

  # get the token
  tryCatch({token_res <- oauth2.0_access_token(endpoint = cognito,
                                              app = app,
                                              code = user_code,
                                              user_params = list(client_id = app_client_id,
                                                                 grant_type = "authorization_code"),
                                              use_basic_auth = TRUE)},
           error = function(e){failed_token <<- TRUE})

  # check result status, make sure token is valid and that the process did not fail
  if (failed_token) {
    return(NULL)
  }

  # The token did not fail, go ahead and use the token to retrieve user information
  user_information <- GET(url = paste0(base_cognito_url, "oauth2/userInfo"), 
                          add_headers(Authorization = paste("Bearer", token_res$access_token)))

  return(content(user_information))

}

      

        
        
        
      

    

In server.r

you use it like this:

library(shiny)
library(shinyjs)

# define a tibble of allwed users (this can also be read from a local file or from a database)
allowed_users <- tibble(
  user_email = c("user1@example.com",
                 "user2@example.com"))

function(input, output, session){

   # initialize authenticated reactive values ----
   # In addition to these three (auth, name, email)
   # you can add additional reactive values here, if you want them to be based on the user which logged on, e.g. privileges.
   user <- reactiveValues(auth = FALSE, # is the user authenticated or not
                          name = NULL, # user name as stored and returned by cognito
                          email = NULL)  # user email as stored and returned by cognito

   # get the url variables ----
   observe({
        query <- parseQueryString(session$clientData$url_search)
        if (!("code" %in% names(query))){
            # no code in the url variables means the user hasn't logged in yet
            showElement("login")
        } else {
            current_user <- retrieve_user_data(query$code)
            # if an error occurred during login
            if (is.null(current_user)){
                hideElement("login")
                showElement("login_error_aws_flow")
                showElement("submit_sign_out_div")
                user$auth <- FALSE
            } else {
                # check if user is in allowed user list
                # for more robustness, use stringr::str_to_lower to avoid case sensitivity
                # i.e., (str_to_lower(current_user$email) %in% str_to_lower(allowed_users$user_email))
                if (current_user$email %in% allowed_users$user_email){
                    hideElement("login")
                    showElement("login_confirmed")
                    showElement("submit_sign_out_div")

                    user$auth <- TRUE
                    user$email <- current_user$email
                    user$name <- current_user$name

                    # ==== User is valid, continue prep ====

                    # show the welcome box with user name
                    output$confirmed_login_name <-
                        renderText({
                            paste0("Hi there!, ",
                                    user$name)
                        })

                    # ==== Put additional login dependent steps here (e.g. db read from source) ====

                    # ADD HERE YOUR REQUIRED LOGIC
                    # I personally like to select the first tab for the user to see, i.e.:
                    showTab("main_navigation", "content_tab_id", select = TRUE) 
                    # (see the next chunk for how this tab is defined in terms of ui elements)

                    # ==== Finish loading and go to tab ====

                } else {
                    # user not allowed. Only show sign-out, perhaps also show a login error message.
                    hideElement("login")
                    showElement("login_error_user")
                    showElement("submit_sign_out_div")
                }
            }
        }
    })

   # This is where you will put your actual elements (the server side that is) ----
   # For example:

    output$some_plot <- renderPlot({
        # *** THIS IS EXTREMELY IMPORTANT!!! ***
        validate(need(user$auth, "No privileges to watch data. Please contact support."))
        # since shinyjs is not safe for hiding content, make sure that any information is covered
        # by the validate(...) expression as was specified. 
        # Rendered elements which were not preceded by a validate expression can be viewed in the html code (even if you use hideElement).

        # only if user is confirmed the information will render (a plot in this case)
        plot(cars)
    })
}

      

        
        
        
      

    

And ui.r

it looks like this:

library(shiny)
library(shinyjs)

fluidPage(
    useShinyjs(), # to enable the show/hide of elements such as login and buttons
    hidden( # this is how the logout button will like:
        div(
            id = "submit_sign_out_div",
            a(id = "submit_sign_out",
              "logout",
              href = aws_auth_logout,
              style = "color: black; 
              -webkit-appearance: button; 
              -moz-appearance: button; 
              appearance: button; 
              text-decoration: none; 
              background:#ff9999; 
              position: absolute; 
              top: 0px; left: 20px; 
              z-index: 10000;
              padding: 5px 10px 5px 10px;"
              )
            )
    ),
    navbarPage(
        "Cognito auth example",
        id = "main_navigation",
        tabPanel(
            "identification",
            value = "login_tab_id",
            h1("Login"),
            div(
                id = "login",
                p("To login you must identify with a username and password"),
                # This defines a login button which upon click will redirect to the AWS Cognito login page
                a(id = "login_link",
                  "Click here to login",
                  href = aws_auth_redirect,
                  style = "color: black;
                  -webkit-appearance: button;
                  -moz-appearance: button;
                  appearance: button;
                  text-decoration: none;
                  background:#95c5ff;
                  padding: 5px 10px 5px 10px;")
            ),
            hidden(div(
                id = "login_error_aws_flow",
                p("An error has occurred."),
                p("Please contact support")
            )),
            hidden(
                div(
                    id = "login_confirmed",
                    h3("User confirmed"),
                    fluidRow(
                        textOutput("confirmed_login_name")),
                    fluidRow(
                        p("Use the menu bar to navigate."),
                        p(
                            "Don't forget to logout when you want to close the system."
                        )
                    )
                )
            ),
        ),
        tabPanel("Your actual content", 
                 value = "content_tab_id",
                 fluidRow(plotOutput("some_plot")))
    )
)