demo-shinyapps.io-v310 diff with dev

.gitignore

@@ -1,5 +1,4 @@
 rsconnect/
-/*.sqlite
 .Rproj.user
 .Rhistory
 .RData
@@ -12,6 +11,8 @@ inst/doc
 auto_decisions.json
 ^docs$
 docs/
+*.sqlite
+!*demo.sqlite
 tarballs/
 report_preferences/
 .Renviron

R/mod_uploadPackage.R

@@ -302,75 +302,78 @@ uploadPackageServer <- function(id, user, auto_list, credentials, parent) {
 
     })
 
-    checking_urls <- reactiveValues()
-
-    observeEvent(input$check_urls, {
-      checking_urls$finished <- FALSE
-      removeModal()
-    })
-
-    observe({
-      req(input$check_urls, !isTRUE(checking_urls$finished))
-      invalidateLater(60*1000)
-
-      withProgress({
-        good_urls <- purrr::map_lgl(checking_urls$url_lst, 
-                                    ~ try(curlGetHeaders(.x, verify = FALSE), silent = TRUE) %>%
-                                      {class(.) != "try-error" && attr(., "status") != 404})
-        Sys.sleep(.5)
-      }, message = "Checking URLs")
-
-      checking_urls$finished <- all(good_urls)
-    })
-
-    observeEvent(checking_urls$finished, {
-      req(checking_urls$finished)
-      showModal(modalDialog(
-        title = h2("Data Connection Issues"),
-        h5("The needed URLs are now reachable. Please try to upload the desired packages now."),
-      ))
-    })
+    # Commented out only for shinyapps.io deployment!
+    # checking_urls <- reactiveValues()
+    # 
+    # observeEvent(input$check_urls, {
+    #   checking_urls$finished <- FALSE
+    #   removeModal()
+    # })
+    # 
+    # observe({
+    #   req(input$check_urls, !isTRUE(checking_urls$finished))
+    #   invalidateLater(60*1000)
+    # 
+    #   withProgress({
+    #     good_urls <- purrr::map_lgl(checking_urls$url_lst,
+    #                                 ~ try(curlGetHeaders(.x, verify = FALSE), silent = TRUE) %>%
+    #                                   {class(.) != "try-error" && attr(., "status") != 404})
+    #     Sys.sleep(.5)
+    #   }, message = "Checking URLs")
+    # 
+    #   checking_urls$finished <- all(good_urls)
+    # })
+    # 
+    # observeEvent(checking_urls$finished, {
+    #   req(checking_urls$finished)
+    #   showModal(modalDialog(
+    #     title = h2("Data Connection Issues"),
+    #     h5("The needed URLs are now reachable. Please try to upload the desired packages now."),
+    #   ))
+    # })
 
     uploaded_pkgs <- reactiveVal(data.frame())
     # Save all the uploaded packages, marking them as 'new', 'not found', 
     # 'duplicate' or 'removed'
     observeEvent(uploaded_pkgs00(), {
 
       uploaded_packages <- uploaded_pkgs00()
-      uploaded_pkgs00(NULL)
+      uploaded_pkgs00(NULL) # keep!
       uploaded_packages$score <- NA_real_
       if (!rlang::is_empty(auto_list())) {
         uploaded_packages$decision <- dplyr::coalesce(uploaded_packages$decision, "")
         uploaded_packages$decision_rule <- ""
       }
       np <- nrow(uploaded_packages)
 
-      if (!isTRUE(getOption("shiny.testmode"))) {
-        url_lst <- c(
-          "https://cran.r-project.org",
-          "https://cranlogs.r-pkg.org"
-        )
-
-        good_urls <- purrr::map_lgl(url_lst, 
-                                    ~ try(curlGetHeaders(.x, verify = FALSE), silent = TRUE) %>%
-                                      {class(.) != "try-error" && attr(., "status") != 404})
 
-        if (!all(good_urls)) {
-          checking_urls$url_lst <- url_lst[!good_urls]
-          showModal(modalDialog(
-            title = h2("Data Connection Issues"),
-            h5("The process has been cancelled because at least one of the URLs used to populate the metrics is unreachable at this time."),
-            br(),
-            h5("Notify when  URLs are reachable?"),
-            footer = tagList(
-              actionButton(ns("check_urls"), "Yes"),
-              modalButton("No")
-            )
-          ))
-        }
-
-      req(all(good_urls))
-      }
+      # if (!isTRUE(getOption("shiny.testmode"))) {
+      #   url_lst <- list(
+      #     "https://cran.rstudio.com",
+      #     "https://cran.r-project.org",
+      #     "https://cranlogs.r-pkg.org"
+      #   )
+      #   
+      #   good_urls <- purrr::map_lgl(url_lst, 
+      #                               ~ try(curlGetHeaders(.x, verify = FALSE), silent = TRUE) %>%
+      #                                 {class(.) != "try-error" && attr(., "status") != 404})
+      # 
+      #   if (!all(good_urls)) {
+      #     checking_urls$url_lst <- url_lst[!good_urls]
+      #     showModal(modalDialog(
+      #       title = h2("Data Connection Issues"),
+      #       h5("The process has been cancelled because at least one of the URLs used to populate the metrics is unreachable at this time."),
+      #       br(),
+      #       h5("Notify when  URLs are reachable?"),
+      #       footer = tagList(
+      #         actionButton(ns("check_urls"), "Yes"),
+      #         modalButton("No")
+      #       )
+      #     ))
+      #   }
+      #   
+      # req(all(good_urls))
+      # }
 
       if (!isTruthy(session$userData$repo_pkgs())) {
         if (isTRUE(getOption("shiny.testmode"))) {

R/utils_insert_db.R

@@ -170,7 +170,7 @@ insert_riskmetric_to_db <- function(pkg_name, pkg_version = "",
   # Get the metrics weights to be used during pkg_score.
   metric_weights <- metric_weights_df$weight
   names(metric_weights) <- metric_weights_df$name
-  
+
   riskmetric_score <-
     riskmetric_assess %>%
     riskmetric::pkg_score(weights = metric_weights)

R/utils_startup.R

@@ -79,12 +79,12 @@ create_credentials_db <- function(db_name, admin_role = ""){
 
   # Init the credentials table for credentials database
   credentials <- data.frame(
-    user = "ADMIN",
-    password = "QWERTY1",
+    user = c("demo_admin", "demo_lead", "demo_reviewer", "demo_viewer"),
+    password = c("Admin@1", "Lead@1", "Reviewer@1", "Viewer@1"),
     # password will automatically be hashed
     admin = TRUE,
     expire = as.character(get_Date()),
-    role = admin_role,
+    role = c("admin", "lead", "reviewer", "viewer"),
     stringsAsFactors = FALSE
   )
 
@@ -101,7 +101,8 @@ create_credentials_db <- function(db_name, admin_role = ""){
     con, name = "pwd_mngt",
     passphrase = passphrase) %>%
     dplyr::mutate(must_change = ifelse(
-      have_changed == "TRUE", must_change, as.character(TRUE)))
+      user == "ADMIN" & have_changed == "FALSE",
+      as.character(TRUE), must_change))
 
   shinymanager::write_db_encrypt(
     con,

app.R

@@ -2,6 +2,21 @@
 # To deploy, run: rsconnect::deployApp()
 # Or use the blue button on top of this file
 
+Sys.setenv(GOLEM_CONFIG_ACTIVE = "demo")
+# options(rsconnect.max.bundle.files = 20000)
+options(shiny.fullstacktrace = TRUE)
 pkgload::load_all(export_all = FALSE,helpers = FALSE,attach_testthat = FALSE)
 options( "golem.app.prod" = TRUE)
-riskassessment::run_app() # add parameters here (if any)
+riskassessment::run_app(
+  login_note = shiny::HTML(
+  "<em>Note:</em><br>
+  Use the following credentials to log on with varying roles & privileges in the app, expanded upon <a href='https://pharmar.github.io/riskassessment/articles/User_Roles_and_Privileges.html#roles' target='_blank'>here</a>:
+  <br><br>
+    U: <span style='text-transform:none;'><u>demo_admin</u></span>; &nbsp;&nbsp;&nbsp; P: <u><span style='text-transform:none;'>Admin@1</span></u>
+  <br>
+    U: <span style='text-transform:none;'><u>demo_lead</u></span>; &nbsp;&nbsp;&nbsp;&nbsp;&nbsp; P: <u><span style='text-transform:none;'>Lead@1</span></u>
+  <br>
+    U: <span style='text-transform:none;'><u>demo_reviewer</u></span>; P: <u><span style='text-transform:none;'>Reviewer@1</span></u>
+    <br>
+    U: <span style='text-transform:none;'><u>demo_viewer</u></span>; &nbsp;&nbsp;  P: <u><span style='text-transform:none;'>Viewer@1</span></u>")
+  ) 

dev/run_dev.R

@@ -10,12 +10,17 @@ golem::detach_all_attached()
 # Document and reload your package, which runs these three functions...
 golem::document_and_reload()
 
-# Run the application  
-run_app(pre_auth_user = 'admin')
+
+# Run the application 
+run_app(
+  pre_auth_user = 'admin',
+  login_note = shiny::HTML('<em>Note:</em> To log in for the first time, use the admin user:
+                          <u>admin</u> with password <u>QWERTY1</u>.'))
 # run_app(pre_auth_user = 'lead')
 # run_app(pre_auth_user = 'reviewer')
 # run_app(pre_auth_user = 'viewer')
 
+
 # # turn off any options
 # options(shiny.autoload.r=NULL)
 

inst/db-config.yml

@@ -22,8 +22,6 @@ default:
       - Low Risk
       - Medium Risk
       - High Risk
-  metric_weights:
-    covr_coverage: 0
 example:
   assessment_db: database_ex.sqlite
   credential_db: credentials_ex.sqlite
@@ -75,6 +73,27 @@ example2:
       - GxP Compliant
       - Needs Review
       - Not GxP Compliant
+demo:
+  assessment_db: database_demo.sqlite
+  credential_db: credentials_demo.sqlite
+  metric_weights:
+    covr_coverage: 0
+  decisions:
+    rules:
+      rule_1:
+        metric: bugs_status
+        condition: ~ metric_score(.x) <= .25
+        decision: High Risk
+      rule_2:
+        metric: dependencies
+        condition: ~ length(.x) >= 30
+        decision: High Risk
+      Medium Risk:
+        - .3983
+        - .6391
+      High Risk:
+        - .6391
+        - 1
 noncredentialed:
   use_shinymanager: false
   assessment_db: database_noncredentialed.sqlite

source/dummy_placeholder_file

@@ -0,0 +1,11 @@
+DO NOT DELETE THIS FILE
+
+It's here for convenience so that this demo branch is easier to deploy to 
+shinyapps.io. When deploying, having any file in the source/ directory
+will ensure that this folder persistents when deployed. Thus, it aptly 
+facilitates storage of untarred pkg sources much more consistently. Without it,
+shinyapps.io will frequenly (and successfully) remove the source/ dir, which is
+not ideal.
+
+Thank you!
+{riskassessment} dev team

vignettes/riskassessment.Rmd

@@ -403,4 +403,4 @@ Check out some of the `riskmetric` or `riskassessment` presentations in [www.pha
 <br>
 <br>
 <br>
-<br>
+<br>