I want to render website through login page in shinyApp

Question

I want to render an URL after login into login page in shinyApp. Do not know how to code it.

I have tried with uiOutput() and renderUI(). But does not work. Here is the below code:

library(shiny)
library(shinyauthr)
library(shinyjs)

# dataframe that holds usernames, passwords and other user data
user_base <- data.frame(
user = c("user1", "sr1"),
password = c("pass1", "USR@1"), 
permissions = c("admin", "standard"),
name = c("User One", "User Two"),
stringsAsFactors = FALSE,
row.names = NULL
)

ui <- fluidPage(
# must turn shinyjs on
shinyjs::useShinyjs(),
# add logout button UI 
div(class = "pull-right", shinyauthr::logoutUI(id = "logout")),
# add login panel UI function
shinyauthr::loginUI(id = "login"),
# setup table output to show user info after login
#tableOutput("user_table")
uiOutput("hptm")
)

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

# call the logout module with reactive trigger to hide/show
logout_init <- callModule(shinyauthr::logout, 
                          id = "logout", 
                          active = reactive(credentials()$user_auth))

# call login module supplying data frame, user and password cols
# and reactive trigger
credentials <- callModule(shinyauthr::login, 
                          id = "login", 
                          data = user_base,
                          user_col = user,
                          pwd_col = password,
                          log_out = reactive(logout_init()))

# pulls out the user information returned from login module
user_data <- reactive({credentials()$info})

#output$user_table <- renderTable({
# use req to only render results when credentials()$user_auth is TRUE
output$hptm <- renderUI({req(credentials()$user_auth)
user_data()})
}
shinyApp(ui = ui, server = server)

I want an user can visit URL "https//stackoverflow.com" after login into shinyApp. The website should not display in another window. It should display in the same window.

Answer 1

Using extendShinyjs()

library(shiny)
library(shinyauthr)
library(shinyjs)

# dataframe that holds usernames, passwords and other user data
user_base <- data.frame(
    user = c("user1", "sr1"),
    password = c("pass1", "USR@1"), 
    permissions = c("admin", "standard"),
    name = c("User One", "User Two"),
    stringsAsFactors = FALSE,
    row.names = NULL
)

jscode <- "
shinyjs.hrefAuto = function(url) { window.location.href = url;};
"

ui <- fluidPage(
    # must turn shinyjs on
    shinyjs::useShinyjs(),
    extendShinyjs(text = jscode, functions = "hrefAuto"),
    # add logout button UI 
    div(class = "pull-right", shinyauthr::logoutUI(id = "logout")),
    # add login panel UI function
    shinyauthr::loginUI(id = "login"),
    # setup table output to show user info after login
    #tableOutput("user_table")
    uiOutput("hptm")
)

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

    # call the logout module with reactive trigger to hide/show
    logout_init <- callModule(shinyauthr::logout, 
                              id = "logout", 
                              active = reactive(credentials()$user_auth))

    # call login module supplying data frame, user and password cols
    # and reactive trigger
    credentials <- callModule(shinyauthr::login, 
                              id = "login", 
                              data = user_base,
                              user_col = user,
                              pwd_col = password,
                              log_out = reactive(logout_init()))

    # pulls out the user information returned from login module
    user_data <- reactive({credentials()$info})

    #output$user_table <- renderTable({
    # use req to only render results when credentials()$user_auth is TRUE
    output$hptm <- renderUI({req(credentials()$user_auth)
        js$hrefAuto('https://stackoverflow.com')})
}
shinyApp(ui = ui, server = server)

I added the following:

In the global environment:

jscode <- "
shinyjs.hrefAuto = function(url) { window.location.href = url;};
"

In the ui:

extendShinyjs(text = jscode, functions = "hrefAuto"),

In the server:

js$hrefAuto('https://stackoverflow.com')