Merge external integration developments

components/app/R/global.R

@@ -169,6 +169,8 @@ opt.default <- list(
   ENABLE_HEARTBEAT = TRUE,
   ENABLE_INACTIVITY = TRUE,
   ENABLE_ANNOT = FALSE,
+  ENABLE_STARTUP_MODAL = TRUE,
+  INTEGRATION_TRANSLATION = FALSE,
   ENABLE_UPGRADE = FALSE,
   ENCRYPTED_EMAIL = FALSE,
   MAX_DATASETS = 25,
@@ -284,3 +286,10 @@ library(shiny.i18n)
 DICTIONARY <- file.path(FILES, "translation.json")
 i18n <- shiny.i18n::Translator$new(translation_json_path = DICTIONARY)
 i18n$set_translation_language("RNA-seq")
+
+## Init integration translator
+if (opt$INTEGRATION_TRANSLATION) {
+  DICTIONARY2 <- file.path(FILES, "translation_integration.json")
+  i18n_int <- shiny.i18n::Translator$new(translation_json_path = DICTIONARY2)
+  i18n_int$set_translation_language("integration")
+}

components/app/R/server.R

@@ -117,6 +117,14 @@ app_server <- function(input, output, session) {
       allow_new_users = opt$ALLOW_NEW_USERS,
       redirect_login = TRUE
     )
+  } else if (authentication == "email-encrypted") {
+    auth <- EmailEncryptedAuthenticationModule(
+      id = "auth",
+      show_modal = TRUE,
+      skip_modal = TRUE,
+      # TODO add argument for location of crypto key (probably on ETC)
+      domain = opt$DOMAIN
+    )
   } else if (authentication == "shinyproxy") {
     username <- Sys.getenv("SHINYPROXY_USERNAME")
     auth <- NoAuthenticationModule(
@@ -1224,7 +1232,7 @@ app_server <- function(input, output, session) {
   ## Startup Message
   dbg("[MAIN] showing startup modal")
   observeEvent(auth$logged, {
-    if (auth$logged) {
+    if (auth$logged && opt$ENABLE_STARTUP_MODAL) {
       shinyjs::delay(500, {
         ## read startup messages
         msg <- readLines(file.path(ETC, "MESSAGES"))

components/board.upload/R/upload_module_preview_counts.R

@@ -128,6 +128,22 @@ upload_table_preview_counts_server <- function(
             action_buttons
           )
         },
+        if (is.matrix(uploaded$counts.csv) && nrow(uploaded$counts.csv) == 1 && ncol(uploaded$counts.csv) == 1) {
+          bslib::layout_columns(
+            col_widths = 12,
+            div(
+              style = "display: flex; justify-content: center; align-items: center; position: absolute; top: 21px; left: 21px; right: 21px; bottom: 21px; z-index: 9999; background: white;",
+              shiny::tags$div(
+                style = "width: 100%; display: flex; justify-content: center; align-items: center;",
+                shiny::tags$div(
+                  class = "spinner-border text-primary", 
+                  style = "width: 5rem; height: 5rem;",
+                  shiny::tags$span(class = "visually-hidden", "Loading...")
+                )
+              )
+            )
+          )
+        },
         if (!is.null(uploaded$counts.csv)) {
           bslib::layout_columns(
             col_widths = 12,

components/board.upload/R/upload_server.R

@@ -522,7 +522,7 @@ UploadBoard <- function(id,
       )
 
       samples_ui <- wizardR::wizard_step(
-        step_title = "Step 2: Upload samples",
+        step_title = tspan("Step 2: Upload samples", js = FALSE),
         step_id = "step_samples",
         server = TRUE,
         upload_table_preview_samples_ui(
@@ -684,11 +684,21 @@ UploadBoard <- function(id,
     # change upload_datatype to selected_datatype
     observeEvent(input$selected_datatype, {
       upload_datatype(input$selected_datatype)
+      query_files <- check_query_files()
+      if (!is.null(query_files$datatype) && new_upload() == 2) {
+        datatype <- query_files$datatype
+        upload_datatype(datatype)
+      }
     })
 
     # change upload_organism to selected_organism
     observeEvent(input$selected_organism, {
       upload_organism(input$selected_organism)
+      query_files <- check_query_files()
+      if (!is.null(query_files$organism) && new_upload() == 2) {
+        organism <- query_files$organism
+        upload_organism(organism)
+      }
     })
 
     observeEvent(input$start_upload, {
@@ -945,7 +955,7 @@ UploadBoard <- function(id,
         wizardR::reset("upload_wizard")
 
         # skip upload trigger at first startup
-        if (new_upload() == 0) {
+        if (new_upload() == 1) {
           return(NULL)
         }
 
@@ -976,6 +986,75 @@ UploadBoard <- function(id,
               ## compute_info(list( "name" = pgx$name,"description" = pgx$description))
               compute_settings$name <- pgx$name
               compute_settings$description <- pgx$description
+            } else if (opt$AUTHENTICATION == "email-encrypted") { # Only data preloading on email-encrypted authentication
+              query_files <- check_query_files()
+              # Get encryption key
+              encryption_key <- tryCatch(
+                {
+                  readLines(file.path(OPG, "etc/keys/encryption.txt"))[1]
+                },
+                error = function(w) {
+                  warning("[UploadServer] ERROR: missing encryption_key file!!!")
+                  NULL
+                }
+              )
+              # if (!file.exists(encryption_key)) {
+              #   encryption_key <- NULL
+              # }
+              # Populate upload data with available
+              if (!is.null(query_files$counts) && new_upload() == 2) {
+                counts_url <- if (!is.null(encryption_key)) {
+                  decrypt_util(query_files$counts, encryption_key)
+                } else {
+                  warning("[UploadServer] No encryption key available, using raw URL")
+                  query_files$counts
+                }
+
+                # Set initial loading state
+                uploaded$counts.csv <- matrix(data = 1, nrow = 1, ncol = 1)
+
+                future_promise({
+                  file <- read_query_files(counts_url)
+                  df <- playbase::read_counts(file)
+                  af <- playbase::read_annot(file)
+                  list(counts = df, annot = af)
+                }) %...>% 
+                (function(result) {
+                  message("[UploadServer] Future completed successfully")
+                  uploaded$counts.csv <- result$counts
+                  uploaded$annot.csv <- result$annot
+                }) %...!% 
+                (function(error) {
+                  message("[UploadServer] Future failed with error: ", error$message)
+                  warning("[UploadServer] Error processing counts file: ", error)
+                })
+              }
+              if (!is.null(query_files$samples) && new_upload() == 2) {
+                # Decrypt the URL if encryption key is available
+                samples_url <- if (!is.null(encryption_key)) {
+                  decrypt_util(query_files$samples, encryption_key)
+                } else {
+                  warning("[UploadServer] No encryption key available, using raw URL")
+                  query_files$samples
+                }
+
+                file <- read_query_files(samples_url)
+                df <- playbase::read_samples(file)
+                uploaded$samples.csv <- df
+              }
+              if (!is.null(query_files$contrasts) && new_upload() == 2) {
+                # Decrypt the URL if encryption key is available
+                contrasts_url <- if (!is.null(encryption_key)) {
+                  decrypt_util(query_files$contrasts, encryption_key)
+                } else {
+                  warning("[UploadServer] No encryption key available, using raw URL")
+                  query_files$contrasts
+                }
+
+                file <- read_query_files(contrasts_url)
+                df <- playbase::read_contrasts(file)
+                uploaded$contrasts.csv <- df
+              }
             }
           } else {
             shinyalert::shinyalert(

components/board.upload/R/upload_utils.R

@@ -308,3 +308,26 @@ write_check_output <- function(
     write(unlist(lines), file.path(raw_dir, "CHECKS_OUTPUT"), append = TRUE)
   }
 }
+
+# Check if there are counts/samples file links on the query parameters
+check_query_files <- function() {
+  counts <- shiny::getQueryString()$counts
+  samples <- shiny::getQueryString()$samples
+  contrasts <- shiny::getQueryString()$contrasts
+  datatype <- shiny::getQueryString()$datatype
+  organism <- shiny::getQueryString()$organism
+  return(list(
+    counts = counts,
+    samples = samples,
+    contrasts = contrasts,
+    datatype = datatype,
+    organism = organism
+  ))
+}
+
+# Read query files
+read_query_files <- function(url) {
+  destination <- tempfile(fileext = ".csv")
+  download.file(url, destination)
+  return(destination)
+}

components/modules/AuthenticationModule.R

@@ -1251,7 +1251,146 @@ LoginCodeAuthenticationModule <- function(id,
   })
 }
 
+## ================================================================================
+## Utility functions for authentication
+## ================================================================================
+
+EmailEncryptedAuthenticationModule <- function(
+    id = "auth",
+    show_modal = TRUE,
+    skip_modal = FALSE,
+    domain = opt$DOMAIN) {
+  shiny::moduleServer(id, function(input, output, session) {
+    message("[AuthenticationModule] >>>> using EmailEncrypted authentication <<<<")
+    ns <- session$ns
+
+    # Get encryption key
+    encryption_key <- tryCatch(
+      {
+        readLines(file.path(OPG, "etc/keys/encryption.txt"))[1]
+      },
+      error = function(w) {
+        NULL
+      }
+    )
+    if (is.null(encryption_key)) {
+      ## we continue without decryption, just to test, unsafe
+      warning("[EmailEncryptedAuthenticationModule] ERROR : missing encryption_key file!!!")
+    }
+
+    USER <- shiny::reactiveValues(
+      method = "email-encrypted",
+      logged = FALSE,
+      username = NA,
+      email = NA,
+      level = "",
+      limit = "",
+      options = opt, ## global
+      user_dir = PGX.DIR ## global
+    )
+
+    if (show_modal) {
+      m <- splashLoginModal(
+        ns = ns,
+        with.username = FALSE,
+        with.email = FALSE,
+        with.password = FALSE,
+        title = "Sign in",
+        subtitle = "Ready to explore your data?",
+        button.text = "Sure I am!"
+      )
+      shiny::showModal(m)
+      if (skip_modal) {
+        shinyjs::runjs("$('#auth-login_submit_btn').click();")
+      }
+    }
+
+    resetUSER <- function() {
+      dbg("[EmailEncryptedAuthenticationModule] resetUSER called")
+      USER$logged <- FALSE
+      USER$username <- NA
+      USER$email <- NA
+      USER$password <- NA
+      USER$level <- ""
+      USER$limit <- ""
+
+      PLOT_DOWNLOAD_LOGGER <<- reactiveValues(log = list(), str = "")
+    }
+
+    output$showLogin <- shiny::renderUI({
+      resetUSER()
+    })
 
+    output$login_warning <- shiny::renderText("")
+
+    ## --------------------------------------
+    ## Step 1: Get email query field
+    ## --------------------------------------
+
+    query_email <- shiny::reactive({
+      query_email <- shiny::getQueryString()$email
+      query_email
+    })
+
+    ## --------------------------------------
+    ## Step 2: Decrypt and Login user
+    ## --------------------------------------
+    shiny::observeEvent(input$login_submit_btn, {
+      if (is.null(query_email())) {
+        dbg("[EmailEncryptedAuthenticationModule] invalid email hash")
+        output$login_warning <- shiny::renderText("invalid email hash")
+        return(NULL)
+      }
+
+      # Decrypt email if encryption key is available
+      decrypted_email <- if (!is.null(encryption_key)) {
+        decrypt_util(query_email(), encryption_key, remove_suffix = TRUE)
+      } else {
+        warning("[EmailEncryptedAuthenticationModule] No encryption key available, using raw email")
+        query_email()
+      }
+
+      # Validate decrypted email
+      if (is.null(decrypted_email)) {
+        dbg("[EmailEncryptedAuthenticationModule] failed to decrypt email")
+        output$login_warning <- shiny::renderText("invalid email format")
+        return(NULL)
+      }
+
+      USER$email <- decrypted_email
+      USER$username <- decrypted_email
+      USER$logged <- TRUE
+
+      # TODO Use some sort of user_database to see if email allowed??
+      # TODO check domain (?)
+
+      # Set up user directory
+      USER$user_dir <- file.path(PGX.DIR, USER$email)
+      create_user_dir_if_needed(USER$user_dir, PGX.DIR)
+      if (!opt$ENABLE_USERDIR) {
+        USER$user_dir <- file.path(PGX.DIR)
+      }
+
+      dbg("[EmailEncryptedAuthenticationModule] using user OPTIONS")
+      USER$options <- read_user_options(USER$user_dir)
+      session$sendCustomMessage("set-user", list(user = USER$email))
+
+      # Handle query files and navigation
+      query_files <- check_query_files() |> unlist()
+      if (!is.null(query_files)) {
+        bigdash.selectTab(session, "upload-tab")
+        shinyjs::runjs("$('#upload-start_upload').click();")
+      } else {
+        bigdash.selectTab(session, "load-tab")
+      }
+    })
+
+    ## export as 'public' functions
+    USER$resetUSER <- resetUSER
+
+    return(USER)
+  })
+}
 ## ================================================================================
 ## ================================= END OF FILE ==================================
 ## ================================================================================