I am trying to add log in options for my Shiny app, and currently trying out the solution here: https://www.r-craft.org/r-news/how-to-build-login-page-in-r-shiny-app/
I modified the code a little bit (marked with comments below), but run into issues. The tabs in the body area have a wrong position towards right. I think it maybe caused by dashboardBody() got called twice, but I don't know where to start if I want to avoid calling it twice. Any advice is appreciated!
library(shiny)
library(shinydashboard)
library(DT)
library(shinyjs)
library(sodium)
# Main login screen
loginpage <- div(id = "loginpage",
style = "width: 500px; max-width: 100%; margin: 0 auto; padding: 20px;",
wellPanel(
tags$h2("LOG IN", class = "text-center", style = "padding-top: 0;color:#333; font-weight:600;"),
textInput("userName", placeholder="Username", label = tagList(icon("user"), "Username")),
passwordInput("passwd", placeholder="Password", label = tagList(icon("unlock-alt"), "Password")),
br(),
div(
style = "text-align: center;",
actionButton("login", "SIGN IN", style = "color: white; background-color:#3c8dbc;
padding: 10px 15px; width: 150px; cursor: pointer;
font-size: 18px; font-weight: 600;"),
shinyjs::hidden(
div(id = "nomatch",
tags$p("Oops! Incorrect username or password!",
style = "color: red; font-weight: 600;
padding-top: 5px;font-size:16px;",
class = "text-center"))),
br(),
br(),
tags$code("Username: myuser Password: mypass"),
br(),
tags$code("Username: myuser1 Password: mypass1")
))
)
credentials = data.frame(
username_id = c("myuser", "myuser1"),
passod = sapply(c("mypass", "mypass1"),password_store),
permission = c("basic", "advanced"),
stringsAsFactors = F
)
header <- dashboardHeader(
title = h3(HTML("ABC")),
tags$li(class = "dropdown",
tags$style(".main-header .logo {height: 100px}")
),
#User
tags$li(
class = "dropdown",
a(tags$img
(
height = "70px",
width = "45px",
src="Pic.png",
style = "margin-top:50px cursor: pointer;"
)
)
),
#Logo
tags$li(
class = "dropdown",
a(tags$img
(
height = "70px",
width = "200px",
src="Pic.png",
style = "margin-left:-10px; cursor: pointer;"
)
)
),
tags$li(
class = "dropdown",
a(tags$img
(
height = "95px",
width = "948.7px",
src="Pic.png",
style = "margin:-1em"
)
)
)
)
sidebar <- dashboardSidebar(uiOutput("sidebarpanel"))
body <- dashboardBody(uiOutput("body"))
ui<-dashboardPage(header,
sidebar,
body,
skin = "blue",
tags$head(tags$style(HTML("
.skin-blue .main-sidebar {
background-color: white;
}")))
)
server <- function(input, output, session) {
login = FALSE
USER <- reactiveValues(login = login)
observe({
if (USER$login == FALSE) {
if (!is.null(input$login)) {
if (input$login > 0) {
Username <- isolate(input$userName)
Password <- isolate(input$passwd)
if(length(which(credentials$username_id==Username))==1) {
pasmatch <- credentials["passod"][which(credentials$username_id==Username),]
pasverify <- password_verify(pasmatch, Password)
if(pasverify) {
USER$login <- TRUE
} else {
shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade")
shinyjs::delay(3000, shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade"))
}
} else {
shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade")
shinyjs::delay(3000, shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade"))
}
}
}
}
})
output$sidebarpanel <- renderUI({
if (USER$login == TRUE ){
dashboardSidebar(
hr(),
hr(),
selectInput('name', 'Name', c("Andrew"), multiple = FALSE , selected = "Andrew")
)
}
})
output$body <- renderUI({
if (USER$login == TRUE ) {
dashboardBody(
tabsetPanel(# change the position to be a little bit left
tabPanel("Tab",
tabsetPanel(
tabPanel(
"SubpannelA",
img(
height = "450px",
width = "1250px",
src="Image.png",
align = "left")
),
tabPanel(
"SubpannelB",
fluidRow(column(width = 6))
),
tabPanel(
"SubpannelC",
fluidRow(column(width = 6))
)
)
))
)
}
else {
loginpage
}
})
output$results <- DT::renderDataTable({
datatable(iris, options = list(autoWidth = TRUE,
searching = FALSE))
})
}
runApp(list(ui = ui, server = server), launch.browser = TRUE)
Thank you!