R brilliant entry hack

Question

Having tried the RStudio Shiny Pro Server evaluation, I am not very impressed with the login / authentication mechanism, as they are not a simple mechanism for managing user accounts to access a brilliant application.

As such, I'm trying to create my own Shiny login mechanism, which works fine for all purposes and tasks, in addition to displaying things within the shinydashboard . Everything seems to be disabled until all the content is displayed. My login code is a small contribution at https://gist.github.com/withr/9001831 , which is why there is a bunch.

My code is:

 require(shiny) require(shinydashboard) my_username <- "test" my_password <- "abc" header <- dashboardHeader(title = "my heading") sidebar <- uiOutput("sidebarpanel") body <- uiOutput("body") login <- box(title = "Login",textInput("userName", "Username"), passwordInput("passwd", "Password"), br(),actionButton("Login", "Log in")) mainpage <- "some data" ui <- dashboardPage(header, sidebar, body) server <- function(input, output, session) { USER <<- reactiveValues(Logged = Logged) observe({ if (USER$Logged == FALSE) { if (!is.null(input$Login)) { if (input$Login > 0) { Username <- isolate(input$userName) Password <- isolate(input$passwd) Id.username <- which(my_username == Username) Id.password <- which(my_password == Password) if (length(Id.username) > 0 & length(Id.password) > 0) { if (Id.username == Id.password) { USER$Logged <<- TRUE } } } } } }) output$sidebarpanel <- renderUI({ if (USER$Logged == TRUE) { dashboardSidebar( sidebarUserPanel("myuser",subtitle = a(icon("user"), "Logout", href="__logout__")), selectInput("in_var", "myvar", multiple = FALSE, choices = c("option 1","option 2")), sidebarMenu( menuItem("Item 1", tabName = "t_item1", icon = icon("line-chart")), menuItem("Item 2", tabName = "t_item2", icon = icon("dollar")), menuItem("Item 3", tabName = "t_item3", icon = icon("credit-card")), menuItem("Item 4", tabName = "t_item4", icon = icon("share-alt")) ))} }) output$body <- renderUI({ if (USER$Logged == TRUE) { dashboardBody(mainpage) } else { dashboardBody(login) } }) } shinyApp(ui, server) 

When I download the application, it looks like this:

If I then resize the screen a bit, it will be fixed.

Any thoughts on how to avoid the strange initial behavior will be greatly appreciated.

Answer 1

I think the problem can be renderUI putting the dashboardSidebar and dashboardBody functions outside of renderUI , just like:

 header <- dashboardHeader(title = "my heading") sidebar <- dashboardSidebar(uiOutput("sidebarpanel")) body <- dashboardBody( uiOutput("body") ) 

It will create an empty sidebar and body, which you can fill later with the renderUI function.

Since you have several components in the "sidebarpanel", you can group them by replacing the dashboardSidebar function with the div function:

  output$sidebarpanel <- renderUI({ if (USER$Logged == TRUE) { div( sidebarUserPanel("myuser",subtitle = a(icon("user"), "Logout", href="__logout__")), selectInput("in_var", "myvar", multiple = FALSE, choices = c("option 1","option 2")), sidebarMenu( menuItem("Item 1", tabName = "t_item1", icon = icon("line-chart")), menuItem("Item 2", tabName = "t_item2", icon = icon("dollar")), menuItem("Item 3", tabName = "t_item3", icon = icon("credit-card")), menuItem("Item 4", tabName = "t_item4", icon = icon("share-alt")) ) ) } }) 

Remove also dashboardBody from the body rendering function:

 output$body <- renderUI({ if (USER$Logged == TRUE) { mainpage } else { login } }) 

He must fix this problem.

By the way, is it safe to use such authentication for login?