R shiny login hack

Question

Попробовав оценку RStudio Shiny Pro Server, я не восхищаюсь механизмом логина/аутентификации, так как их нет простого механизма управления учетными записями пользователей для доступа к блестящему приложению.

Как таковой, я пытаюсь создать свой собственный механизм входа в Shiny, который для всех целей и задач работает нормально, кроме отображения вещей в рамках shinydashboard. Кажется, что все отключено, пока не отображается весь контент. Мой код для входа - небольшая сводка с https://gist.github.com/withr/9001831, так что спасибо за кучу.

Мой код:

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) 

Когда я загрузить приложение это выглядит следующим образом:

Если я затем слегка изменить размер экрана он исправляет себя.

Любые мысли о том, как избежать странного изначальное поведение было бы весьма признателен ..

Answer 1

Я думаю, что проблема может быть исправлена, помещая функцию dashboardSidebar и dashboardBody вне renderUI, так же, как:

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

Он создаст пустую боковую панель и корпус, которые позже вы сможете заполнить, используя функцию renderUI.

Поскольку у вас есть несколько компонентов в «sidebarpanel» вы можете группа затем, заменив функцию dashboardSidebar с div функции:

 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")) 
      ) 
     ) 
     } 
     }) 

Снимите также dashboardBody от «тела» оказывает функцию:

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

Должно возникнуть проблема.

Кстати, можно ли использовать эту аутентификацию для входа в систему?