Ui Reactive to global variable refreshed each session for authentication

shiny

#1

I am working on creating an app that can authenticate against a table (in PostgreSQL database) of valid session tokens that if valid will let the user continue onto the app or redirect if the session token does not match one found in the table. The problem I’m running into is that, to my knowledge, the table of valid sessions has to be referenced outside the server function in order to to properly invoke the redirect (which lives in a custom ui function). This will work for the first user that attempts to hit the app because the select against the valid tokens table is initiated by that user. Any subsequent user’s session however will try to compare against a stale list of valid tokens generated by the first user. Long story short, I need to be able to refresh an app object with every new session, but I can’t do it from within the server code because the scope won’t reach the ui function I’ve created. Here is an abstraction of what I’m trying to accomplish:

require(shiny)

# Global Variable That Should be Refreshed with Each New Session
app_count <- if(exists("app_count")) {
    app_count + 1
} else {
    1
}

# UI function defined by contents of global variable
ui_func <- function() {
    if(app_count == 1) {
        bootstrapPage(
            h6(textOutput("count"))
        )
    } else if (app_count == 2) {
        bootstrapPage(
            h4(textOutput("count"))
        )
    } else if (app_count == 3) {
        bootstrapPage(
            h2(textOutput("count"))
        )
    } else {
        url <- "https://www.google.com/"
        redirect <- sprintf("location.replace(\"%s\");", url)
        tags$script(HTML(redirect))
    }
}

server <- function(input, output, session) {

    # Render Count Text
    output$count <- renderText({
        paste0("Current Count: ", app_count)
    })
}

shinyApp(ui_func, server)

Am I even thinking about this the right way? This is largely based on a really cool oauth vignette put together by @jcheng but obviously heavily modified to address the reliance on an in house authentication system.


#2

I’m not 100% clear on the details of the session tokens in your DB (and I wouldn’t expect to be :slight_smile: ), but this stood out to me:

I need to be able to refresh an app object with every new session

As far as I’m aware, anything that needs to be refreshed with every new session needs to go inside your server function. You can use output objects created in the server function in the UI function. It may be that I’m completely misunderstanding, and your case is more complex, but it seems to me that you can follow the same approach here.

If you want to create/change UI based on a value that is refreshed each time a user connects to the app, assign the result of a renderUI() call in your server function to an output slot, handle the required logic inside the renderUI() call (e.g. querying the database), then display the corresponding UI with uiOutput("output_slot_name") in your UI function. If the UI doesn’t need to change, then obviously you wont be using renderUI() but the approach will be similar.

How does the table of session tokens in the database get updated? It sounds like you need some logic inside your server function that queries the session tokens in the DB, creates the right UI for the user (or re-directs them elsewhere), and then immediately updates the table it to make sure it isn’t “stale” for the next user that logs in. (If I’ve understood you correctly.)

Of course I may have missed your problem entirely - let me know if this wasn’t clear and you still need to talk it through!


#3

Thanks very much for the response Jim!

The token table is refreshed by a colleagues’ Python process that generates a couple tokens (one for Flask apps and one for Shiny apps) every time someone logs in (using a Flask authentication module). My goal is to just query the Shiny table anytime anyone tries to access one of the Shiny apps in our larger framework and compare their session token against the contents of that table. The reason I was doing this in the global framework was I wanted the ui to force a redirect (google.com in the case of this example) if the session token doesn’t match any entries in the valid tokens table. I’ll try a variation that uses a renderUI from within the server code (because I think you’re right about server content being the only thing that refreshes for every session) and see if it works for this use case.

My only lingering/tin hat level paranoia concern is that if someone really is trying to break in with an invalid session token, they might be able to glean some information from the html response prior to the renderUI logic being executed. I’ll let you know if the renderUI solution works though.


#4

You’re welcome. I think that yes, the only thing that gets re-run is the server function (maybe technically the UI code is also re-run, but as it doesn’t do much other than show what the server creates it doesn’t matter so much). Concretely, anything in global.R (or just defined as an object in app.R as in your example) will only ever run once (I think) - when the app is first run. Hopefully @jcheng or someone a bit more certain in how Shiny works will correct me if I’m wrong.


#5

Having the entire ui rendered by as a uiOutput does the trick. A solution guided by @jim89 can be seen below. I don’t know enough about what gets passed back and forth between websockets to know for sure if this is a secure solution, but the app is hosted via SSL, so all the traffic in and out is encrypted. In any case, here is my solution:

library(shiny)
    
ui <- uiOutput("ui")

server <- function(input, output, session) {
    
    # reactive value defaults to one before the ui is generated
    val <- reactive({if(is.null(input$the_count)) {1} else {input$the_count}})
    
    # UI function defined by contents of global variable
    output$ui <- renderUI({
        req(val())
        
        if(val() == 1) {
            fluidPage(
                numericInput("the_count", "Counter!", value = val(), min = 1, max = 4),
                h6(textOutput("count"))
            )
        } else if (val() == 2) {
            fluidPage(
                numericInput("the_count", "Counter!", value = val(), min = 1, max = 4),
                h4(textOutput("count"))
            )
        } else if (val() == 3) {
            fluidPage(
                numericInput("the_count", "Counter!", value = val(), min = 1, max = 4),
                h2(textOutput("count"))
            )
        } else {
            url <- "https://www.google.com/"
            redirect <- sprintf("location.replace(\"%s\");", url)
            tags$script(HTML(redirect))
        }
    })

    # Render Count Text
    output$count <- renderText({
        paste("Current Count: ", val())
    })
}

shinyApp(ui, server)

#6

Glad you found something that works. If I test your code and input 4 in the numeric input I get redirected to Google, but if I refresh the page/connect in a different session (e.g. in a new browser, or even a new tab), the count is not updating - is that what you intended for the app to do?


#7

I thought this would address my use case, but I’ve run into some snags. First to answer your questions:

For my purposes, the val() variable doesn’t have to be shared across sessions, and if it did, my understanding is that I could use a ‘<<-’ operator to assign the variable inside the server function, and that variable would then alter the variable across multiple sessions. I haven’t tested that, but as I said, it’s not necessary for the problem I am seeking to address.

I have unfortunately hit a snag that my solution does not address, so let me take a step back and explain my precise use case. When a user attempts to access one of our shiny apps, their URL will be assigned a session token that can be accessed by the app. The first thing any of my shiny apps needs to do is query our database for all valid session tokens. If the session token is seen to be valid, I want the ui to paint normally otherwise I want to generate a 401 page (ideally a real 401, but I really am out of my depth here).

The solution that I checked above does achieve this from the stand point that it can grab the session token object, query the database from within the server function (which means that it will always have a list of valid tokens as of the moment that the app was accessed), and then pass the true/false logic to a renderUI to paint the entire ui for the app if it works, or paint a basic HTML 401 error if the check fails.

The problem is that I have some fairly complex shiny apps that I have to integrate this functionality to and defining the entire ui from within the server function is tricky, and has introduced some fairly inconsistent behavior.

Initially I was attempting to move the logic to the app space so that a basic ui function (ui_func in my example) could take the place of the ui in the shinyApp call. This would reduce the overhead of having to totally reinvent all of my uis and move them to the server. This ran into the problem that I originally had where I couldn’t get a fresh copy of the valid session tokens from a database call in the app scope (the stale copy of the valid session tokens was keeping any subsequent session calls from getting an updated version).

This is exemplary of my current (and not at all ideal) framework:

# Easter Egg is displayed if /?query=123; 401 displayed if /?query=anything else
library(shiny)

ui <- uiOutput("ui")

server <- function(input, output, session) {
    # Valid Query Object defined in each session (this would be a database call)
    validQuery <- "123"
    
    # Parsing the session token from the URL
    # This is defined before the app launches in my actual use case
    query <- reactive({parseQueryString(session$clientData$url_search)})
    
    # TRUE/FALSE that the two values match
    output$queryMatch <- renderText({
        req(query())
        
        paste(query() == validQuery)
    })
    
    # Parse the GET query string
    output$queryText <- renderText({
        
        paste(names(query()), query(), sep = "=", collapse=", ")
    })
    
    # If there is a query in the URL and it matches the validQuery, render a selectInput
    # This is a placeholder for all of the various renderUI objects I have in my apps
    output$easterEgg <- renderUI({
        req(length(query()) > 0 && query() == validQuery)
        
        selectInput("easterEgg", "So Long as Queries Match...", choices = c("foo", "bar", validQuery), selected = validQuery)
    })
    
    # Send the Complete renderUI to the ui in app scope to be rendered if the query is
    # either absent or is present AND == validQuery, otherwise paint a 401
    output$ui <- renderUI({
        
        if(length(query()) > 0 && query() != validQuery) {
            HTML("<strong>This is a 401 Error<strong>")
        } else {
            bootstrapPage(
                h3("Parsed query string"),
                verbatimTextOutput("queryText"),
                
                h3("A valid query would look like '/?query=123'"),
                verbatimTextOutput("queryMatch"),
                
                uiOutput("easterEgg")
            )
        }
    })
}

shinyApp(ui, server)

Ideally I could create a shiny module that could be called as far upstream as possible that makes the determination before the server has to be called.

# Need to be able to have an updated valid session list every time the
# app is accessed
validQuery <- dbGetQuery(con, "select valid_token from token_table")

# if there is a way to parse the URL before the server function is called
# that would be great
query <- parseQueryString(session$clientData$url_search)        

if(length(query()) > 0 && query() == validQuery) {
    bootstrapPage(
        h3("Parsed query string"),
        verbatimTextOutput("queryText"),
        
        h3("A valid query would look like '/?query=123'"),
        verbatimTextOutput("queryMatch"),
        
        uiOutput("easterEgg")
    )
} else {
    HTML("<strong>This is a 401 Error<strong>")
}

#8

Sorry, just seeing this now and I don’t have time to read the whole thread but I did want to let you know that you can change this line to ui_func <- function(req) { and the UI will be generated fresh for every session. This is not widely known, but the functionality is necessary for the bookmarkable state feature among other things.


#9

You can see that I do a similar thing here (redirect if preconditions not met), but for OAuth: https://gist.github.com/jcheng5/44bd750764713b5a1df7d9daf5538aea (see the uiFunc function declaration, that’s what I pass as the first argument to shinyApp instead of a static ui)


#10

Thanks very much for the response Joe! I actually used your OAuth example as a template for my initial approach but I didn’t think to wrap the database call into the uiFunc, forcing it to rerun with every new session. Here is a working example:

# Easter Egg is displayed if /?query=123; 401 displayed if /?query=anything else
library(shiny)

uiFunc <- function(req) {
    # Valid Query Object defined in each session with database select
    validQuery <- "123"
    
    if(length(parseQueryString(req$QUERY_STRING)) > 0 && parseQueryString(req$QUERY_STRING) != validQuery) {
        HTML("<strong>This is a 401 Error<strong>")
    } else {
        bootstrapPage(
            h3("Parsed query string"),
            verbatimTextOutput("queryText"),
            
            h3("A valid query would look like '?query=123'"),
            verbatimTextOutput("queryMatch"),
            
            uiOutput("easterEgg")
        )
    }
}

server <- function(input, output, session) {
    
    # Replicating the validQuery in server space to make the app components work
    validQuery <- "123"
    
    # Parsing the session token from the URL
    # This is defined before the app launches in my actual use case
    query <- reactive({parseQueryString(session$clientData$url_search)})
    
    # TRUE/FALSE that the two values match
    output$queryMatch <- renderText({
        req(query())
        
        paste(query() == validQuery)
    })
    
    # Parse the GET query string
    output$queryText <- renderText({
        
        paste(names(query()), query(), sep = "=", collapse=", ")
    })
    
    # If there is a query in the URL and it matches the validQuery, render a selectInput
    # This is a placeholder for all of the various renderUI objects I have in my apps
    output$easterEgg <- renderUI({
        req(length(query()) > 0 && query() == validQuery)
        
        selectInput("easterEgg", "So Long as Queries Match...", choices = c("foo", "bar", validQuery), selected = validQuery)
    })
}

shinyApp(uiFunc, server)