Luego de consultar con especialistas en la materia, programadores de diversas ramas y profesores hemos dado con la respuesta al dilema y la compartimos en esta publicación.
Solución:
ShinyProxy, un servidor Shiny de código abierto basado en Docker y Spring Java, fue diseñado para solucionar este problema. Le permite codificar usuarios en el archivo de configuración de la aplicación, conectarse a un servidor LDAP, usar SSO/Keycloak o iniciar sesión en una red social.
Aquí hay un ejemplo de cómo usar cookies para la autenticación. Más información se puede encontrar en mi blog aquí.
Primero descargue la cookie js a la carpeta www/:
if (!dir.exists('www/'))
dir.create('www')
download.file(
url = 'https://cdn.jsdelivr.net/npm/[email protected]/src/js.cookie.min.js',
destfile = 'www/js.cookies.js'
)
Instale los paquetes necesarios:
install.packages(c('shiny', 'shinyjs', 'bcrypt'))
Guarde el siguiente código como app.R y haga clic en el botón “Ejecutar aplicación”:
library(shiny)
library(shinyjs)
library(bcrypt)
# This would usually come from your user database.
# Never store passwords as clear text
password_hash <- hashpw('secret123')
# Our not so random sessionid
# sessionid <- paste(
# collapse = '',
# sample(x = c(letters, LETTERS, 0:9), size = 64, replace = TRUE)
# )
sessionid <- "OQGYIrpOvV3KnOpBSPgOhqGxz2dE5A9IpKhP6Dy2kd7xIQhLjwYzskn9mIhRAVHo"
jsCode <- '
shinyjs.getcookie = function(params)
var cookie = Cookies.get("id");
if (typeof cookie !== "undefined")
Shiny.onInputChange("jscookie", cookie);
else
var cookie = "";
Shiny.onInputChange("jscookie", cookie);
shinyjs.setcookie = function(params)
Cookies.set("id", escape(params), expires: 0.5 );
Shiny.onInputChange("jscookie", params);
shinyjs.rmcookie = function(params)
Cookies.remove("id");
Shiny.onInputChange("jscookie", "");
'
server <- function(input, output)
status <- reactiveVal(value = NULL)
# check if a cookie is present and matching our super random sessionid
observe(
js$getcookie()
if (!is.null(input$jscookie) &&
input$jscookie == sessionid)
status(paste0('in with sessionid ', input$jscookie))
else
status('out')
)
observeEvent(input$login,
if (input$username == 'admin' &
checkpw(input$password, hash = password_hash))
# generate a sessionid and store it in your database,
# sessionid <- paste(
# collapse = '',
# sample(x = c(letters, LETTERS, 0:9), size = 64, replace = TRUE)
# )
# but we keep it simple in this example...
js$setcookie(sessionid)
else
status('out, cause you don't know the password secret123 for user admin.')
)
observeEvent(input$logout,
status('out')
js$rmcookie()
)
output$output <- renderText(
paste0('You are logged ', status())
)
ui <- fluidPage(
tags$head(
tags$script(src = "js.cookies.js")
),
useShinyjs(),
extendShinyjs(text = jsCode),
sidebarLayout(
sidebarPanel(
textInput('username', 'User', placeholder = 'admin'),
passwordInput('password', 'Password', placeholder = 'secret123'),
actionButton('login', 'Login'),
actionButton('logout', 'Logout')
),
mainPanel(
verbatimTextOutput('output')
)
)
)
shinyApp(ui = ui, server = server)
Bueno, puedes hacerlo a través del código usando renderUI y cambiar la interfaz de usuario sobre la marcha. Aquí hay un ejemplo de cómo hacerlo:
library(shiny)
library(ggplot2)
u <- shinyUI(fluidPage(
titlePanel("Shiny Password"),
sidebarLayout(position = "left",
sidebarPanel( h3("sidebar panel"),
uiOutput("in.pss"),
uiOutput("in.clr"),
uiOutput("in.titl"),
uiOutput("in.cnt"),
uiOutput("in.seed")
),
mainPanel(h3("main panel"),
textOutput('echo'),
plotOutput('stdplot')
)
)
))
pok <- F
s <- shinyServer(function(input, output)
output$in.pss <- renderUI( input$pss; if (pok) return(NULL) else return(textInput("pss","Password:","")) )
output$in.clr <- renderUI( input$pss; if (pok) return(selectInput("clr","Color:",c("red","blue"))) else return(NULL) )
output$in.titl <- renderUI( input$pss; if (pok) return(textInput("titl","Title:","Data")) else return(NULL) )
output$in.cnt <- renderUI( input$pss; if (pok) return(sliderInput("cnt","Count:",100,1000,500,5)) else return(NULL) )
output$in.seed <- renderUI( input$pss; if (pok) return(numericInput("seed","Seed:",1234,1,10000,1)) else return(NULL) )
histdata <- reactive(
input$pss;
validate(need(input$cnt,"Need count"),need(input$seed,"Need seed"))
set.seed(input$seed)
df <- data.frame(x=rnorm(input$cnt))
)
observe(
if (!pok)
password <- input$pss
if (!is.null(password) && password == "pass")
pok <<- TRUE
)
output$echo = renderText(
if (pok)
s <- sprintf("the %s is %s and has %d rows and uses the %d seed",
input$ent,input$clr,nrow(histdata()),input$seed)
else
s <- ""
return(s)
)
output$stdplot = renderPlot(
input$pss
if (pok)
return(qplot(data = histdata(),x,fill = I(input$clr),binwidth = 0.2,main=input$titl))
else
return(NULL)
)
)
shinyApp(ui=u,server=s)
rendimientos
esto al iniciar sesión:
Y esto una vez que haya ingresado la contraseña codificada "pasar".
Por supuesto, programar de esta manera es un poco incómodo, pero podría usar pestañas y ocultarlas quizás usando una lógica similar.
O si está utilizando shinyServer, probablemente podría poner un filtro delante del sitio. Pero así es como lo abordaría en Shiny.
Si sostienes algún duda y forma de avanzar nuestro ensayo puedes dejar una apostilla y con placer lo estudiaremos.