Merge pull request #95 from datastorm-open/admin-edit-multiple-users

WIP - Admin mode: edit multiple users
datastorm-open · Jun 4, 2021 · 8ec0577 · 8ec0577
2 parents ce650d2 + 6219c15
commit 8ec0577
Show file tree

Hide file tree

Showing 4 changed files with 193 additions and 59 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -72,6 +72,7 @@ importFrom(shiny,icon)
 importFrom(shiny,insertUI)
 importFrom(shiny,invalidateLater)
 importFrom(shiny,is.reactive)
+importFrom(shiny,isTruthy)
 importFrom(shiny,isolate)
 importFrom(shiny,modalButton)
 importFrom(shiny,modalDialog)

diff --git a/R/language.R b/R/language.R
@@ -51,6 +51,7 @@ pkgEnv$label_en = list(
   "Home" = "Home",
   "Select all shown users" = "Select all shown users",
   "Remove selected users" = "Remove selected users",
+  "Edit selected users" = "Edit selected users",
   "Force selected users to change password" = "Force selected users to change password",
   "Users" = "Users",
   "Passwords" = "Passwords",
@@ -79,7 +80,8 @@ pkgEnv$label_en = list(
   "Select" = "Select",
   "Logs" = "Logs",
   "All users" = "All users",
-  "Nb logged" = "Nb logged"
+  "Nb logged" = "Nb logged",
+  "Permitted null values" = "Permitted null values"
 )
 
 pkgEnv$label_fr = list(
@@ -133,6 +135,7 @@ pkgEnv$label_fr = list(
   "Home" = "Accueil",
   "Select all shown users" = "S\u00e9lectionner tous les utilisateurs affich\u00e9s",
   "Remove selected users" = "Supprimer les utilisateurs s\u00e9lectionn\u00e9s",
+  "Edit selected users" = "Editer les utilisateurs s\u00e9lectionn\u00e9s",
   "Force selected users to change password" = "Forcer les utilisateurs s\u00e9l\u00e9ctionn\u00e9s \u00e0 changer de mot de passe",
   "Users" = "Utilisateurs",
   "Passwords" = "Mots de passe",
@@ -160,7 +163,8 @@ pkgEnv$label_fr = list(
   "Select" = "S\u00e9lectionner",
   "Logs" = "Logs",
   "All users" = "Tous les utilisateurs",
-  "Nb logged" = "Connexions"
+  "Nb logged" = "Connexions",
+  "Permitted null values" = "Valeurs nulles autoris\u00e9es"
 )
 
 pkgEnv$label_ptbr = list(
@@ -214,6 +218,7 @@ pkgEnv$label_ptbr = list(
   "Home" = "In\u00edcio",
   "Select all shown users" = "Selecionar todos os usu\u00e1rios mostrados",
   "Remove selected users" = "Remover usu\u00e1rios selecionados",
+  "Edit selected users" = "Modificar usu\u00e1rios selecionados",
   "Force selected users to change password" = "For\u00e7ar usu\u00e1rio selecionado a mudar a senha",
   "Users" = "Usu\u00e1rios",
   "Passwords" = "Senhas",
@@ -241,7 +246,8 @@ pkgEnv$label_ptbr = list(
   "Select" = "Selecionar",
   "Logs" = "Conex\u00f5es",
   "All users" = "All usu\u00e1rio",
-  "Nb logged" = "Conex\u00f5es"
+  "Nb logged" = "Conex\u00f5es",
+  "Permitted null values" = "Valores nulos autorizados"
 )
 
 pkgEnv$label_es = list(
@@ -322,7 +328,8 @@ pkgEnv$label_es = list(
   "Select" = "Seleccionar",
   "Logs" = "Registros",
   "All users" = "Todos los usuarios",
-  "Nb logged" = "Conexiones"
+  "Nb logged" = "Conexiones",
+  "Permitted null values" = "Valores nulos permitidos"
 )
 
 pkgEnv$label_de = list(

diff --git a/R/module-admin.R b/R/module-admin.R
@@ -35,18 +35,26 @@ admin_ui <- function(id, lan = NULL) {
         ),
         tags$br(), tags$br(), tags$br(),
         DTOutput(outputId = ns("table_users")),
-        
+
         tags$br(),
 
         actionButton(
-          inputId = ns("remove_selected_allusers"),
+          inputId = ns("select_all_users"),
           # label = lan$get("Select all shown users"),
           label = "",
           class = "btn-secondary pull-right",
           style = "margin-left: 5px",
           icon = icon("check-square")
         ),
 
+        actionButton(
+          inputId = ns("edit_selected_users"),
+          label = lan$get("Edit selected users"),
+          class = "btn-primary pull-right disabled",
+          style = "margin-left: 5px",
+          icon = icon("pencil-square-o")
+        ),
+
         actionButton(
           inputId = ns("remove_selected_users"),
           label = lan$get("Remove selected users"),
@@ -80,14 +88,14 @@ admin_ui <- function(id, lan = NULL) {
         ),
 
         tags$br(),tags$br(), tags$br(), tags$hr(),
-        
+
         downloadButton(
           outputId = ns("download_sql_database"),
           label = lan$get("Download SQL database"),
           class = "btn-primary center-block",
           icon = icon("download")
         ),
-        
+
         tags$br(),tags$br()
 
       )
@@ -107,14 +115,14 @@ admin <- function(input, output, session, sqlite_path, passphrase, lan,
   jns <- function(x) {
     paste0("#", ns(x))
   }
-  
+
   token_start <- isolate(getToken(session = session))
 
   update_read_db <- reactiveValues(x = NULL)
 
   # read users table from database
   users <- reactiveVal(NULL)
-  
+
   observe({
     unbindDT(ns("table_users"))
     update_read_db$x
@@ -136,10 +144,10 @@ admin <- function(input, output, session, sqlite_path, passphrase, lan,
   observe({
     if(!is.null(users_update())) users(users_update())
   })
-  
+
   # read password management table from database
   pwds <- reactiveVal(NULL)
-  
+
   observe({
     unbindDT(ns("table_pwds"))
     update_read_db$x
@@ -170,7 +178,7 @@ admin <- function(input, output, session, sqlite_path, passphrase, lan,
     users <- users[, setdiff(names(users), c("password", "is_hashed_password")), drop = FALSE]
     users$Edit <- input_btns(ns("edit_user"), users$user, "Edit user", icon("pencil-square-o"), status = "primary", lan = lan())
     users$Remove <- input_btns(ns("remove_user"), users$user, "Delete user", icon("trash-o"), status = "danger", lan = lan())
-    users$Select <- input_checkbox_ui(ns("remove_mult_users"), users$user)
+    users$Select <- input_checkbox_ui(ns("select_mult_users"), users$user)
     names_lan <- sapply(names(users), function(x) lan()$get(x))
     change <- as.logical(users$admin)
     users[change, "admin"] <- lan()$get("Yes")
@@ -181,8 +189,12 @@ admin <- function(input, output, session, sqlite_path, passphrase, lan,
       rownames = FALSE,
       escape = FALSE,
       selection = "none",
+      style = "bootstrap",
       # extensions = 'FixedColumns', # bug using FixedColumns on checkbox + update table...
       options = list(
+        scrollY = if (nrow(users) > 10) "500px",
+        lengthChange = FALSE,
+        paging = FALSE,
         language = lan()$get_DT(),
         drawCallback = JS("function() {Shiny.bindAll(this.api().table().node());}"),
         # initComplete = JS(
@@ -199,13 +211,18 @@ admin <- function(input, output, session, sqlite_path, passphrase, lan,
   }, server = FALSE)
 
 
-  observeEvent(input$remove_selected_allusers, {
+  observeEvent(input$select_all_users, {
     input_names <- names(input)
-    remove_mult_users_input <- input_names[grep("^remove_mult_users", input_names)]
-    if(length(remove_mult_users_input) > 0){
-      ctrl <- lapply(remove_mult_users_input, function(x){
+    select_mult_users_names <- grep("^select_mult_users", input_names, value = TRUE)
+    select_mult_users_value <- unlist(lapply(select_mult_users_names, function(x) input[[x]]))
+    if (!all(select_mult_users_value)) {
+      ctrl <- lapply(select_mult_users_names, function(x) {
         updateCheckboxInput(session, x, value = TRUE)
       })
+    } else {
+      ctrl <- lapply(select_mult_users_names, function(x){
+        updateCheckboxInput(session, x, value = FALSE)
+      })
     }
   })
 
@@ -229,7 +246,11 @@ admin <- function(input, output, session, sqlite_path, passphrase, lan,
       rownames = FALSE,
       escape = FALSE,
       selection = "none",
+      style = "bootstrap",
       options = list(
+        scrollY = if (nrow(pwds) > 10) "500px",
+        lengthChange = FALSE,
+        paging = FALSE,
         language = lan()$get_DT(),
         drawCallback = JS("function() {Shiny.bindAll(this.api().table().node());}"),
         # initComplete = JS(
@@ -255,13 +276,15 @@ admin <- function(input, output, session, sqlite_path, passphrase, lan,
   })
 
   # Remove all selected users
-  r_selected_users <- callModule(module = input_checkbox, id = "remove_mult_users")
+  r_selected_users <- callModule(module = input_checkbox, id = "select_mult_users")
   observeEvent(r_selected_users(), {
     selected_users <- r_selected_users()
     if (length(selected_users) > 0) {
       toggleBtn(session = session, inputId = ns("remove_selected_users"), type = "enable")
+      toggleBtn(session = session, inputId = ns("edit_selected_users"), type = "enable")
     } else {
       toggleBtn(session = session, inputId = ns("remove_selected_users"), type = "disable")
+      toggleBtn(session = session, inputId = ns("edit_selected_users"), type = "disable")
     }
   })
 
@@ -311,7 +334,8 @@ admin <- function(input, output, session, sqlite_path, passphrase, lan,
 
 
 
-  # launch modal to edit informations about a user
+  # EDIT USER: launch modal to edit informations about a user ----
+
   observeEvent(input$edit_user, {
     users <- users()
     showModal(modalDialog(
@@ -377,7 +401,50 @@ admin <- function(input, output, session, sqlite_path, passphrase, lan,
   })
 
 
-  # launch modal to add a new user
+
+
+  # EDIT MULTIPLE USERS: Launch modal to edit multiple users ----
+  observeEvent(input$edit_selected_users, {
+    users <- users()
+    showModal(modalDialog(
+      title = "Edit user",
+      edit_user_ui(ns("edit_mult_user"), credentials = users, username = r_selected_users(), inputs_list = inputs_list, lan = lan()),
+      footer = tagList(
+        modalButton(lan()$get("Cancel")),
+        actionButton(
+          inputId = ns("edited_mult_user"),
+          label = lan()$get("Confirm change"),
+          class = "btn-primary",
+          `data-dismiss` = "modal"
+        )
+      )
+    ))
+  })
+
+  value_mult_edited <- callModule(module = edit_user, id = "edit_mult_user")
+
+  observeEvent(input$edited_mult_user, {
+    users <- users()
+    newval <- value_mult_edited$user
+    newval$user <- newval$admin <- NULL
+    conn <- dbConnect(SQLite(), dbname = sqlite_path)
+    on.exit(dbDisconnect(conn))
+    res_edit <- try({
+      for (user in r_selected_users()) {
+        users <- update_user(users, newval, user)
+      }
+      write_db_encrypt(conn = conn, value = users, name = "credentials", passphrase = passphrase)
+    }, silent = FALSE)
+    if (inherits(res_edit, "try-error")) {
+      showNotification(ui = lan()$get("Fail to update user"), type = "error")
+    } else {
+      showNotification(ui = lan()$get("User successfully updated"), type = "message")
+      update_read_db$x <- Sys.time()
+    }
+  })
+
+
+  # ADD NEW USER: launch modal to add a new user ----
   observeEvent(input$add_user, {
     users <- users()
     if(!is.null(max_users) && is.numeric(max_users) && nrow(users) >= max_users){
@@ -453,7 +520,8 @@ admin <- function(input, output, session, sqlite_path, passphrase, lan,
       if(!"is_hashed_password" %in% colnames(users)){
         users$is_hashed_password <- FALSE
       }
-      newuser <- newuser[, colnames(users)]
+      newuser[setdiff(colnames(users), colnames(newuser))] <- NA
+      newuser <- newuser[colnames(users)]
       users <- rbind(users, newuser)
       write_db_encrypt(conn = conn, value = users, name = "credentials", passphrase = passphrase)
       resetpwd <- read_db_decrypt(conn = conn, name = "pwd_mngt", passphrase = passphrase)