R/eruu_modules.R

Defines functions eruu_ui eruu_module eruu_usertab_ui eruu_usertab_module eruu_admintab_ui eruu_admintab_module

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"
  )

}
pydupont/esr.redcap.user.ui documentation built on Dec. 25, 2019, 3:20 a.m.