Merge pull request #703 from pharmaR/jt-700-noncredential_deploy

Allow a non-credentialed deployment

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: riskassessment
 Title: A web app designed to interface with the `riskmetric` package
-Version: 3.0.0.9009
+Version: 3.0.0.9010
 Authors@R: c( 
     person("Aaron", "Clark", role = c("aut", "cre"), email = "aaron.clark@biogen.com"),
     person("Robert", "Krajcik", role = "aut", email = "robert.krajcik@biogen.com"),

NEWS.md

@@ -9,6 +9,7 @@
 * Fixed bug where HTML reports displayed a darker green in the cards' meters
 * Only run configuration checkers when configuring the database
 * Added dependencies/reverse dependencies card hyperlink (#597)
+* Added non-shinymanager deployment option (#700)
 
 # riskassessment 3.0.0
 

R/app_server.R

@@ -41,6 +41,11 @@ app_server <- function(input, output, session) {
     res_auth[["admin"]] <- !isTRUE(golem::get_golem_options('nonadmin'))
     res_auth[["user"]] <- "test_user"
     res_auth[["role"]] <- ifelse(!isTRUE(golem::get_golem_options('nonadmin')), "admin", "reviewer")
+  } else if (isFALSE(get_db_config("use_shinymanager"))) {
+    res_auth <- reactiveValues()
+    res_auth[["admin"]] <- FALSE
+    res_auth[["user"]] <- session$user %||% "anonymous"
+    res_auth[["role"]] <- intersect(unlist(session$groups, use.names = FALSE), dbSelect("select user_role from roles")[[1]]) %||% "default"
   } else {
     # check_credentials directly on sqlite db
     res_auth <- shinymanager::secure_server(
@@ -64,7 +69,7 @@ app_server <- function(input, output, session) {
   })
 
   observeEvent(res_auth$user, {
-    req(res_auth$admin == TRUE | "weight_adjust" %in% credential_config$privileges[[res_auth$role]])
+    req(res_auth$admin == TRUE || any(c("admin", "weight_adjust") %in% unlist(credential_config$privileges[res_auth$role])))
 
       appendTab("apptabs",
                 tabPanel(
@@ -86,12 +91,13 @@ app_server <- function(input, output, session) {
                           admin_ui
                         }
                       ),
-                    if (res_auth$admin)
+                    if (res_auth$admin == TRUE || "admin" %in% unlist(credential_config$privileges[res_auth$role]))
                       tabPanel(
                         id = "privilege_id",
                         title = "Roles & Privileges",
                         mod_user_roles_ui("userRoles")
                       ),
+                    if ("weight_adjust" %in% unlist(credential_config$privileges[res_auth$role]))
                     tabPanel(
                       id = "reweight_id",
                       title = "Assessment Reweighting",
@@ -105,7 +111,7 @@ app_server <- function(input, output, session) {
   observeEvent(credential_config$privileges, {
     req(user$role)
 
-    if ("weight_adjust" %in% credential_config$privileges[[user$role]])
+    if ("weight_adjust" %in% unlist(credential_config$privileges[user$role]))
       showTab("credentials", "Assessment Reweighting")
     else
       hideTab("credentials", "Assessment Reweighting")

R/mod_addComment.R

@@ -32,7 +32,7 @@ addCommentUI <- function(id) {
 #' 
 addCommentServer <- function(id, metric_abrv, user, credentials, pkg_name) {
   if (missing(credentials))
-    credentials <- get_db_config("credentials")
+    credentials <- get_credential_config()
 
   moduleServer(id, function(input, output, session) {
 
@@ -50,22 +50,22 @@ addCommentServer <- function(id, metric_abrv, user, credentials, pkg_name) {
         width = "100%",
         rows = 4,
         placeholder = glue::glue(
-          "Commenting as user: {user$name}, role: {user$role}"
+          "Commenting as user: {user$name}, role: {paste(user$role, collapse = ', ')}"
         )
       )
     })
 
     observeEvent(input$submit_comment, {
       req(input$add_comment)
-      req("general_comment" %in% credentials$privileges[[user$role]])
+      req("general_comment" %in% unlist(credentials$privileges[user$role], use.name = FALSE))
 
       comment <- trimws(input$add_comment)
 
       if (comment != "") {
 
         dbUpdate(
         "INSERT INTO comments values({pkg_name()}, {user$name}, 
-        {user$role}, {comment}, {metric_abrv},
+        {paste(user$role, collapse = ', ')}, {comment}, {metric_abrv},
         {getTimeStamp()})"
         )
 

R/mod_code_explorer.R

@@ -73,7 +73,7 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgdir = reactiveVal(), c
           ),
           br(), br(),
           div(id = ns("comments_for_fe"), fluidRow(
-            if ("general_comment" %in% credentials$privileges[[user$role]]) addCommentUI(id = ns("add_comment")),
+            if ("general_comment" %in% unlist(credentials$privileges[user$role], use.name = FALSE)) addCommentUI(id = ns("add_comment")),
             viewCommentsUI(id = ns("view_comments"))))
         )
       }

R/mod_communityMetrics.R

@@ -25,7 +25,7 @@ communityMetricsUI <- function(id) {
 #' 
 communityMetricsServer <- function(id, selected_pkg, community_metrics, user, credentials) {
   if (missing(credentials))
-    credentials <- get_db_config("credentials")
+    credentials <- get_credential_config()
 
   moduleServer(id, function(input, output, session) {
 
@@ -51,7 +51,7 @@ communityMetricsServer <- function(id, selected_pkg, community_metrics, user, cr
                      plotly::plotlyOutput(NS(id, "downloads_plot"), height = "500px")))),
             br(), br(),
             div(id = "comments_for_cum", fluidRow( 
-              if ("general_comment" %in% credentials$privileges[[user$role]]) addCommentUI(id = session$ns("add_comment")),
+              if ("general_comment" %in% unlist(credentials$privileges[user$role], use.name = FALSE)) addCommentUI(id = session$ns("add_comment")),
               viewCommentsUI(id = session$ns("view_comments"))))
           )
       }

R/mod_decision_automation.R

@@ -94,7 +94,7 @@ mod_decision_automation_ui_2 <- function(id){
 #' @importFrom sortable sortable_js sortable_options sortable_js_capture_input
 mod_decision_automation_server <- function(id, user, credentials){
   if (missing(credentials))
-    credentials <- get_db_config("credentials")
+    credentials <- get_credential_config()
   moduleServer( id, function(input, output, session){
     ns <- session$ns
 
@@ -428,7 +428,7 @@ mod_decision_automation_server <- function(id, user, credentials){
     #### Outputs ####
     purrr::walk(c("auto_dropdown", "auto_dropdown2"), ~
                   observeEvent(input[[.x]], {
-                    req("auto_decision_adjust" %in% credentials$privileges[[user$role]])
+                    req("auto_decision_adjust" %in% unlist(credentials$privileges[user$role], use.name = FALSE))
 
                     showModal(modalDialog(
                       size = "l",
@@ -515,7 +515,7 @@ mod_decision_automation_server <- function(id, user, credentials){
     })
 
     output$auto_classify <- renderUI({
-      if ("auto_decision_adjust" %in% credentials$privileges[[user$role]]) {
+      if ("auto_decision_adjust" %in% unlist(credentials$privileges[user$role], use.name = FALSE)) {
         tagList(
           br(),br(),
           hr(),
@@ -540,7 +540,7 @@ mod_decision_automation_server <- function(id, user, credentials){
     })
 
     output$decision_rule_div <- renderUI({
-      req("auto_decision_adjust" %in% credentials$privileges[[user$role]])
+      req("auto_decision_adjust" %in% unlist(credentials$privileges[user$role], use.name = FALSE))
       tagList(
         div(
           style = "display: flex",
@@ -625,7 +625,7 @@ mod_decision_automation_server <- function(id, user, credentials){
 
     output$auto_settings <-
       renderUI({
-        req("auto_decision_adjust" %in% credentials$privileges[[user$role]])
+        req("auto_decision_adjust" %in% unlist(credentials$privileges[user$role], use.name = FALSE))
 
         div(
           style = "float: right;",
@@ -637,7 +637,7 @@ mod_decision_automation_server <- function(id, user, credentials){
 
     output$auto_settings2 <-
       renderUI({
-        req("auto_decision_adjust" %in% credentials$privileges[[user$role]])
+        req("auto_decision_adjust" %in% unlist(credentials$privileges[user$role], use.name = FALSE))
 
         div(
           style = "float: right;",
@@ -721,7 +721,7 @@ mod_decision_automation_server <- function(id, user, credentials){
       })
 
     observeEvent(input$submit_auto, {
-      req("auto_decision_adjust" %in% credentials$privileges[[user$role]])
+      req("auto_decision_adjust" %in% unlist(credentials$privileges[user$role], use.name = FALSE))
 
       showModal(modalDialog(
         size = "l",
@@ -752,7 +752,7 @@ mod_decision_automation_server <- function(id, user, credentials){
     })
 
     observeEvent(input$submit_color, {
-      req("auto_decision_adjust" %in% credentials$privileges[[user$role]])
+      req("auto_decision_adjust" %in% unlist(credentials$privileges[user$role], use.name = FALSE))
 
       showModal(modalDialog(
         size = "l",
@@ -784,7 +784,7 @@ mod_decision_automation_server <- function(id, user, credentials){
     })
 
     observeEvent(input$confirm_submit_auto, {
-      req("auto_decision_adjust" %in% credentials$privileges[[user$role]])
+      req("auto_decision_adjust" %in% unlist(credentials$privileges[user$role], use.name = FALSE))
       req(!disable_auto_submit())
 
       out_lst <- purrr::compact(reactiveValuesToList(auto_decision))
@@ -796,7 +796,7 @@ mod_decision_automation_server <- function(id, user, credentials){
       if (rlang::is_empty(rules_updates)) {
         risk_rule_update(rules_updates)
         dbUpdate("DELETE FROM rules")
-        loggit::loggit("INFO", glue::glue("Decision automation rules have been disabled by {user$name} ({user$role})."))
+        loggit::loggit("INFO", glue::glue("Decision automation rules have been disabled by {user$name} ({paste(user$role, collapse = ', ')})."))
       } else {
         if (!is.null(rule_lst[["rule_else"]][["decision"]]))
           rules_updates[["rule_else"]] <- rule_lst[["rule_else"]]
@@ -812,7 +812,7 @@ mod_decision_automation_server <- function(id, user, credentials){
           glue::glue_collapse(", ")
         dbUpdate("DELETE FROM rules")
         dbUpdate(glue::glue("INSERT INTO rules (rule_type, metric_id, condition, decision_id) VALUES {rule_out};"))
-        loggit::loggit("INFO", glue::glue("Decision automation rules were updated/implemented by {user$name} ({user$role})."))
+        loggit::loggit("INFO", glue::glue("Decision automation rules were updated/implemented by {user$name} ({paste(user$role, collapse = ', ')})."))
       }
 
       removeModal()
@@ -829,7 +829,7 @@ mod_decision_automation_server <- function(id, user, credentials){
 
 
     observeEvent(input$confirm_submit_col, {
-      req("auto_decision_adjust" %in% credentials$privileges[[user$role]])
+      req("auto_decision_adjust" %in% unlist(credentials$privileges[user$role], use.name = FALSE))
 
       selected_colors <- 
         decision_lst %>%
@@ -839,7 +839,7 @@ mod_decision_automation_server <- function(id, user, credentials){
         dbUpdate("UPDATE decision_categories SET color = {.x} WHERE decision = {.y}")
         shinyjs::runjs(glue::glue("document.documentElement.style.setProperty('--{risk_lbl(.y, type = 'attribute')}-color', '{.x}');"))
         })
-      loggit::loggit("INFO", glue::glue("The decision category display colors were modified by {user$name} ({user$role})"))
+      loggit::loggit("INFO", glue::glue("The decision category display colors were modified by {user$name} ({paste(user$role, collapse = ', ')})"))
       color_current(selected_colors)
 
       removeModal()

R/mod_downloadHandler.R

@@ -269,7 +269,7 @@ mod_downloadHandler_server <- function(id, pkgs, user, metric_weights){
                               app_version = golem::get_golem_options('app_version'),
                               metric_weights = metric_weights(),
                               user_name = user$name,
-                              user_role = user$role,
+                              user_role = paste(user$role, collapse = ', '),
                               overall_comments = overall_comments,
                               pkg_summary = pkg_summary,
                               mm_comments = mm_comments,

R/mod_introJS.R

@@ -33,11 +33,11 @@ introJSUI <- function(id) {
 #' @keywords internal
 introJSServer <- function(id, text, user, credentials) {
   if (missing(credentials))
-    credentials <- get_db_config("credentials")
+    credentials <- get_credential_config()
   moduleServer(id, function(input, output, session) {
 
     steps <- reactive({
-      if(user$admin || "weight_adjust" %in% credentials$privileges[[user$role]]) {
+      if(user$admin || "weight_adjust" %in% unlist(credentials$privileges[user$role], use.name = FALSE)) {
         apptab_steps <- bind_rows(apptab_admn, apptab_steps)
       }
 

R/mod_maintenanceMetrics.R

@@ -20,7 +20,7 @@ maintenanceMetricsUI <- function(id) {
 #' 
 maintenanceMetricsServer <- function(id, selected_pkg, maint_metrics, user, credentials, parent) {
   if (missing(credentials))
-    credentials <- get_db_config("credentials")
+    credentials <- get_credential_config()
 
   moduleServer(id, function(input, output, session) {
        ns <- NS(id)
@@ -39,7 +39,7 @@ maintenanceMetricsServer <- function(id, selected_pkg, maint_metrics, user, cred
             metricGridUI(NS(id, 'metricGrid')),
             br(), br(),
             fluidRow(div(id = "comments_for_mm",
-                         if ("general_comment" %in% credentials$privileges[[user$role]]) addCommentUI(NS(id, 'add_comment')),
+                         if ("general_comment" %in% unlist(credentials$privileges[user$role], use.name = FALSE)) addCommentUI(NS(id, 'add_comment')),
                          viewCommentsUI(NS(id, 'view_comments')))
             )
           )

R/mod_pkg_explorer.R

@@ -68,7 +68,7 @@ mod_pkg_explorer_server <- function(id, selected_pkg,
             ),
             br(), br(),
             div(id = ns("comments_for_se"), fluidRow(
-              if ("general_comment" %in% credentials$privileges[[user$role]]) addCommentUI(id = ns("add_comment")),
+              if ("general_comment" %in% unlist(credentials$privileges[user$role], use.name = FALSE)) addCommentUI(id = ns("add_comment")),
               viewCommentsUI(id = ns("view_comments")))),
           id = id
         )

R/mod_reportPreview.R

@@ -40,7 +40,7 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics,
                                 downloads_plot_data, user, credentials, app_version,
                                 metric_weights) {
   if (missing(credentials))
-    credentials <- get_db_config("credentials")
+    credentials <- get_credential_config()
 
   moduleServer(id, function(input, output, session) {
 
@@ -82,7 +82,7 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics,
 
             br(), br(),
 
-            if ("overall_comment" %in% credentials$privileges[[user$role]]) 
+            if ("overall_comment" %in% unlist(credentials$privileges[user$role], use.name = FALSE)) 
               div(id = NS(id, "pkg-summary-grp"),
                   # Compose pkg summary - either disabled, enabled, or pre-populated
                   uiOutput(NS(id, "pkg_summary_ui")),
@@ -119,7 +119,7 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics,
               HTML("<span class='h2 txtasis'>R Package Risk Assessment  </span><br>"),
               HTML(glue::glue("<span class='h4 txtasis'>Report for Package: {selected_pkg$name()}</span><br>")),
               if("Report Author" %in% report_includes())
-                HTML(glue::glue("<span class='h4 txtasis'>Author (Role): {user$name} ({user$role})</span><br>")),
+                HTML(glue::glue("<span class='h4 txtasis'>Author (Role): {user$name} ({paste(user$role, collapse = ', ')})</span><br>")),
               if("Report Date" %in% report_includes())
                 HTML(glue::glue("<span class='h4 txtasis'>Report Date: {format(get_time(), '%B %d, %Y')}</span><br>")),
 
@@ -289,7 +289,7 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics,
       } else { # first summary!
         dbUpdate(
           "INSERT INTO comments
-          VALUES ({selected_pkg$name()}, {user$name}, {user$role},
+          VALUES ({selected_pkg$name()}, {user$name}, {paste(user$role, collapse = ', ')},
           {current_summary}, 's', {getTimeStamp()})")
         showModal(modalDialog(
           title = h2("Summary Submitted"),
@@ -315,7 +315,7 @@ reportPreviewServer <- function(id, selected_pkg, maint_metrics, com_metrics,
           SET comment = {input$pkg_summary}, added_on = {getTimeStamp()}
           WHERE id = {selected_pkg$name()} AND
           user_name = {user$name} AND
-          user_role = {user$role} AND
+          user_role = {paste(user$role, collapse = ', ')} AND
           comment_type = 's'"
       )