if(file.exists("R/eruu_user.R")){source("R/eruu_user.R")}
#' @export
eruu_ui <- function(id){
ns <- shiny::NS(id)
shiny::tagList(
shiny::div(
shiny::div(
shiny::div(shiny::textInput(ns("username_in"), shiny::h4("Username")),
class = "col-sm-6"),
shiny::div(shiny::passwordInput(ns("password_in"), shiny::h4("Password")),
class = "col-sm-6")
),
shiny::div(
shiny::div(shiny::actionButton(ns("connect_button"), "Connect"),
class = "col-sm-6"),
shiny::div(shiny::verbatimTextOutput(ns("connection_status")),
class = "col-sm-6")
)
)
)
}
#' @export
eruu_module <- function(input, output, session, database){
session$userData$current_user <- shiny::reactiveVal(NULL)
session$userData$current_key <- shiny::reactiveVal(NULL)
session$userData$connection_status <- shiny::reactiveVal("Not connected")
current_user <- session$userData$current_user
current_key <- session$userData$current_key
connection_status <- session$userData$connection_status
shiny::observeEvent(input$connect_button, {
is_valid <- F
logger::log_debug("Check user")
if(!is.null(input$username_in) && !is.null(input$password_in)){
is_valid <- validate_user(input$username_in, input$password_in, database)
if(is_valid){
current_user(input$username_in)
key <- get_user_key(current_user(), database)
key <- decrypt_redcap_key(input$password_in, key)
current_key(key)
connection_status("Successfully connected")
}else{
current_user(NULL)
current_key(NULL)
connection_status("Connection Error")
}
}else{
current_user(NULL)
current_key(NULL)
connection_status("Connection Error")
}
})
output$connection_status <- renderText({
connection_status()
})
}
#' @export
eruu_usertab_ui <- function(id){
ns <- shiny::NS(id)
shiny::tagList(
shiny::uiOutput(ns("user_account"))
)
}
#' @export
eruu_usertab_module <- function(input, output, session, database){
current_user <- session$userData$current_user
current_key <- session$userData$current_key
connection_status <- session$userData$connection_status
output$user_account <- shiny::renderUI({
if(!is.null(current_user())){
shiny::tagList(
shiny::div(
shiny::div(shiny::h2(paste0("User: ", current_user()))),
shiny::div(shiny::p("To change anything, please be sure to be logged in and re-enter your password bellow"),
class="important"),
shiny::div(shiny::passwordInput(session$ns("password_current"), shiny::h4("Current password"))),
class="user_admin_section"),
shiny::div(
shiny::h3("Update password"),
shiny::div(
shiny::div(
shiny::passwordInput(session$ns("password_new1"), shiny::h4("New password")),
class="col-sm-6"),
shiny::div(
shiny::passwordInput(session$ns("password_new2"), shiny::h4("Repeat password")),
class="col-sm-6"),
),
shiny::div(
shiny::actionButton(session$ns("change_passwd_button"), "Update password"),
shiny::verbatimTextOutput(session$ns("passwd_change_status"))
),
class="user_admin_section"
),
shiny::div(
shiny::h3("Update redcap key"),
shiny::div(
shiny::passwordInput(session$ns("key_new"), shiny::h4("Key"))),
shiny::div(
shiny::actionButton(session$ns("change_key_button"), "Update key")),
shiny::div(
shiny::verbatimTextOutput(session$ns("key_change_status")))
)
)
}
})
passwd_status <- reactiveVal("")
key_status <- reactiveVal("")
shiny::observeEvent(input$change_passwd_button, {
is_valid <- F
logger::log_debug("Check user")
if(!is.null(current_user()) && !is.null(input$password_current)){
is_valid <- validate_user(current_user(), input$password_current, database)
if(is_valid){
if(input$password_new1 != input$password_new2){
is_valid <- T #Do not disconnect the user
passwd_status("Passwords do not match!")
} else{
pass_strength <- check_password_strength(input$password_new1)
if(pass_strength$score > min_password_score){
user <- update_user(current_user(), database, input$password_current, password = input$password_new1)
is_valid <- validate_user(user$username, input$password_new1, database)
if(is_valid){
passwd_status("Password updated successfully")
current_user(user[["username"]])
} else {
passwd_status("Error while updating password")
}
}else{
passwd_status(paste0("Password is not strong enough. ", pass_strength$feedback[[1]]))
}
}
}
} else{
passwd_status("User invalid. Contact admin")
}
if(!is_valid){
if(nchar(passwd_status()) > 0){
connection_status(paste0(passwd_status(), ". Disconnected"))
}else{
connection_status("Current password not correct. Disconnected")
}
current_user(NULL)
current_key(NULL)
}
})
shiny::observeEvent(input$change_key_button, {
is_valid <- F
logger::log_debug("Check user")
if(!is.null(current_user()) && !is.null(input$password_current)){
is_valid <- validate_user(current_user(), input$password_current, database)
if(is_valid){
user <- update_user(current_user(), database, input$password_current, key = input$key_new)
is_valid <- validate_user(current_user(), input$password_current, database)
if(is_valid){
key_status("Key updated successfully")
} else {
key_status("Error while updating key")
}
current_user(user$username)
}
}else{
passwd_status("User invalid. Contact admin")
}
if(!is_valid){
if(nchar(key_status()) > 0){
connection_status(paste0(key_status(), ". Disconnected"))
}else{
connection_status("Current password not correct. Disconnected")
}
current_user(NULL)
current_key(NULL)
}
})
output$passwd_change_status <- renderText(
passwd_status()
)
output$key_change_status <- renderText(
key_status()
)
}
#' @export
eruu_admintab_ui <- function(id){
ns <- shiny::NS(id)
shiny::tagList(
shiny::uiOutput(ns("user_admin"))
)
}
#' @export
eruu_admintab_module <- function(input, output, session, database){
current_user <- session$userData$current_user
current_key <- session$userData$current_key
connection_status <- session$userData$connection_status
output$user_admin <- shiny::renderUI({
if(!is.null(current_user())){
admin_user <- get_user(current_user(), database)
if(admin_user[["role"]] == "admin"){
shiny::tagList(
shiny::div(
shiny::passwordInput(session$ns("admin_password"),
label = shiny::h3("Current admin password"))
),
shiny::uiOutput(session$ns("internal_admin_ui"))
)
}
}
})
output$internal_admin_ui <- renderUI({
if (!is.null(current_user())) {
admin_user <- get_user(current_user(), database)
is_valid <-
validate_user(current_user(), input$admin_password, database)
if (admin_user[["role"]] == "admin" && is_valid) {
all_users <- get_all_users(database)
shiny::tagList(
shiny::div(
shiny::h3("User list"),
DT::dataTableOutput(session$ns("user_list")),
class = "user_admin_section"),
shiny::div(
shiny::h3("Set user as admin"),
shiny::div("Due to high encryption and security requirements,
No change of the role can be done by the user or the admin alone.
Both user and admin need to enter their respecitve passwords."),
shiny::selectizeInput(session$ns("admin_select"), shiny::h4("User"), choice = all_users$username),
shiny::passwordInput(session$ns("admin_user_password"),
label = shiny::h4("Current user password")),
shiny::actionButton(session$ns("admin_validate"), shiny::h4("Validate")),
shiny::verbatimTextOutput(session$ns("admin_output")),
class = "user_admin_section"),
shiny::div(
shiny::h3("Set user as basic user"),
shiny::div("Due to high encryption and security requirements,
No change of the role can be done by the user or the admin alone.
Both user and admin need to enter their respecitve passwords."),
shiny::selectizeInput(session$ns("basic_select"), shiny::h4("User"), choice = all_users$username),
shiny::passwordInput(session$ns("basic_user_password"),
label = shiny::h4("Current user password")),
shiny::actionButton(session$ns("basic_validate"), shiny::h4("Validate")),
shiny::verbatimTextOutput(session$ns("basic_output")),
class = "user_admin_section"),
shiny::div(
shiny::h3("Delete user"),
shiny::selectizeInput(session$ns("delete_select"), shiny::h4("User"), choice = all_users$username),
shiny::actionButton(session$ns("delete_validate"), shiny::h4("Validate")),
shiny::verbatimTextOutput(session$ns("delete_output")),
class = "user_admin_section"),
shiny::div(
shiny::h3("Add user"),
shiny::textInput(session$ns("add_username"), label = shiny::h4("Username"), placeholder = "user"),
shiny::passwordInput(session$ns("add_password1"), label = shiny::h4("Password")),
shiny::passwordInput(session$ns("add_password2"), label = shiny::h4("Repeat password")),
shiny::actionButton(session$ns("add_validate"), shiny::h4("Validate")),
shiny::verbatimTextOutput(session$ns("add_output")),
class = "user_admin_section"),
shiny::div(
shiny:: downloadButton(session$ns("downloadData"), label = h4("Download")),
class = "user_admin_section"
)
)
}
}
})
all_users_as_dt <- function(database){
all_users <- get_all_users(database)
df <-
all_users[, !names(all_users) %in% c("key",
"passwd_hash",
"validation_hash",
"created_at",
"active")]
return(DT::datatable(df, rownames = F))
}
shiny::observeEvent(input$delete_validate, {
browser()
if (!is.null(current_user())) {
admin_user <- get_user(current_user(), database)
is_valid_admin <-
validate_user(current_user(), input$admin_password, database)
if (admin_user[["role"]] == "admin" && is_valid_admin) {
u <- get_user(input$delete_select, database)
if(!is.null(u) && u$username != current_user()){
if(u$role == "admin"){
output$delete_output <- renderText("Admin users can't be deleted. Change role first")
}
else{
if(delete_user(current_user(), input$admin_password, u$username, database)){
output$delete_output <- renderText("User deleted")
output$user_list <- renderDataTable(all_users_as_dt(database))
}else{
output$delete_output <- renderText("Couldn't delete user")
output$user_list <- renderDataTable(all_users_as_dt(database))
}
}
}else{
output$delete_output <- renderText("Impossible to delete your own account")
}
}
}
})
output$user_list <- DT::renderDataTable({
if (!is.null(current_user())) {
admin_user <- get_user(current_user(), database)
is_valid <-
validate_user(current_user(), input$admin_password, database)
if (admin_user[["role"]] == "admin" && is_valid) {
return(all_users_as_dt(database))
}
}
return(NULL)
})
shiny::observeEvent(input$admin_validate, {
if (!is.null(current_user())) {
admin_user <- get_user(current_user(), database)
is_valid_admin <-
validate_user(current_user(), input$admin_password, database)
if (admin_user[["role"]] == "admin" && is_valid_admin) {
u <- get_user(input$admin_select, database)
if(!is.null(u)){
is_valid_user <-
validate_user(u$username, input$admin_user_password, database)
if(is_valid_user){
ret <- update_user_with_admin_access(current_user(),
input$admin_password,
u$username,
input$admin_user_password,
database,
role = "admin")
if(!is.null(ret)){
output$admin_output <- renderText("Role updated successfully")
output$user_list <- renderDataTable(all_users_as_dt(database))
}else{
output$admin_output <- renderText("An error occured")
output$user_list <- renderDataTable(all_users_as_dt(database))
}
}
}
}
}
})
shiny::observeEvent(input$basic_validate, {
if (!is.null(current_user())) {
admin_user <- get_user(current_user(), database)
is_valid_admin <-
validate_user(current_user(), input$admin_password, database)
if (admin_user[["role"]] == "admin" && is_valid_admin) {
u <- get_user(input$basic_select, database)
if(!is.null(u)){
is_valid_user <-
validate_user(u$username, input$basic_user_password, database)
if(is_valid_user){
ret <- update_user_with_admin_access(current_user(),
input$admin_password,
u$username,
input$basic_user_password,
database,
role = "basic")
if(!is.null(ret)){
output$basic_output <- renderText("Role updated successfully")
output$user_list <- renderDataTable(all_users_as_dt(database))
}else{
output$basic_output <- renderText("An error occured")
output$user_list <- renderDataTable(all_users_as_dt(database))
}
}
}
}
}
})
shiny::observeEvent(input$delete_validate, {
if (!is.null(current_user())) {
admin_user <- get_user(current_user(), database)
is_valid_admin <-
validate_user(current_user(), input$admin_password, database)
if (admin_user[["role"]] == "admin" && is_valid_admin) {
u <- get_user(input$admin_select, database)
if(!is.null(u) && u$username != current_user()){
if(u$role == "admin"){
output$delete_output <- renderText("Admin users can't be deleted. Change role first")
}
else{
if(delete_user(current_user(), input$admin_password, u$username, database)){
output$delete_output <- renderText("User deleted")
output$user_list <- renderDataTable(all_users_as_dt(database))
}else{
output$delete_output <- renderText("Couldn't delete user")
output$user_list <- renderDataTable(all_users_as_dt(database))
}
}
}
}
}
})
shiny::observeEvent(input$add_validate, {
if (!is.null(current_user())) {
admin_user <- get_user(current_user(), database)
is_valid_admin <-
validate_user(current_user(), input$admin_password, database)
if (admin_user[["role"]] == "admin" && is_valid_admin) {
username <- input$add_username
pw1 <- input$add_password1
pw2 <- input$add_password1
if(!is.null(username) && !is.null(pw1) && !is.null(pw2)){
if(pw1 != pw2){
output$add_output <- renderText("Passwords don't match")
}else if(check_password_strength(pw1)$score < min_password_score){
output$add_output <- renderText(
paste0("Password is not strong enough. ",
pass_strength$feedback[[1]])
)
}else if(!is.null(get_user(username, database))){
output$add_output <- renderText("This user already exists")
}else {
key <- paste(rep("A", 32), collapse = "")
u <- create_user(username, pw1, key, database)
if(!is.null(u)){
output$add_output <- renderText("User successfully created")
output$user_list <- renderDataTable(all_users_as_dt(database))
}else{
output$add_output <- renderText("User couldn't be created")
output$user_list <- renderDataTable(all_users_as_dt(database))
}
}
}
}
}
})
output$downloadData <- downloadHandler(
filename = function() {
"users.db"
},
content = function(file) {
file.copy(database, file)
},
contentType = "application/x-sqlite3"
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.