In systats/shinyuser:

library(badger)
# git_repo <- "systats/shinyuser"
# cat(
#   #badge_travis(git_repo),
#   #"[![Codecov test coverage](https://codecov.io/gh/favstats/peRspective/branch/master/graph/badge.svg)](https://codecov.io/gh/favstats/peRspective?branch=master)",
#   badge_code_size(git_repo),
#   badge_last_commit(git_repo),
#   badge_lifecycle("experimental", "blue")
# )

This is a demonstration of how to implement user authentication directly in a shiny app. The core idea is to provide a simple, secure and modularized solution.

Features:

1. User's credentials are saved wherever you want.
2. Clean landing page that overlays any arbitrary layout
3. Basic security features
   • delayed login trialing (5 sec)
   • bcrypt for password encrypton
4. Build with shiny.semantic for clean design patterns
5. Tested with shinyapps.io

Minimal example of shinyuser

library(tidyverse)
library(shiny)
library(shinyjs)
library(shiny.semantic)
library(semantic.dashboard)
library(shinyuser)
library(openssl)
library(bcrypt)

ui <- function(){
  dashboardPage(
    dashboardHeader(
      inverted = T,
      login_ui("user"),
      div(class = "ui circular icon button action-button", id = "user-logout", 
        icon("power off")
      )
    ),
    dashboardSidebar(
      side = "left", size = "", inverted = T,
      sidebarMenu(
        div(class = "item",
          h4(class = "ui inverted header", "Something")
        )
      )
    ),
    dashboardBody(
      div(class = "sixteen wide column",
        "Something great content"
      )
    )
  )
}

server <- function(input, output) {

  users <- reactive({ 
    dplyr::tibble(name = "admin", pw = bcrypt::hashpw("test"))
  })

  user <- callModule(login_server, "user", users)

  observeEvent(user(), {
    observe(print(user()))
  })
}

shinyApp(ui, server)

devtools::document()
devtools::install()

users <- dplyr::tibble(name = c("admin", "admin2"), email = name, pw = bcrypt::hashpw("test")) %>% glimpse

.name = "admin"
.email = ""
.pw = "test"

bcrypt::checkpw(password = .pw, hash = users$pw[2])

known <- users %>% 
  #glimpse %>% 
  dplyr::filter(name == .name | email == .email) %>% 
  # glimpse %>% 
  dplyr::filter(bcrypt::checkpw(password = .pw, hash = pw)) %>% 
  glimpse
            # & #(), 
            #
            )

glimpse(known)

systats/shinyuser documentation built on Oct. 19, 2021, 8:03 a.m.