Authentication in shiny app and multiple pages

问题:

In the system that I am developing I have 3 different actors (user, admin, support team) using Shiny App. I want to know how I can give authentication to these three actors that each of these actor only access to their page. I found that It can be possible with shiny server Pro which is not free. Is there any way to do it instead of using shiny server pro. In the UI.R the code are as following:

  library(shiny)
library(shinydashboard)
rm(list = ls())


Logged = FALSE;
my_username <- "test"
my_password <- "test"

ui1 <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(


  box(




    ui = (htmlOutput("page"))

   )
  )
)

In the Server.R the codes are as following: library(shinydashboard)

library(shiny)

server = (function(input, output,session) {

  ui1 <- function(){
    tagList(
      div(id = "login",
          wellPanel(textInput("userName", "Username"),
                    passwordInput("passwd", "Password"),
                    br(),actionButton("Login", "Log in"))),
      tags$style(type="text/css", "#login {font-size:10px;   text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -100px;margin-left: -150px;}")
    )}

  ui2 <- function(){tagList(tabPanel("Test"))}
  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
            } 
          }
        } 
      }
    }    
  })
  observe({
    if (USER$Logged == FALSE) {

      output$page <- renderUI({
        div(class="outer",do.call(bootstrapPage,c("",ui1())))
      })
    }
    if (USER$Logged == TRUE) 
    {
      output$page <- renderUI({
        div(class="outer",do.call(navbarPage,c(inverse=TRUE,title = "Contratulations you got in!",ui2())))
      })
      print(ui)
    }
  })
})

I want to go to another page that is only authenticated to user . How can I connect the UI.R to different pages in shiny App? (For example show the page USER.R).

回答1:

Try such i think it can help to do what you want

1) ui :

library(shiny)
library(shinydashboard)
shinyUI( 
  dashboardPage(
    dashboardHeader(),
    dashboardSidebar(),
    dashboardBody(

        uiOutput("page")

    )
  )

)

2) server :

    library(shiny)
    library(shinydashboard)
    source("user.R")
    source("admin.R")

    my_username <- c("test","admin")
    my_password <- c("test","123")
    get_role=function(user){
      if(user=="test") {
        return("TEST")
      }else{
        return("ADMIN")
      }
    }

    get_ui=function(role){
      if(role=="TEST"){
        return(list_field_user)
      }else{
        return(list_field_admin)
      }
    }


    shinyServer(function(input, output,session) {

      USER <- reactiveValues(Logged = FALSE,role=NULL)

      ui1 <- function(){
        tagList(
          div(id = "login",
              wellPanel(textInput("userName", "Username"),
                        passwordInput("passwd", "Password"),
                        br(),actionButton("Login", "Log in")))
          ,tags$style(type="text/css", "#login {font-size:10px;   text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -10px;margin-left: -150px;}")
        )}

      ui2 <- function(){list(tabPanel("Test",get_ui(USER$role)[2:3]),get_ui(USER$role)[[1]])}

      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
                  USER$role=get_role(Username)

              }
            } 
          }
        }
        }
      })
      observe({
        if (USER$Logged == FALSE) {

          output$page <- renderUI({
box(
            div(class="outer",do.call(bootstrapPage,c("",ui1()))))
          })
        }
        if (USER$Logged == TRUE)    {
          output$page <- renderUI({
box(width = 12,
            div(class="outer",do.call(navbarPage,c(inverse=TRUE,title = "Contratulations you got in!",ui2())))
          )})
          #print(ui)
        }
      })
    })

3) user.r:

 list_field_user = list(tabPanel("test2",fluidRow(column(6,numericInput("inputtest", "test", value = 0),column(6,actionButton(inputId ="test1",label ="go"))))),
                       h1("1234"),h2("234"))

4) admin.r

list_field_admin = list( h1("admin"),h2("admin"))

!!! place all this files in one dir

that simple example but this can help you