├── .DS_Store ├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── NAMESPACE ├── R ├── cookies.R ├── helper.R ├── login_mod.R ├── recovery_mod.R ├── semantic_inputs.R ├── theme_mod.R └── utils-pipe.R ├── README.md ├── Readme.Rmd ├── app.R ├── app_test.R ├── man ├── clickjs.Rd ├── create_cookie.Rd ├── form_login.Rd ├── js_cookies.Rd ├── js_for_toggle_input.Rd ├── login_server.Rd ├── login_ui.Rd ├── multiple_checkbox.Rd ├── pipe.Rd ├── simple_checkbox.Rd ├── toggle_input.Rd └── toggle_slider.Rd ├── rsconnect └── shinyapps.io │ └── systats │ └── shinyuser.dcf ├── shinyuser.Rproj └── www ├── layout.css └── shiny.jpeg /.DS_Store: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/systats/shinyuser/d9bd6cffae88cb1a6ba379c863a027e675077bbe/.DS_Store -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.secrets$ 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | .db 6 | .secrets 7 | .DS_Store 8 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: shinyuser 2 | Title: What the Package Does (one line, title case) 3 | Version: 0.0.0.9000 4 | Authors@R: person("First", "Last", email = "first.last@example.com", role = c("aut", "cre")) 5 | Description: What the package does (one paragraph). 6 | Depends: R (>= 3.6.0) 7 | License: What license is it under? 8 | Encoding: UTF-8 9 | LazyData: true 10 | RoxygenNote: 7.1.1 11 | Imports: 12 | shiny, 13 | R6, 14 | purrr, 15 | dplyr, 16 | stringr, 17 | magrittr 18 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export("%>%") 4 | export(clickjs) 5 | export(create_cookie) 6 | export(form_login) 7 | export(js_cookies) 8 | export(js_for_toggle_input) 9 | export(login_server) 10 | export(login_ui) 11 | export(multiple_checkbox) 12 | export(simple_checkbox) 13 | export(toggle_input) 14 | export(toggle_slider) 15 | importFrom(magrittr,"%>%") 16 | -------------------------------------------------------------------------------- /R/cookies.R: -------------------------------------------------------------------------------- 1 | #' https://gist.github.com/calligross/e779281b500eb93ee9e42e4d72448189 2 | #' js_cookies 3 | #' @export 4 | js_cookies <- ' 5 | shinyjs.getcookie = function(params) { 6 | var cookie = Cookies.get("id"); 7 | if (typeof cookie !== "undefined") { 8 | Shiny.onInputChange("user-jscookie", cookie); 9 | } else { 10 | var cookie = ""; 11 | Shiny.onInputChange("user-jscookie", cookie); 12 | } 13 | } 14 | shinyjs.setcookie = function(params) { 15 | Cookies.set("id", escape(params), { expires: 0.5 }); 16 | Shiny.onInputChange("user-jscookie", params); 17 | } 18 | shinyjs.rmcookie = function(params) { 19 | Cookies.remove("id"); 20 | Shiny.onInputChange("user-jscookie", ""); 21 | } 22 | ' 23 | 24 | #' create_cookie 25 | #' @export 26 | create_cookie <- function(user, pw){ 27 | # timestamp <- lubridate::ceiling_date(lubridate::now(), "1 day") 28 | openssl::sha1(paste(user, pw, sep = "_")) 29 | } -------------------------------------------------------------------------------- /R/helper.R: -------------------------------------------------------------------------------- 1 | #' simple_checkbox 2 | #' @export 3 | simple_checkbox <- function(id, label, type = "", is_marked = TRUE, style = NULL) { 4 | if (!(type %in% checkbox_types)) { 5 | stop("Wrong type selected. Please check checkbox_types for possibilities.") 6 | } 7 | value <- if (is_marked) { 8 | "true" 9 | } else { 10 | "false" 11 | } 12 | selector <- paste0(".checkbox.", id) 13 | shiny::tagList( 14 | shiny_text_input(id, tags$input(type = "text", style = "display:none"), value = value), 15 | div( 16 | style = style, 17 | class = paste("ui checkbox", type, id), 18 | tags$input(type = "checkbox", tags$label(label)) 19 | ), 20 | tags$script(js_for_toggle_input(selector, id)), 21 | if (value == "true") tags$script(paste0("$('", selector, "').checkbox('set checked')")) else NULL 22 | ) 23 | } 24 | 25 | #' js_for_toggle_input 26 | #' @export 27 | js_for_toggle_input <- function(selector, input_id) { 28 | paste0("$('", selector, "').checkbox({ 29 | onChecked: function() { 30 | $('#", input_id, "').val('true'); 31 | $('#", input_id, "').change(); 32 | }, 33 | onUnchecked: function() { 34 | $('#", input_id, "').val('false'); 35 | $('#", input_id, "').change(); 36 | }});") 37 | } 38 | 39 | 40 | #' multiple_checkbox 41 | #' @export 42 | multiple_checkbox <- function(input_id, label, choices, selected = NULL, 43 | position = "grouped", type = "radio", ...) { 44 | 45 | if (missing(input_id) || missing(label) || missing(choices)) { 46 | stop("Each of input_id, label and choices must be specified") 47 | } 48 | 49 | if (!(position %in% checkbox_positions)) { 50 | stop("Wrong position selected. Please check checkbox_positions for possibilities.") 51 | } 52 | 53 | if (!(type %in% checkbox_types)) { 54 | stop("Wrong type selected. Please check checkbox_types for possibilities.") 55 | } 56 | 57 | choices_values <- choices 58 | 59 | if (!is.null(selected) && !(selected %in% choices_values)) { 60 | stop("choices must include selected value.") 61 | } 62 | 63 | if (is.null(selected)) { 64 | selected <- choices[[1]] 65 | } 66 | 67 | slider_field <- function(label, value, checked, type) { 68 | field_id <- generate_random_id("slider", 10) 69 | 70 | if (checked) { 71 | checked <- "checked" 72 | } else { 73 | checked <- NULL 74 | } 75 | uifield( 76 | uicheckbox(type = type, id = field_id, 77 | tags$input(type = "radio", name = "field", 78 | checked = checked, value = value), 79 | tags$label(label) 80 | ) 81 | ) 82 | } 83 | 84 | checked <- as.list(choices %in% selected) 85 | values <- choices 86 | labels <- as.list(names(choices)) 87 | checkbox_id <- sprintf("checkbox_%s", input_id) 88 | 89 | div(..., 90 | id = checkbox_id, 91 | shiny_text_input(input_id, tags$input(type = "text", style = "display:none"), 92 | value = selected), 93 | uiform( 94 | div(class = sprintf("%s fields", position), 95 | tags$label(label), 96 | purrr::pmap(list(labels, values, checked), slider_field, type = type) %>% 97 | shiny::tagList() 98 | ) 99 | ), 100 | tags$script(paste0("$('#", checkbox_id, " .checkbox').checkbox({ 101 | onChecked: function() { 102 | var childCheckboxValue = $(this).closest('.checkbox').find('.checkbox').context.value; 103 | $('#", input_id, "').val(childCheckboxValue); 104 | $('#", input_id, "').change(); 105 | } 106 | });")) 107 | ) 108 | } 109 | -------------------------------------------------------------------------------- /R/login_mod.R: -------------------------------------------------------------------------------- 1 | #' form_login 2 | #' @export 3 | form_login <- function(id, test){ 4 | ns <- NS(id) 5 | div(class = "ui form", 6 | div(class = "field", 7 | div(class = "ui left icon input", id = ns("frame_user"), 8 | HTML(''), 9 | shiny::tags$input(id = ns("name"), type = "text", value = ifelse(test, "admin", "") , placeholder = "Username or Email") 10 | ) 11 | ), 12 | div(class = "field", 13 | div(class = "ui left icon input", id = ns("frame_pw"), 14 | HTML(''), 15 | shiny::tags$input(id = ns("pw"), type = "password", value = ifelse(test, "test", "") , placeholder = "Password") 16 | ) 17 | ), 18 | div(class = "ui fluid button action-button", id = ns("login"), HTML('')) 19 | ) 20 | } 21 | 22 | #' clickjs 23 | #' @export 24 | clickjs <- '$(document).keyup(function(event) { 25 | if (event.key == "Enter") { 26 | $("#user-login").click(); 27 | } 28 | });' 29 | 30 | 31 | #' login_ui 32 | #' @export 33 | login_ui <- function(id, head = NULL, tail = NULL, test = F){ 34 | 35 | ns <- NS(id) 36 | 37 | tagList( 38 | tags$head( 39 | tags$script(src = "https://cdn.jsdelivr.net/npm/js-cookie@2/src/js.cookie.min.js") 40 | ), 41 | shinyjs::useShinyjs(), 42 | extendShinyjs(text = js_cookies, functions = c("getcookie","setcookie","rmcookie")), 43 | div(class = "ui inverted active page dimmer", id = ns("buffer"), 44 | style = "background-color:#e0e1e2;", 45 | div(class="ui text loader", "Loading Data") 46 | ), 47 | hidden( 48 | div(class = "ui inverted active page dimmer", id = ns("checkin"), 49 | style = "background-color:#e0e1e2;", 50 | div(class = "ui card", align = "left", style = "width:400px;", 51 | div(class = "content", 52 | head, 53 | div(class="ui accordion", id = "checkin_options", 54 | div(class = "active title", id = "default_title", 55 | HTML(''), 56 | "Login" 57 | ), 58 | div(class="active content", id = "default_content", 59 | form_login(id, test = test) 60 | ), 61 | 62 | div(class = "title", id = "title2", 63 | HTML(''), 64 | "Forgot your password?" 65 | ), 66 | div(class="content", id = "content2", 67 | recovery_ui(ns("recovery")) 68 | ) 69 | ) 70 | ) 71 | ) 72 | ) 73 | ), 74 | shiny::tags$script("$('.ui.accordion').accordion();"), 75 | # https://stackoverflow.com/questions/32335951/using-enter-key-with-action-button-in-r-shiny 76 | shiny::tags$script(clickjs) 77 | ) 78 | } 79 | 80 | 81 | #' login_server 82 | #' @export 83 | login_server <- function(input, output, session, users, delay = 5){ 84 | 85 | callModule(recovery_server, "recovery") 86 | 87 | observe({ 88 | shinyjs::show("buffer") 89 | shinyjs::show("checkin") 90 | }) 91 | 92 | user <- eventReactive(input$login, { 93 | req(users()) 94 | 95 | 96 | # glimpse(users()) 97 | 98 | known <- users() %>% 99 | dplyr::filter(name == input$name | email == input$name) %>% 100 | dplyr::filter(bcrypt::checkpw(password = input$pw, hash = pw)) %>% 101 | dplyr::mutate(status = 1) 102 | 103 | # glimpse(known) 104 | 105 | if(nrow(known) == 0){ 106 | shinyjs::addCssClass("login", "disabled") 107 | shinyjs::delay(5000, shinyjs::removeCssClass("login", "disabled")) 108 | shinyjs::runjs("$('#user-checkin').transition('shake');") 109 | return(NULL) 110 | } 111 | 112 | shinyjs::hide("checkin") 113 | shinyjs::hide("buffer") 114 | 115 | return(known) 116 | }) 117 | 118 | 119 | observeEvent( input$logout ,{ 120 | print(glue::glue("Logged out")) 121 | shinyjs::runjs("history.go(0);") 122 | }) 123 | 124 | 125 | return(user) 126 | } 127 | -------------------------------------------------------------------------------- /R/recovery_mod.R: -------------------------------------------------------------------------------- 1 | recovery_ui <- function(id){ 2 | ns <- NS(id) 3 | tagList( 4 | br(), 5 | p("What is your Email Adress?"), 6 | div(class = "ui grid", 7 | div(class = "ten wide column", 8 | div(class = "ui left icon input", 9 | HTML(''), 10 | shiny::tags$input(id = ns("email"), type = "text", value="" , placeholder="email") 11 | ) 12 | 13 | ), 14 | div(class = "one wide column", 15 | action_button(ns("send"), label = "send") 16 | ) 17 | ), 18 | br(), 19 | uiOutput(ns("code")), 20 | br(), 21 | uiOutput(ns("passwords")) 22 | ) 23 | } 24 | 25 | recovery_server <- function(input, output, session){ 26 | 27 | 28 | email_code <- reactive({ 29 | paste0( 30 | sample(0:9, size = 1), 31 | sample(0:9, size = 1), 32 | sample(0:9, size = 1), 33 | sample(0:9, size = 1) 34 | ) 35 | }) 36 | 37 | 38 | email <- eventReactive(input$send, { 39 | if(str_detect(input$email, "^[[:alnum:].-_]+@[[:alnum:].-]+$")){ 40 | input$email 41 | } else { 42 | NULL 43 | } 44 | }) 45 | 46 | 47 | output$code <- renderUI({ 48 | if(is.null(email())){ 49 | tagList("") 50 | } else { 51 | tagList( 52 | p("We sent you an 4 number code to", br(), strong(email()), br(), 53 | "Please check now your mail"), 54 | div(class = "ui grid", 55 | div(class = "ten wide column", 56 | div(class = "ui left icon input", 57 | HTML(''), 58 | shiny::tags$input(id = session$ns("lock"), type = "text", value="" , placeholder="secure code") 59 | ) 60 | 61 | ), 62 | div(class = "one wide column", 63 | action_button(session$ns("verify"), label = "verify") 64 | ) 65 | ) 66 | ) 67 | } 68 | }) 69 | 70 | 71 | observe({ 72 | print(input$send) 73 | print(input$email) 74 | print(str_detect(input$email, "^[[:alnum:].-_]+@[[:alnum:].-]+$")) 75 | print(email()) 76 | print(email_code()) 77 | }) 78 | 79 | verified <- eventReactive(input$verify, { 80 | if(email_code() == input$lock){ 81 | "verified" 82 | } else { 83 | "not veriefied" 84 | } 85 | }) 86 | 87 | observe({ 88 | print(verified()) 89 | }) 90 | 91 | 92 | output$passwords <- renderUI({ 93 | 94 | if(verified() != "verified"){ 95 | tagList("") 96 | } else { 97 | tagList( 98 | p("Please provide twice the same new password"), 99 | div(class = "ui grid", 100 | div(class = "ten wide column", 101 | div(class = "ui left icon input", 102 | HTML(''), 103 | shiny::tags$input(id = session$ns("pw1"), type = "password", value = "" , placeholder = "Secret") 104 | ), 105 | br(), 106 | br(), 107 | div(class = "ui left icon input", 108 | HTML(''), 109 | shiny::tags$input(id = session$ns("pw2"), type = "password", value = "" , placeholder = "Secret") 110 | ) 111 | 112 | ), 113 | div(class = "one wide column", 114 | br(), 115 | br(), 116 | br(), 117 | action_button(session$ns("change"), label = "change") 118 | ) 119 | ) 120 | ) 121 | } 122 | 123 | }) 124 | 125 | outputOptions(output, "code", suspendWhenHidden = FALSE) 126 | outputOptions(output, "passwords", suspendWhenHidden = FALSE) 127 | } -------------------------------------------------------------------------------- /R/semantic_inputs.R: -------------------------------------------------------------------------------- 1 | #' toggle_input 2 | #' @export 3 | toggle_input <- function(id, label = NULL, fitted = F, checked = F, class = NULL){ 4 | fit <- NULL 5 | check <- NULL 6 | if (fitted) fit <- "fitted" 7 | if (checked) check <- "checked" 8 | variation <- paste("ui", fit, "toggle checkbox", sep = " ") 9 | 10 | if (!is.null(class)) 11 | variation <- class 12 | htmltools::tagList(htmltools::div(class = variation, htmltools::tags$input(id = id, type = "checkbox", checked = check), htmltools::tags$label(label, style = "color:white;"))) 13 | } 14 | 15 | #' toggle_slider 16 | #' @export 17 | toggle_slider <- function(id, label = NULL, fitted = F, checked = F, class = NULL){ 18 | fit <- NULL 19 | check <- NULL 20 | if (fitted) fit <- "fitted" 21 | if (checked) check <- "checked" 22 | variation <- paste("ui", fit, "slider checkbox", sep = " ") 23 | 24 | if (!is.null(class)) 25 | variation <- class 26 | htmltools::tagList(htmltools::div(class = variation, htmltools::tags$input(id = id, type = "checkbox", checked = check), htmltools::tags$label(label, style = "color:white;"))) 27 | } 28 | -------------------------------------------------------------------------------- /R/theme_mod.R: -------------------------------------------------------------------------------- 1 | #' #' theme_ui 2 | #' #' https://stackoverflow.com/questions/19844545/replacing-css-file-on-the-fly-and-apply-the-new-style-to-the-page 3 | #' theme_ui <- function(id){ 4 | #' ns <- NS(id) 5 | #' tagList( 6 | #' span(textOutput(ns("type"), inline = T), style="margin-right:.5cm"), 7 | #' toggle_slider(ns("daynight"), label = "", checked = F) 8 | #' #dropdown(ns("theme"), choices = c("default", shiny.semantic::SUPPORTED_THEMES), value = "default") 9 | #' ) 10 | #' } 11 | #' 12 | #' #' list_themes 13 | #' list_themes <- shiny.semantic::SUPPORTED_THEMES %>% 14 | #' purrr::set_names(shiny.semantic::SUPPORTED_THEMES) %>% 15 | #' purrr::imap(~ glue::glue("https://d335w9rbwpvuxm.cloudfront.net/semantic.{.x}.min.css")) %>% 16 | #' c(list("default" = "https://d335w9rbwpvuxm.cloudfront.net/semantic.min.css")) 17 | #' 18 | #' 19 | #' #' theme_server 20 | #' 21 | #' theme_server <- function(input, output, session){ 22 | #' 23 | #' # observeEvent(input$daynight, { 24 | #' # if(input$daynight){ 25 | #' # runjs(glue::glue("setStyleSheet('{list_themes[['cyborg']]}')")) 26 | #' # } else { 27 | #' # runjs(glue::glue("setStyleSheet('{list_themes[['default']]}')")) 28 | #' # } 29 | #' # }) 30 | #' 31 | #' default <- "https://d335w9rbwpvuxm.cloudfront.net/semantic.min.css" 32 | #' dark <- "https://d335w9rbwpvuxm.cloudfront.net/semantic.cyborg.min.css" 33 | #' 34 | #' observeEvent(input$daynight, { 35 | #' req(input$daynight) 36 | #' if(input$daynight){ 37 | #' shinyjs::runjs(glue::glue('$("link[src=""]").attr("src","");', .open = "<", .close = ">")) 38 | #' } else { 39 | #' shinyjs::runjs(glue::glue('$("link[src=""]").attr("src","");', .open = "<", .close = ">")) 40 | #' } 41 | #' }) 42 | #' 43 | #' output$type <- renderText({ 44 | #' #req(input$daynight) 45 | #' if(is.null(input$daynight)) return("Hell") 46 | #' if(input$daynight){ 47 | #' "Dunkel" 48 | #' } else { 49 | #' "Hell" 50 | #' } 51 | #' }) 52 | #' 53 | #' outputOptions(output, "type", suspendWhenHidden = F) 54 | #' } -------------------------------------------------------------------------------- /R/utils-pipe.R: -------------------------------------------------------------------------------- 1 | #' Pipe operator 2 | #' 3 | #' See \code{magrittr::\link[magrittr]{\%>\%}} for details. 4 | #' 5 | #' @name %>% 6 | #' @rdname pipe 7 | #' @keywords internal 8 | #' @export 9 | #' @importFrom magrittr %>% 10 | #' @usage lhs \%>\% rhs 11 | NULL 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | shinyuser 2 | ================ 3 | 4 | This is a demonstration of how to implement user authentication directly 5 | in a shiny app. The core idea is to provide a simple, secure and 6 | modularized solution. 7 | 8 | Features: 9 | 10 | 1. User’s credentials are saved wherever you want. 11 | 2. Clean landing page that overlays any arbitrary layout 12 | 3. Basic security features 13 | - delayed login trialing (5 sec) 14 | 15 | - `bcrypt` for password encrypton 16 | 17 | 4. Build with 18 | [shiny.semantic](https://github.com/Appsilon/shiny.semantic) for 19 | clean design patterns 20 | 5. Tested with shinyapps.io 21 | 22 | Minimal example of `shinyuser` 23 | 24 | ``` r 25 | library(tidyverse) 26 | library(shiny) 27 | library(shinyjs) 28 | library(shiny.semantic) 29 | library(semantic.dashboard) 30 | library(shinyuser) 31 | library(openssl) 32 | library(bcrypt) 33 | 34 | ui <- function(){ 35 | dashboardPage( 36 | dashboardHeader( 37 | inverted = T, 38 | login_ui("user"), 39 | div(class = "ui circular icon button action-button", id = "user-logout", 40 | icon("power off") 41 | ) 42 | ), 43 | dashboardSidebar( 44 | side = "left", size = "", inverted = T, 45 | sidebarMenu( 46 | div(class = "item", 47 | h4(class = "ui inverted header", "Something") 48 | ) 49 | ) 50 | ), 51 | dashboardBody( 52 | div(class = "sixteen wide column", 53 | "Something great content" 54 | ) 55 | ) 56 | ) 57 | } 58 | 59 | server <- function(input, output) { 60 | 61 | users <- reactive({ 62 | dplyr::tibble(name = "admin", pw = bcrypt::hashpw("test")) 63 | }) 64 | 65 | user <- callModule(login_server, "user", users) 66 | 67 | observeEvent(user(), { 68 | observe(print(user())) 69 | }) 70 | } 71 | 72 | shinyApp(ui, server) 73 | ``` 74 | 75 | 76 | -------------------------------------------------------------------------------- /Readme.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "shinyuser" 3 | output: github_document 4 | --- 5 | 6 | 7 | ```{r, echo = FALSE, results='asis', eval = T, eval = T, message=F, warning=F} 8 | library(badger) 9 | # git_repo <- "systats/shinyuser" 10 | # cat( 11 | # #badge_travis(git_repo), 12 | # #"[![Codecov test coverage](https://codecov.io/gh/favstats/peRspective/branch/master/graph/badge.svg)](https://codecov.io/gh/favstats/peRspective?branch=master)", 13 | # badge_code_size(git_repo), 14 | # badge_last_commit(git_repo), 15 | # badge_lifecycle("experimental", "blue") 16 | # ) 17 | ``` 18 | 19 | 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. 20 | 21 | Features: 22 | 23 | 1. User's credentials are saved wherever you want. 24 | 2. Clean landing page that overlays any arbitrary layout 25 | 3. Basic security features 26 | + delayed login trialing (5 sec) 27 | 28 | + `bcrypt` for password encrypton 29 | 30 | 4. Build with [shiny.semantic](https://github.com/Appsilon/shiny.semantic) for clean design patterns 31 | 5. Tested with shinyapps.io 32 | 33 | 34 | Minimal example of `shinyuser` 35 | 36 | ```{r, eval = F} 37 | library(tidyverse) 38 | library(shiny) 39 | library(shinyjs) 40 | library(shiny.semantic) 41 | library(semantic.dashboard) 42 | library(shinyuser) 43 | library(openssl) 44 | library(bcrypt) 45 | 46 | ui <- function(){ 47 | dashboardPage( 48 | dashboardHeader( 49 | inverted = T, 50 | login_ui("user"), 51 | div(class = "ui circular icon button action-button", id = "user-logout", 52 | icon("power off") 53 | ) 54 | ), 55 | dashboardSidebar( 56 | side = "left", size = "", inverted = T, 57 | sidebarMenu( 58 | div(class = "item", 59 | h4(class = "ui inverted header", "Something") 60 | ) 61 | ) 62 | ), 63 | dashboardBody( 64 | div(class = "sixteen wide column", 65 | "Something great content" 66 | ) 67 | ) 68 | ) 69 | } 70 | 71 | server <- function(input, output) { 72 | 73 | users <- reactive({ 74 | dplyr::tibble(name = "admin", pw = bcrypt::hashpw("test")) 75 | }) 76 | 77 | user <- callModule(login_server, "user", users) 78 | 79 | observeEvent(user(), { 80 | observe(print(user())) 81 | }) 82 | } 83 | 84 | shinyApp(ui, server) 85 | ``` 86 | 87 | 88 | 89 | 90 | ```{r} 91 | devtools::document() 92 | devtools::install() 93 | ``` 94 | 95 | 96 | 97 | ```{r} 98 | users <- dplyr::tibble(name = c("admin", "admin2"), email = name, pw = bcrypt::hashpw("test")) %>% glimpse 99 | 100 | .name = "admin" 101 | .email = "" 102 | .pw = "test" 103 | 104 | bcrypt::checkpw(password = .pw, hash = users$pw[2]) 105 | 106 | known <- users %>% 107 | #glimpse %>% 108 | dplyr::filter(name == .name | email == .email) %>% 109 | # glimpse %>% 110 | dplyr::filter(bcrypt::checkpw(password = .pw, hash = pw)) %>% 111 | glimpse 112 | # & #(), 113 | # 114 | ) 115 | 116 | glimpse(known) 117 | ``` 118 | 119 | -------------------------------------------------------------------------------- /app.R: -------------------------------------------------------------------------------- 1 | # devtools::document() 2 | # devtools::install() 3 | 4 | library(dplyr) 5 | library(stringr) 6 | library(purrr) 7 | library(jsonlite) 8 | library(R6) 9 | library(shiny.semantic) 10 | library(shiny) 11 | library(shinyjs) 12 | library(semantic.dashboard) 13 | library(googlesheets4) 14 | library(gargle) 15 | library(bcrypt) 16 | 17 | # remotes::install_github("rstudio/reactlog") 18 | # library(reactlog) 19 | # reactlog_enable() 20 | 21 | # # designate project-specific cache 22 | # options(gargle_oauth_cache = ".secrets") 23 | # # check the value of the option, if you like 24 | # gargle::gargle_oauth_cache() 25 | # # trigger auth on purpose to store a token in the specified cache 26 | # # a broswer will be opened 27 | # googlesheets4::sheets_auth() 28 | # sheets_auth( 29 | # cache = ".secrets", 30 | # email = "symonroth@gmail.com" 31 | # ) 32 | 33 | dir("R", full.names = T) %>% purrr::walk(source) 34 | 35 | ui <- function(){ 36 | dashboardPage( 37 | dashboardHeader( 38 | inverted = T, 39 | login_ui("user", test = T), 40 | #tail = a(href="https://www.google.de", target="_blank", "Forgot your password?")), 41 | div(class = "ui circular icon button action-button", id = "user-logout", 42 | icon("power off") 43 | ) 44 | ), 45 | dashboardSidebar( 46 | side = "left", size = "", inverted = T, 47 | sidebarMenu( 48 | div(class = "item", 49 | h4(class = "ui inverted header", "Something") 50 | ) 51 | ) 52 | ), 53 | dashboardBody( 54 | div(class = "sixteen wide column", 55 | "Something great content" 56 | ) 57 | ) 58 | ) 59 | } 60 | 61 | server <- function(input, output) { 62 | 63 | users <- reactive({ 64 | # user_sheet <- "https://docs.google.com/spreadsheets/d/1l-lHBPO9_JaI5aAUyTQ0Dt6YYY7O2SzTYFLbAHjCxlg/edit?usp=sharing" 65 | # googlesheets4::read_sheet(user_sheet) %>% 66 | dplyr::tibble(name = c("admin", "admin2"), email = name, pw = bcrypt::hashpw("test")) %>% glimpse 67 | }) 68 | 69 | user <- callModule(login_server, "user", users) 70 | 71 | observeEvent(user(), { 72 | observe(print(user())) 73 | }) 74 | } 75 | 76 | shinyApp(ui, server) 77 | # reactlog::reactlog_show() 78 | -------------------------------------------------------------------------------- /app_test.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | library(shiny) 3 | library(shinyjs) 4 | library(shiny.semantic) 5 | library(semantic.dashboard) 6 | library(shinyuser) 7 | library(openssl) 8 | library(bcrypt) 9 | 10 | ui <- function(){ 11 | dashboardPage( 12 | dashboardHeader( 13 | inverted = T, 14 | shinyuser::login_ui("user", test = T), 15 | div(class = "ui circular icon button action-button", id = "user-logout", 16 | icon("power off") 17 | ) 18 | ), 19 | dashboardSidebar( 20 | side = "left", size = "", inverted = T, 21 | sidebarMenu( 22 | div(class = "item", 23 | h4(class = "ui inverted header", "Something") 24 | ) 25 | ) 26 | ), 27 | dashboardBody( 28 | div(class = "sixteen wide column", 29 | "Something great content" 30 | ) 31 | ) 32 | ) 33 | } 34 | 35 | server <- function(input, output) { 36 | 37 | users <- reactive({ 38 | dplyr::tibble(name = "admin", email = name, pw = bcrypt::hashpw("test")) 39 | }) 40 | 41 | user <- callModule(shinyuser::login_server, "user", users) 42 | 43 | observeEvent(user(), { 44 | observe(print(user())) 45 | }) 46 | } 47 | 48 | 49 | shinyApp(ui, server) -------------------------------------------------------------------------------- /man/clickjs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/login_mod.R 3 | \docType{data} 4 | \name{clickjs} 5 | \alias{clickjs} 6 | \title{clickjs} 7 | \format{ 8 | An object of class \code{character} of length 1. 9 | } 10 | \usage{ 11 | clickjs 12 | } 13 | \description{ 14 | clickjs 15 | } 16 | \keyword{datasets} 17 | -------------------------------------------------------------------------------- /man/create_cookie.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cookies.R 3 | \name{create_cookie} 4 | \alias{create_cookie} 5 | \title{create_cookie} 6 | \usage{ 7 | create_cookie(user, pw) 8 | } 9 | \description{ 10 | create_cookie 11 | } 12 | -------------------------------------------------------------------------------- /man/form_login.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/login_mod.R 3 | \name{form_login} 4 | \alias{form_login} 5 | \title{form_login} 6 | \usage{ 7 | form_login(id, test) 8 | } 9 | \description{ 10 | form_login 11 | } 12 | -------------------------------------------------------------------------------- /man/js_cookies.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cookies.R 3 | \docType{data} 4 | \name{js_cookies} 5 | \alias{js_cookies} 6 | \title{https://gist.github.com/calligross/e779281b500eb93ee9e42e4d72448189 7 | js_cookies} 8 | \format{ 9 | An object of class \code{character} of length 1. 10 | } 11 | \usage{ 12 | js_cookies 13 | } 14 | \description{ 15 | https://gist.github.com/calligross/e779281b500eb93ee9e42e4d72448189 16 | js_cookies 17 | } 18 | \keyword{datasets} 19 | -------------------------------------------------------------------------------- /man/js_for_toggle_input.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/helper.R 3 | \name{js_for_toggle_input} 4 | \alias{js_for_toggle_input} 5 | \title{js_for_toggle_input} 6 | \usage{ 7 | js_for_toggle_input(selector, input_id) 8 | } 9 | \description{ 10 | js_for_toggle_input 11 | } 12 | -------------------------------------------------------------------------------- /man/login_server.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/login_mod.R 3 | \name{login_server} 4 | \alias{login_server} 5 | \title{login_server} 6 | \usage{ 7 | login_server(input, output, session, users, delay = 5) 8 | } 9 | \description{ 10 | login_server 11 | } 12 | -------------------------------------------------------------------------------- /man/login_ui.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/login_mod.R 3 | \name{login_ui} 4 | \alias{login_ui} 5 | \title{login_ui} 6 | \usage{ 7 | login_ui(id, head = NULL, tail = NULL, test = F) 8 | } 9 | \description{ 10 | login_ui 11 | } 12 | -------------------------------------------------------------------------------- /man/multiple_checkbox.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/helper.R 3 | \name{multiple_checkbox} 4 | \alias{multiple_checkbox} 5 | \title{multiple_checkbox} 6 | \usage{ 7 | multiple_checkbox( 8 | input_id, 9 | label, 10 | choices, 11 | selected = NULL, 12 | position = "grouped", 13 | type = "radio", 14 | ... 15 | ) 16 | } 17 | \description{ 18 | multiple_checkbox 19 | } 20 | -------------------------------------------------------------------------------- /man/pipe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils-pipe.R 3 | \name{\%>\%} 4 | \alias{\%>\%} 5 | \title{Pipe operator} 6 | \usage{ 7 | lhs \%>\% rhs 8 | } 9 | \description{ 10 | See \code{magrittr::\link[magrittr]{\%>\%}} for details. 11 | } 12 | \keyword{internal} 13 | -------------------------------------------------------------------------------- /man/simple_checkbox.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/helper.R 3 | \name{simple_checkbox} 4 | \alias{simple_checkbox} 5 | \title{simple_checkbox} 6 | \usage{ 7 | simple_checkbox(id, label, type = "", is_marked = TRUE, style = NULL) 8 | } 9 | \description{ 10 | simple_checkbox 11 | } 12 | -------------------------------------------------------------------------------- /man/toggle_input.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/semantic_inputs.R 3 | \name{toggle_input} 4 | \alias{toggle_input} 5 | \title{toggle_input} 6 | \usage{ 7 | toggle_input(id, label = NULL, fitted = F, checked = F, class = NULL) 8 | } 9 | \description{ 10 | toggle_input 11 | } 12 | -------------------------------------------------------------------------------- /man/toggle_slider.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/semantic_inputs.R 3 | \name{toggle_slider} 4 | \alias{toggle_slider} 5 | \title{toggle_slider} 6 | \usage{ 7 | toggle_slider(id, label = NULL, fitted = F, checked = F, class = NULL) 8 | } 9 | \description{ 10 | toggle_slider 11 | } 12 | -------------------------------------------------------------------------------- /rsconnect/shinyapps.io/systats/shinyuser.dcf: -------------------------------------------------------------------------------- 1 | name: shinyuser 2 | title: shinyuser 3 | username: 4 | account: systats 5 | server: shinyapps.io 6 | hostUrl: https://api.shinyapps.io/v1 7 | appId: 1626826 8 | bundleId: 2705294 9 | url: https://systats.shinyapps.io/shinyuser/ 10 | when: 1578085737.06176 11 | asMultiple: FALSE 12 | asStatic: FALSE 13 | ignoredFiles: .Rbuildignore|DESCRIPTION|main.html|main.Rmd|NAMESPACE|README.md|Readme.Rmd|man|R 14 | -------------------------------------------------------------------------------- /shinyuser.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | -------------------------------------------------------------------------------- /www/layout.css: -------------------------------------------------------------------------------- 1 | body { 2 | background-color: #ECF0F1; 3 | } 4 | 5 | #checkin { 6 | margin-top: 125px; 7 | } -------------------------------------------------------------------------------- /www/shiny.jpeg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/systats/shinyuser/d9bd6cffae88cb1a6ba379c863a027e675077bbe/www/shiny.jpeg --------------------------------------------------------------------------------