Merge pull request #67 from HenriKajasilta/newuseroptions

New user options
PecanProject · Jul 5, 2023 · 075db0d · 075db0d
2 parents 5397899 + a13a0eb
commit 075db0d
Show file tree

Hide file tree

Showing 4 changed files with 35 additions and 11 deletions.
diff --git a/.RData b/.RData
diff --git a/R/app_server.R b/R/app_server.R
@@ -56,15 +56,35 @@ app_server <- function(input, output, session) {
     if (dp()) message("auth_result$user changed")
 
     if (auth_result$admin == "FALSE") {
-
-      updateSelectInput(session, "site", selected = auth_result$user)
-      shinyjs::disable("site")
+      # Create a new user that has access to the Carbon action sites.
+      if (auth_result$user == "ca_user") {
+
+        shinyjs::enable("site")
+        shinyjs::show("site")
+        # Subset of site choices for the third user
+        site_choices <- sites[sites$site_type %in% c('Advanced CarbonAction Site','CarbonAction Site'),]$site
+
+        updateSelectInput(session, "site", choices = site_choices, selected = auth_result$user)
+      } else if (auth_result$user == "valio_user") {
+
+        shinyjs::enable("site")
+        shinyjs::show("site")
+        # Subset of site choices for the third user
+        site_choices <- sites[grepl("Valio Carbo", sites$site_type),]$site
+
+        updateSelectInput(session, "site", choices = site_choices, selected = auth_result$user)
+
+      } else {
+
+        updateSelectInput(session, "site", selected = auth_result$user)
+        shinyjs::disable("site")
+      }
 
       updateTextInput(session, "uservisible", value = auth_result$user)
       shinyjs::disable("uservisible")
 
 
-      # shinyjs::show("usevisible")
+      # shinyjs::show("uservisible")
     } else {
       shinyjs::enable("site")
       shinyjs::show("site")
@@ -80,13 +100,13 @@ app_server <- function(input, output, session) {
   ################
 
   # Module for download server, need to decide if ui is separated to
-  # different functions, if more download buttons in required
+  # different functions, if more download buttons is required
 
   mod_download_server_inst("download_ui_1")
 
-  mod_download_server_table("event_table", auth_result$user)
+  mod_download_server_table("event_table", user_auth = reactive(input$site))
 
-  mod_download_server_json("json_zip", auth_result$user)
+  mod_download_server_json("json_zip", user_auth = reactive(input$site))
 
 
 

diff --git a/R/mod_download.R b/R/mod_download.R
@@ -130,6 +130,7 @@ mod_download_json <- function(id, label) {
 #'
 mod_download_server_table <- function(id, user_auth, base_folder = json_file_base_folder()) {
 
+  stopifnot(is.reactive(user_auth))
 
   moduleServer(id, function(input, output, session){
     ns <- session$ns
@@ -152,7 +153,7 @@ mod_download_server_table <- function(id, user_auth, base_folder = json_file_bas
           file_path <- base_folder
 
           if(dp()) message("Checking current user")
-            user <- user_auth
+            user <- user_auth()
         }
         # Create the file path based on the production status and the user
         file_path <- file.path(file_path, user)
@@ -198,6 +199,7 @@ mod_download_server_table <- function(id, user_auth, base_folder = json_file_bas
 
 mod_download_server_json <- function(id, user_auth, base_folder = json_file_base_folder()) {
 
+  stopifnot(is.reactive(user_auth))
 
   moduleServer(id, function(input, output, session){
     ns <- session$ns
@@ -223,7 +225,7 @@ mod_download_server_json <- function(id, user_auth, base_folder = json_file_base
           file_path <- base_folder
 
           if(dp()) message("Checking current user")
-          user <- user_auth
+          user <- user_auth()
         }
         # Create the file path based on the production status and the user
         file_path <- file.path(file_path, user)

diff --git a/tests/testthat/test-download.R b/tests/testthat/test-download.R
@@ -7,15 +7,17 @@ test_that("is download functional", {
     expect_true(file.info(output$report)$size > 10000)
   })
 
+  site <- reactive("qvidja")
+
   # Check that file exist when downloading csv
-  testServer(mod_download_server_table, args = list(user_auth = "qvidja"), {
+  testServer(mod_download_server_table, args = list(user_auth = site), {
     expect_true(file.exists(output$eventtable))
     expect_true(file.size(output$eventtable) > 70)
   })
 
 
   # Check that file exist when downloading zip
-  testServer(mod_download_server_json, args = list(user_auth = "qvidja"), {
+  testServer(mod_download_server_json, args = list(user_auth = site), {
     expect_true(file.exists(output$eventjson))
     expect_true(grepl(".zip", output$eventjson))