diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml
index dffb85e7c..ff2b70458 100644
--- a/.github/workflows/test-coverage.yaml
+++ b/.github/workflows/test-coverage.yaml
@@ -1,4 +1,4 @@
-# Workflow derived from https://github.com/r-lib/actions/tree/master/examples
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
on:
push:
@@ -9,6 +9,8 @@ on:
name: test-coverage
+permissions: read-all
+
jobs:
test-coverage:
runs-on: ubuntu-latest
@@ -24,21 +26,45 @@ jobs:
sudo apt-get update
sudo apt-get install -y texlive-xetex
- - uses: actions/checkout@v2
+ - uses: actions/checkout@v4
- uses: r-lib/actions/setup-pandoc@v2
- uses: r-lib/actions/setup-r@v2
with:
- use-public-rspm: true
+ use-public-rspm: false
r-version: 'renv'
- uses: r-lib/actions/setup-renv@v2
- - name: Install riskassessment
- shell: bash
- run: R CMD INSTALL --preclean .
-
- name: Test coverage
- run: covr::codecov()
+ run: |
+ cov <- covr::package_coverage(
+ quiet = FALSE,
+ clean = FALSE,
+ install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
+ )
+ covr::to_cobertura(cov)
shell: Rscript {0}
+
+ - uses: codecov/codecov-action@v4
+ with:
+ fail_ci_if_error: ${{ github.event_name != 'pull_request' && true || false }}
+ file: ./cobertura.xml
+ plugin: noop
+ disable_search: true
+ token: ${{ secrets.CODECOV_TOKEN }}
+
+ - name: Show testthat output
+ if: always()
+ run: |
+ ## --------------------------------------------------------------------
+ find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
+ shell: bash
+
+ - name: Upload test results
+ if: failure()
+ uses: actions/upload-artifact@v4
+ with:
+ name: coverage-test-failures
+ path: ${{ runner.temp }}/package
diff --git a/.gitignore b/.gitignore
index e2f725ad8..c8976059e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,5 +1,4 @@
rsconnect/
-/*.sqlite
.Rproj.user
.Rhistory
.RData
@@ -12,6 +11,7 @@ inst/doc
auto_decisions.json
^docs$
docs/
-tarballs/
+*.sqlite
+!*demo.sqlite
report_preferences/
.Renviron
diff --git a/DESCRIPTION b/DESCRIPTION
index d21963c06..66601712e 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: riskassessment
Title: A web app designed to interface with the `riskmetric` package
-Version: 3.1.0
+Version: 3.1.1
Authors@R: c(
person("Aaron", "Clark", role = c("aut", "cre"), email = "clark.aaronchris@gmail.com"),
person("Jeff", "Thompson", role = c("aut"), email = "jeff.thompson51317@gmail.com", comment = "Co-Lead"),
diff --git a/NEWS.md b/NEWS.md
index 8882138a5..678888e23 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,10 @@
+# riskassessment 3.1.1
+
+* Added navigation controls in Function Explorer tab (#644)
+* Fixed bug that crashed the Package Dependencies page for pkgs without any dependency info available (#802)
+* Fixed bug that incorrectly displayed 0 dependencies as 1 (#805)
+* Fixed bug that kept full list of available packages from populating (#776)
+
# riskassessment 3.1.0
### User Enhancements
diff --git a/R/app_server.R b/R/app_server.R
index 98bc3e974..6a9c86bfd 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -11,9 +11,20 @@ app_server <- function(input, output, session) {
old <- options()
onStop(function() {
- options(old)
- })
- options(repos = get_db_config("package_repo"))
+ options(c(
+ # Unsets available packages filter if unset previously. Will be overriden
+ # otherwise.
+ list(available_packages_filters = NULL),
+ old
+ ))
+ })
+ options(
+ # Set session repo to value specified in configuration file
+ repos = get_db_config("package_repo"),
+ # Removes filters based on R version, OS type, sub-architecture. Only
+ # duplicates will be removed from the available package list
+ available_packages_filters = "duplicates"
+ )
# Collect user info.
user <- reactiveValues()
diff --git a/R/mod_code_explorer.R b/R/mod_code_explorer.R
index 7d0ebffda..2259f2158 100644
--- a/R/mod_code_explorer.R
+++ b/R/mod_code_explorer.R
@@ -31,7 +31,7 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal(
showHelperMessage(message = glue::glue("Source code not available for {{{selected_pkg$name()}}}"))
} else {
div(introJSUI(NS(id, "introJS")),
- br(),
+ br(),
fluidRow(
column(3,
wellPanel(
@@ -69,7 +69,28 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal(
div(id = ns("file_viewer"),
uiOutput(ns("file_output"), class = "file_browser"),
style = "height: 62vh; overflow: auto; border: 1px solid var(--bs-border-color-translucent);"
- )
+ ),
+ br(),
+ fluidRow(style = "height:35px !important;",
+ column(4,offset = 8,
+ conditionalPanel(
+ condition = "typeof(window.$highlights_list) != 'undefined' && window.$highlights_list.length > 1",
+ actionButton(ns("prev_button"),label = "",icon = icon("chevron-left"),
+ style ="width: 32px !important;
+ height: 32px !important;
+ font-size: 16px !important;
+ line-height: 5px !important;
+ padding: 0px !important;") |>bslib::tooltip("Previous occurence"), style = "display: inline-block;",
+
+ div(id = "search_index","",style ="display:inline"),
+ actionButton(ns("next_button"),label = "",icon = icon("chevron-right"),
+ style = "width: 32px !important;
+ height: 32px !important;
+ font-size: 16px !important;
+ line-height: 5px !important;
+ padding: 0px !important;
+ display:inline;
+ ")|>bslib::tooltip("Next occurence",placement ="right"), style = "display: inline-block;")))
)
),
br(), br(),
@@ -127,7 +148,7 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal(
close(con)
func_list <- c(input$exported_function, paste0("`", input$exported_function, "`"))
highlight_index <- parse_data() %>%
- filter(stringr::str_ends(file, input$test_files) & func %in% func_list) %>%
+ filter(basename(file) == input$test_files & func %in% func_list) %>%
pull(line)
renderCode(lines, highlight_index)
}) %>%
@@ -144,7 +165,7 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal(
close(con)
func_list <- c(input$exported_function, paste0("`", input$exported_function, "`"))
highlight_index <- parse_data() %>%
- filter(stringr::str_ends(file, input$source_files) & func %in% func_list) %>%
+ filter(basename(file) == input$source_files & func %in% func_list) %>%
pull(line)
renderCode(lines, highlight_index)
}) %>%
@@ -157,8 +178,12 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal(
con <- archive::archive_read(file.path("tarballs",
glue::glue("{selected_pkg$name()}_{selected_pkg$version()}.tar.gz")),
file = fp)
+
Rdfile <-tools::parse_Rd(con)
close(con)
+ shinyjs::runjs('
+ $highlights_list = undefined;')
+
HTML(paste0(utils::capture.output(tools::Rd2HTML(Rdfile,
package = c(selected_pkg$name(),
selected_pkg$version()), out = "")), collapse = "\n"))
@@ -166,7 +191,57 @@ mod_code_explorer_server <- function(id, selected_pkg, pkgarchive = reactiveVal(
bindEvent(input$man_files, input$exported_function, ignoreNULL = FALSE)
introJSServer("introJS", text = reactive(fe_steps), user, credentials)
+ search_index_value <- reactiveVal(1)
+ highlight_list <- reactiveVal(1)
+
+ observeEvent(input$next_button,{
+ if (input$next_button > 0){
+ shinyjs::runjs('
+ var $index =Array.from($highlights_list).findIndex(node => node.isEqualNode($curr_sel));
+ if( $index == $highlights_list.length -1)
+ {
+
+ $curr_sel = $highlights_list[0]
+ search_index.innerHTML = 1 + " of " + $highlights_list.length;
+
+ }
+ else
+ {
+ $curr_sel = $highlights_list[$index +1]
+ search_index.innerHTML = ( $index+2) + " of " + $highlights_list.length;
+ }
+
+ var $target = document.querySelector("#code_explorer-file_viewer")
+ $target.scrollTop = 0;
+ $target.scrollTop =$curr_sel.offsetTop -40; ')
+
+ }
+
+ })
+ observeEvent(input$prev_button,{
+ if (input$prev_button > 0){
+
+ shinyjs::runjs('var $index =Array.from($highlights_list).findIndex(node => node.isEqualNode($curr_sel));
+ if( $index ==0)
+ {
+ $curr_sel = $highlights_list[$highlights_list.length -1]
+ search_index.innerHTML = $highlights_list.length + " of " + $highlights_list.length;
+ }
+ else
+ {
+ $curr_sel = $highlights_list[$index -1]
+ search_index.innerHTML = ($index) + " of " + $highlights_list.length;
+ }
+ var $target = document.querySelector("#code_explorer-file_viewer")
+
+ $target.scrollTop = 0;
+ $target.scrollTop = $curr_sel.offsetTop - 40;
+
+ ')
+ }
+
+ })
output$file_output <- renderUI({
switch (input$file_type,
test = test_code(),
diff --git a/R/mod_code_explorer_utils.R b/R/mod_code_explorer_utils.R
index 9d73ceec6..d2e1a2ab9 100644
--- a/R/mod_code_explorer_utils.R
+++ b/R/mod_code_explorer_utils.R
@@ -172,9 +172,19 @@ renderCode <- function(lines, hlindex) {
})
),
tags$script(HTML("
+
document.querySelectorAll('.code pre').forEach(bl => {
hljs.highlightBlock(bl);
});
+ var $highlights_list = document.querySelectorAll('.highlight')
+ var $curr_sel = document.querySelector('.highlight')
+ if(typeof($highlights_list) != 'undefined' & $curr_sel != null){
+ var $target = document.querySelector('#code_explorer-file_viewer')
+ $target.scrollTop = 0;
+ $target.scrollTop = $curr_sel.offsetTop - 40;
+ var $index1 =Array.from($highlights_list).findIndex(node => node.isEqualNode($curr_sel)) +1;
+ search_index.innerHTML = $index1 + ' of ' + $highlights_list.length;
+ }
"))
)
}
diff --git a/R/mod_packageDependencies.R b/R/mod_packageDependencies.R
index 78f6ed05a..4145769ac 100644
--- a/R/mod_packageDependencies.R
+++ b/R/mod_packageDependencies.R
@@ -64,7 +64,7 @@ packageDependenciesServer <- function(id, selected_pkg, user, credentials, paren
req(pkgref())
tryCatch(
expr = {
- deep_ends <- pkgref()$dependencies[[1]] %>% dplyr::as_tibble() %>%
+ deep_ends <- {if(suppressWarnings(is.null(nrow(pkgref()$dependencies[[1]])) || nrow(pkgref()$dependencies[[1]]) == 0)) dplyr::tibble(package = character(0), type = character(0)) else pkgref()$dependencies[[1]] %>% dplyr::as_tibble()} %>%
mutate(package = stringr::str_replace(package, "\n", " ")) %>%
mutate(name = stringr::str_extract(package, "^((([[A-z]]|[.][._[A-z]])[._[A-z0-9]]*)|[.])"))
@@ -94,7 +94,8 @@ packageDependenciesServer <- function(id, selected_pkg, user, credentials, paren
)
tryCatch(
expr = {
- shrug_jests <- pkgref()$suggests[[1]] %>% dplyr::as_tibble()%>%
+ shrug_jests <-
+ {if(suppressWarnings(is.null(nrow(pkgref()$suggests[[1]])) || nrow(pkgref()$suggests[[1]]) == 0)) dplyr::tibble(package = character(0), type = character(0)) else pkgref()$suggests[[1]] %>% dplyr::as_tibble()} %>%
mutate(package = stringr::str_replace(package, "\n", " ")) %>%
mutate(name = stringr::str_extract(package, "^((([[A-z]]|[.][._[A-z]])[._[A-z0-9]]*)|[.])"))
@@ -122,8 +123,7 @@ packageDependenciesServer <- function(id, selected_pkg, user, credentials, paren
decision_id = character(0)))
}
)
- # this is so the dependencies is also a 0x2 tibble like suggests
- if (rlang::is_empty(pkgref()$dependencies[[1]])) depends(dplyr::tibble(package = character(0), type = character(0), name = character(0)))
+
revdeps(pkgref()$reverse_dependencies[[1]] %>% as.vector())
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_build_cards.R b/R/utils_build_cards.R
index 48ff9ae8e..f10d56f51 100644
--- a/R/utils_build_cards.R
+++ b/R/utils_build_cards.R
@@ -256,7 +256,6 @@ build_dep_cards <- function(data, loaded, toggled){
is_url = numeric(),
type = character()
)
-
deps <- data %>%
mutate(base = if_else(name %in% c(rownames(installed.packages(priority = "base"))), "Base", "Non-Base")) %>%
diff --git a/R/utils_get_db.R b/R/utils_get_db.R
index 04f957d7a..3836be4ee 100644
--- a/R/utils_get_db.R
+++ b/R/utils_get_db.R
@@ -239,6 +239,42 @@ get_metric_data <- function(pkg_name, metric_class = 'maintenance', db_name = go
)
}
+#' Get Dependency Pkg Versions and Scores
+#'
+#'
+#' @param pkg_name character name of the package
+#' @param verify_data a data.frame used to verify whether a pkg exists in the db
+#' @param cran_pkgs a data.frame containing all available cran package names/versions
+#'
+#' @returns a list
+#' @noRd
+get_versnScore <- function(pkg_name, verify_data, cran_pkgs) {
+
+ if (rlang::is_empty(pkg_name))
+ return(list(name = character(), version = character(), score = character(),
+ decision_id = character(), decision = character()))
+
+ if (pkg_name %in% verify_data$name) { #loaded2_db()$name
+ tmp_df <- verify_data %>% filter(name == pkg_name) %>% select(score, version, decision_id, decision)
+ pkg_score <- tmp_df %>% pull(score) %>% as.character
+ pkg_versn <- tmp_df %>% pull(version) %>% as.character
+ pkg_decision_id <- tmp_df %>% pull(decision_id) %>% as.character
+ pkg_decision <- tmp_df %>% pull(decision) %>% as.character
+ } else {
+ pkg_score <- ""
+ pkg_versn <- if_else(pkg_name %in% c(rownames(installed.packages(priority="base"))), "",
+ subset(cran_pkgs, Package == pkg_name, c("Version")) %>% as.character())
+ pkg_decision_id <- ""
+ pkg_decision <- ""
+ }
+
+ return(list(name = pkg_name, version = pkg_versn, score = pkg_score,
+ decision_id = pkg_decision_id, decision = pkg_decision
+ ))
+}
+
+
+
#' The 'Get Dependencies Metrics Data' function
#'
#' Pull the depenencies data for a specific package id, and create
@@ -277,7 +313,7 @@ get_depends_data <- function(pkg_name,
deps_decision_data <- purrr::map_df(deep_ends$name, ~get_versnScore(.x, loaded2_db, repo_pkgs))
if(nrow(deps_decision_data) == 0) {
deps_w_decision <- dplyr::tibble(name = character(0), version = character(0),
- score = character(0), decision = character(0), decision_id = character(0))
+ score = character(0), decision = character(0), decision_id = character(0))
} else {
deps_w_decision <- deps_decision_data
}
@@ -407,40 +443,6 @@ get_assess_blob <- function(pkg_lst, db_name = golem::get_golem_options('assessm
}
-#' Get Dependency Pkg Versions and Scores
-#'
-#'
-#' @param pkg_name character name of the package
-#' @param verify_data a data.frame used to verify whether a pkg exists in the db
-#' @param cran_pkgs a data.frame containing all available cran package names/versions
-#'
-#' @returns a list
-#' @noRd
-get_versnScore <- function(pkg_name, verify_data, cran_pkgs) {
-
- if (rlang::is_empty(pkg_name))
- return(list(name = character(), version = character(), score = character(),
- decision_id = character(), decision = character()))
-
- if (pkg_name %in% verify_data$name) { #loaded2_db()$name
- tmp_df <- verify_data %>% filter(name == pkg_name) %>% select(score, version, decision_id, decision)
- pkg_score <- tmp_df %>% pull(score) %>% as.character
- pkg_versn <- tmp_df %>% pull(version) %>% as.character
- pkg_decision_id <- tmp_df %>% pull(decision_id) %>% as.character
- pkg_decision <- tmp_df %>% pull(decision) %>% as.character
- } else {
- pkg_score <- ""
- pkg_versn <- if_else(pkg_name %in% c(rownames(installed.packages(priority="base"))), "",
- subset(cran_pkgs, Package == pkg_name, c("Version")) %>% as.character())
- pkg_decision_id <- ""
- pkg_decision <- ""
- }
-
- return(list(name = pkg_name, version = pkg_versn, score = pkg_score,
- decision_id = pkg_decision_id, decision = pkg_decision
- ))
-}
-
##### End of get_* functions #####
diff --git a/R/utils_insert_db.R b/R/utils_insert_db.R
index 3b25f4da7..8036b738b 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)
@@ -215,7 +215,7 @@ insert_riskmetric_to_db <- function(pkg_name, pkg_version = "",
metric_value <- case_when(
"pkg_metric_error" %in% class(riskmetric_assess[[metric$name]][[1]]) ~ "pkg_metric_error",
- metric$name == "dependencies" ~ as.character(length(unlist(as.vector(riskmetric_assess[[metric$name]][[1]][1])))),
+ metric$name == "dependencies" ~ as.character(NROW(riskmetric_assess[[metric$name]][[1]])),
metric$name == "reverse_dependencies" ~ as.character(length(as.vector(riskmetric_assess[[metric$name]][[1]]))),
metric$is_perc == 1L ~ as.character(round(riskmetric_score[[metric$name]]*100, 2)[[1]]),
TRUE ~ as.character(riskmetric_assess[[metric$name]][[1]][1:length(riskmetric_assess[[metric$name]])])
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..8f1bdfc96 100644
--- a/app.R
+++ b/app.R
@@ -2,6 +2,17 @@
# 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: pkg_reviewer; P: Reviewer@1
+
+ U: pkg_viewer; P: Viewer@1")
+ )
diff --git a/credentials_demo.sqlite b/credentials_demo.sqlite
new file mode 100644
index 000000000..f0d056f08
Binary files /dev/null and b/credentials_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..df23cde36 100644
--- a/inst/db-config.yml
+++ b/inst/db-config.yml
@@ -20,10 +20,9 @@ default:
decisions:
categories:
- Low Risk
+ - Undecided
- Medium Risk
- High Risk
- metric_weights:
- covr_coverage: 0
example:
assessment_db: database_ex.sqlite
credential_db: credentials_ex.sqlite
@@ -75,6 +74,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/manifest.json b/manifest.json
index 6ea2ffa49..55fa9764a 100644
--- a/manifest.json
+++ b/manifest.json
@@ -6175,7 +6175,7 @@
"checksum": "d74482ddef0a4941a51c077f5ea60e10"
},
".github/workflows/test-coverage.yaml": {
- "checksum": "c0baef024db9ec1299aae4098e904e9c"
+ "checksum": "a854cdb9e1cfbcbbf5ccffdf4755606b"
},
".github/workflows/write-manifest.yaml": {
"checksum": "cdfc1470af653982867daed2b99d5b97"
@@ -6463,13 +6463,13 @@
"checksum": "97d1232340e04c53088bc8f814133dcd"
},
"NEWS.md": {
- "checksum": "9fd91891f54e18c5f702df550768e91a"
+ "checksum": "8f1dc97771e1911ac13a12a45300a516"
},
"R/app_config.R": {
"checksum": "c2b61f270b86b6833f0ee39c44a1a440"
},
"R/app_server.R": {
- "checksum": "e2a53d90bd4289198e29bec4ff19eba7"
+ "checksum": "8408e324004d2991c855c03040cb2dca"
},
"R/app_ui.R": {
"checksum": "50d68f46171151cd36457a7154e5a7a3"
@@ -6490,10 +6490,10 @@
"checksum": "61459e71d1e62587597ac1dac2c7c650"
},
"R/mod_code_explorer_utils.R": {
- "checksum": "fe3bd5c1243d0ba649d070a6ecf29560"
+ "checksum": "2588e180a69a79b7be4e3818eb3931dc"
},
"R/mod_code_explorer.R": {
- "checksum": "72a36a8c4d7f15e0da013104177328b1"
+ "checksum": "1ec3f3aac096efff1e0c360b347e2d32"
},
"R/mod_communityMetrics.R": {
"checksum": "fdd39bd2a7e19b8dccc195aaec57a3d8"
@@ -6532,7 +6532,7 @@
"checksum": "a894eb9114e258feb99b76cdca557cd2"
},
"R/mod_packageDependencies.R": {
- "checksum": "6fffb51829775826e242824f268062b6"
+ "checksum": "f8cee3c4845b4d3c3c2f66796af28359"
},
"R/mod_pkg_explorer_utils.R": {
"checksum": "b7792e08cc4a67296c9df0f452c0a72a"
@@ -6565,13 +6565,13 @@
"checksum": "e5835b81f48d93ee0175507abbb3186f"
},
"R/utils_build_cards.R": {
- "checksum": "f79316fe637bb1f4038f085621d298f5"
+ "checksum": "a7cfdc1f9a4ad1c2835cd22eb279d8dc"
},
"R/utils_config_db.R": {
"checksum": "74cf2ee5e7283483a88f08d60e3728b0"
},
"R/utils_get_db.R": {
- "checksum": "6e87d4d43f93b4a4b556d72b848dc3f1"
+ "checksum": "6c0e6fb4b3716cdd0c0d2953a1cf4393"
},
"R/utils_insert_db.R": {
"checksum": "240f4647cb71a94cb19db8088c85a609"
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/tests/testthat/test-apps/explorer-app/tarballs/dplyr_1.1.2.tar.gz b/tests/testthat/test-apps/explorer-app/tarballs/dplyr_1.1.2.tar.gz
new file mode 100644
index 000000000..567e3e265
Binary files /dev/null and b/tests/testthat/test-apps/explorer-app/tarballs/dplyr_1.1.2.tar.gz differ
diff --git a/tests/testthat/test-apps/tarballs/tidyr_1.3.0.tar.gz b/tests/testthat/test-apps/tarballs/tidyr_1.3.0.tar.gz
new file mode 100644
index 000000000..f64e890ba
Binary files /dev/null and b/tests/testthat/test-apps/tarballs/tidyr_1.3.0.tar.gz differ
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
+