0

I am developing a shiny dashboard and there are two UIs (say Login,Dashboard). Upon successful login, the dashboard should be displayed. I used this as reference.

But I am unable to navigate to the next page upon successful login.

The UI code used is as follows:

    library(shiny)
    library(shinydashboard)

    `%AND%` <- function (x, y) {
      if (!is.null(x) && !anyNA(x))
        if (!is.null(y) && !anyNA(y))
          return(y)
      return(NULL)
    }

    passwordInputAddon <- function (inputId, label, value = "", placeholder = NULL, addon, width = NULL)
    {
      value <- shiny::restoreInput(id = inputId, default = value)
      htmltools::tags$div(
        class = "form-group shiny-input-container",
        label %AND% htmltools::tags$label(label, `for` = inputId),
        style = if (!is.null(width)) paste0("width: ", htmltools::validateCssUnit(width), ";"),
        htmltools::tags$div(
          style = "margin-bottom: 5px;", class="input-group",
          addon %AND% htmltools::tags$span(class="input-group-addon", addon),
          htmltools::tags$input(
            id = inputId, type = "password", class = "form-control",
            value = value, placeholder = placeholder
          )
        )
      )
    }

    my_username <- "test"
    my_password <- "abc"

ui1 <- function(){

  tagList(
    div(id = "login",
        fluidPage(

          tags$style(".container-fluid {margin-top: 13%}"),
          setBackgroundColor(color = "#2d3c44"),              
          fluidRow(
            column(8, align = "center", offset = 2,
                   textInputAddon("name", label = "", placeholder = "Username", addon = icon("user"),width = "25%"),
                   tags$style(type="text/css", "#string { height: 50px; width: 50%; text-align:center;
                        font-size: 30px; display: block;}")
            )
          ),
          fluidRow(
            column(8, align = "center", offset = 2,
                   passwordInputAddon("password", label = "", placeholder = "Password", addon = icon("key"),width = "25%"),               
                   tags$style(type="text/css", "#string { height: 50px; width: 50%; text-align:center;
                        font-size: 30px; display: block;}")
            )
          ),

          fluidRow(
            column(12, div(style = "height:20px;background-color: #2d3c44;")
            )

          ),

          fluidRow(
            column(6, align = "center", offset = 3,
                   actionButton("login",label = "Login", width = "35%", style = "color: #fff; background-color: #1bc3d7; border-color: #1bc3d7;"))),
          fluidRow(
            column(6, tags$head(tags$style(HTML('#dataInfo{color: red"}'))),
                   align = "center", offset = 3,
                   verbatimTextOutput("dataInfo")))

        )
        )


    )
}

ui2 <- function(){

  tagList(

    dashboardPage(
      dashboardHeader(
        title="Shiny Dashboard",
        tags$li(
          class="dropdown"
        )
      ),
      dashboardSidebar(
        sidebarMenu(
          id = 'dashboard_menu',
          sidebarMenuOutput("menu")

        )
      ),
      dashboardBody(
        tabItems(
          tabItem(tabName="Item1"),
          tabItem(tabName="Item2"),
          tabItem(tabName="Item3")
        )

      ))

  )

}

The server code is as follows:

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

  Logged <- FALSE
  Security <- TRUE

  USER <- reactiveValues(Logged = Logged)
  SEC <- reactiveValues(Security = Security)

  observe({ 
    if (USER$Logged == FALSE) {
      if (!is.null(input$login)) {
        if (input$login > 0) {
          Username <- isolate(input$name)
          Password <- isolate(input$password)
          if(my_username == Username & my_password == Password) {
            USER$Logged <- TRUE
          } else {SEC$Security <- FALSE}
        } 
      }
    }    
  })

  observe({
    if (USER$Logged == FALSE) {({ui1()})}
    if (USER$Logged == TRUE) {({ui2()})}
  })

  observe({
    output$dataInfo <- renderText({
      if (SEC$Security) {""}
      else {"Your username or password is not correct"}
    })
  })
}

I am unable to navigate to another page. There is no error and also the navigation does not take place. I don't know where is the error.

Can anyone solve this issue?

Nevedha Ayyanar
  • 845
  • 9
  • 27

1 Answers1

2

maybe you can use shinymanager package for login? The credentials are in the table

library(shiny)
library(shinymanager)
library(shinydashboard)

# data.frame with credentials info
credentials <- data.frame(
  user = c("Nevedha"),
  password = c("welcome123"),
  stringsAsFactors = FALSE
)

ui <- secure_app(
  dashboardPage(
    dashboardHeader(
      title="Shiny Dashboard",
      tags$li(
        class="dropdown"
      )
    ),
    dashboardSidebar(
      sidebarMenu(
        id = 'dashboard_menu',
        sidebarMenuOutput("menu")

      )
    ),
    dashboardBody(
      tabItems(
        tabItem(tabName="Item1"),
        tabItem(tabName="Item2"),
        tabItem(tabName="Item3")
      )

    ))
)

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

  result_auth <- secure_server(check_credentials = check_credentials(credentials))

  output$res_auth <- renderPrint({
    a <- reactiveValuesToList(result_auth)
    # username
    a$user
  })

  # classic app
  selectedData <- reactive({
    iris[, c(input$xcol, input$ycol)]
  })

  clusters <- reactive({
    kmeans(selectedData(), input$clusters)
  })

  output$plot1 <- renderPlot({
    palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3",
              "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))

    par(mar = c(5.1, 4.1, 0, 1))
    plot(selectedData(),
         col = clusters()$cluster,
         pch = 20, cex = 3)
    points(clusters()$centers, pch = 4, cex = 4, lwd = 4)
  })
}

shinyApp(ui = ui, server = server)

enter image description here

Pork Chop
  • 28,528
  • 5
  • 63
  • 77
  • How can I get the user name and password from the login? – Nevedha Ayyanar Oct 08 '19 at 09:11
  • `a <- reactiveValuesToList(result_auth)` and `a$user` should have the user – Pork Chop Oct 08 '19 at 09:17
  • My requirement is, based on the user name, I need to restrict the tabs in the dashboard. Say for instance, for the user name Nevedha, some 2 views should be displayed. So I used `if(a()$user == "Nevedha"){ ...}` . But I don't get the desired output – Nevedha Ayyanar Oct 08 '19 at 09:41