diff --git a/.gitignore b/.gitignore index e2f725ad8..28e312cfa 100644 --- a/.gitignore +++ b/.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 diff --git a/R/mod_uploadPackage.R b/R/mod_uploadPackage.R index d8507b5e9..a9e4f7468 100644 --- a/R/mod_uploadPackage.R +++ b/R/mod_uploadPackage.R @@ -302,34 +302,35 @@ 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', @@ -337,7 +338,7 @@ uploadPackageServer <- function(id, user, auto_list, credentials, parent) { 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, "") @@ -345,32 +346,34 @@ uploadPackageServer <- function(id, user, auto_list, credentials, parent) { } 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"))) { diff --git a/R/utils_insert_db.R b/R/utils_insert_db.R index 0c95e09ae..42f9c60b0 100644 --- a/R/utils_insert_db.R +++ b/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) diff --git a/R/utils_startup.R b/R/utils_startup.R index 644d0f578..e9df10421 100644 --- a/R/utils_startup.R +++ b/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, diff --git a/app.R b/app.R index d464155d4..ac28ffdf0 100644 --- a/app.R +++ b/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( + "Note:
+ Use the following credentials to log on with varying roles & privileges in the app, expanded upon here: +

+ U: demo_admin;     P: Admin@1 +
+ U: demo_lead;       P: Lead@1 +
+ U: demo_reviewer; P: Reviewer@1 +
+ U: demo_viewer;    P: Viewer@1") + ) diff --git a/credentials_demo.sqlite b/credentials_demo.sqlite new file mode 100644 index 000000000..8aa102814 Binary files /dev/null and b/credentials_demo.sqlite differ diff --git a/database_demo.sqlite b/database_demo.sqlite new file mode 100644 index 000000000..64938a0b2 Binary files /dev/null and b/database_demo.sqlite differ diff --git a/dev/run_dev.R b/dev/run_dev.R index 92f199d23..2dbeaae9f 100644 --- a/dev/run_dev.R +++ b/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('Note: To log in for the first time, use the admin user: + admin with password QWERTY1.')) # 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) diff --git a/inst/db-config.yml b/inst/db-config.yml index 923d14eaa..8dfde827e 100644 --- a/inst/db-config.yml +++ b/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 diff --git a/source/dummy_placeholder_file b/source/dummy_placeholder_file new file mode 100644 index 000000000..55b220e7a --- /dev/null +++ b/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 \ No newline at end of file diff --git a/vignettes/riskassessment.Rmd b/vignettes/riskassessment.Rmd index 2ed8b94cb..1876ee9f4 100644 --- a/vignettes/riskassessment.Rmd +++ b/vignettes/riskassessment.Rmd @@ -403,4 +403,4 @@ Check out some of the `riskmetric` or `riskassessment` presentations in [www.pha


-
\ No newline at end of file +