Merge pull request #609 from Sage-Bionetworks/develop

Release 24.8.1

.Rbuildignore

@@ -2,4 +2,5 @@
 ^renv$
 ^renv\.lock$
 ^.venv
-^schematic$
+^schematic$
+^\.github$

.github/.gitignore

@@ -0,0 +1 @@
+*.html

.github/workflows/test-coverage.yaml

@@ -0,0 +1,62 @@
+# 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:
+    branches: [main, develop]
+  pull_request:
+    branches: [main, develop]
+
+name: test-coverage
+
+permissions: read-all
+
+jobs:
+  test-coverage:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      SYNAPSE_PAT: ${{ secrets.SYNAPSE_PAT }}
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::covr, any::xml2, any::testthat
+          needs: coverage
+
+      - name: Test coverage
+        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

DESCRIPTION

@@ -7,6 +7,6 @@ License: file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.1
-Imports: httr, dplyr, jsonlite, shinyjs, yaml, promises, readr
+Imports: httr, dplyr, jsonlite, shinyjs, yaml, promises, readr, httr2
 Suggests: 
     covr

NAMESPACE

@@ -12,6 +12,7 @@ export(manifest_populate)
 export(manifest_validate)
 export(model_component_requirements)
 export(model_submit)
+export(parse_env_var)
 export(storage_dataset_files)
 export(storage_project_datasets)
 export(storage_projects)

R/datacurator_package.R

@@ -0,0 +1 @@
+#' @importFrom httr GET POST content

R/read_dca_config.R

@@ -0,0 +1,148 @@
+#' @title Read the DCA config file and report issues
+#' @param config URL or filepath to a DCA JSON config file
+read_dca_config <- function(config) {
+  conf <- jsonlite::fromJSON(config)
+
+  name_check <- function(req, prov) {
+    if (!all(req %in% prov)) {
+      which_miss <- req[which(!req %in% prov)]
+      stop(sprintf("DCA config missing %s", which_miss))
+    }
+  }
+
+  lvl_1_props_req <- list(
+    "dcc" = list(),
+    "dca" = list(),
+    "schematic" = list()
+  )
+  lvl_1_props_ops <- list() # Placeholder for optional properties
+  lvl_1_props_conf <- names(conf)
+  name_check(names(lvl_1_props_req), lvl_1_props_conf)
+
+  dca_props_req <- list() # Placeholder for required DCA properties
+  dca_props_ops <- list(
+    "use_compliance_dashboard" = FALSE,
+    "primary_col" = "#2a668d",
+    "secondary_col" = "#184e71",
+    "sidebar_col" = "#191919"
+  )
+  dca_props_conf <- names(conf$dca)
+  name_check(names(dca_props_req), dca_props_conf)
+
+  if (!"use_compliance_dashboard" %in% dca_props_conf) {
+    conf$dca$use_compliance_dashboard <- FALSE
+  }
+  if (!"primary_col" %in% dca_props_conf) {
+    conf$dca$primary_col <- "#2a668d"
+  }
+  if (!"secondary_col" %in% dca_props_conf) {
+    conf$dca$secondary_col <- "#184e71"
+  }
+  if (!"primary_col" %in% dca_props_conf) {
+    conf$dca$sidebar_col <- "#191919"
+  }
+
+  dcc_props_req <- list(
+    "name" = list(),
+    "synapse_asset_view" = list(),
+    "data_model_url" = list(),
+    "template_menu_config_file" = list()
+  )
+  dcc_props_ops <- list(
+    "data_model_info" = NA_character_,
+    "logo_location" = "https://raw.githubusercontent.com/Sage-Bionetworks/data_curator_config/prod/demo/sage_logo_mark_only.png",
+    "logo_link" = "https://synapse.org",
+    "dcc_help_link" = NA_character_,
+    "portal_help_link" = NA_character_
+  )
+  dcc_props_conf <- names(conf$dcc)
+  name_check(names(dcc_props_req), dcc_props_conf)
+
+  if (!"logo_location" %in% dcc_props_conf) {
+    conf$dcc$logo_location <- dcc_props_ops$logo_location
+  }
+  if (!"logo_link" %in% dcc_props_conf) {
+    conf$dcc$logo_link <- dcc_props_ops$logo_link
+  }
+
+  # required elements should not have a default. Should error if not provided.
+  # WIP, confirm required and move others to ops with defaults
+  schematic_props_req <- list(
+    "manifest_generate" = list(),
+    "model_validate" = list(),
+    "model_submit" = list()
+  )
+  schematic_props_ops <- list(
+    "global" = list()
+  )
+  schematic_props_conf <- names(conf$schematic)
+  name_check(names(schematic_props_req), schematic_props_conf)
+
+  if (!"global" %in% schematic_props_conf) {
+    conf$schematic$global <- list()
+  }
+
+  global_ops <- list(
+    "data_model_labels" = "class_label"
+  )
+  global_conf <- names(conf$schematic$global)
+  if (!"data_model_labels" %in% global_conf) {
+    conf$schematic$global$data_model_labels <- "class_label"
+  }
+
+  # required elements should not have a default. Should error if not provided.
+  # WIP, confirm required and move others to ops with defaults
+  mg_props_req <- list(
+    "output_format" = "excel",
+    "use_annotations" = TRUE
+  )
+  mg_props_ops <- list()
+  mg_props_conf <- names(conf$schematic$manifest_generate)
+  name_check(names(mg_props_req), mg_props_conf)
+
+  # required elements should not have a default. Should error if not provided.
+  # WIP, confirm required and move others to ops with defaults
+  mv_props_req <- list(
+    "restrict_rules" = FALSE
+  )
+  mv_props_ops <- list(
+    "cross_manifest_validation" = FALSE
+  )
+  mv_props_conf <- names(conf$schematic$model_validate)
+  name_check(names(mv_props_req), mv_props_conf)
+
+  if (!"cross_manifest_validation" %in% mv_props_conf) {
+    conf$schematic$model_validate$cross_manifest_validation <- FALSE
+  }
+
+  # required elements should not have a default. Should error if not provided.
+  # WIP, confirm required and move others to ops with defaults
+  ms_props_req <- list(
+    "table_manipulation" = "replace",
+    "manifest_record_type" = "file_only"
+  )
+  ms_props_ops <- list(
+    "table_column_names" = "class_label",
+    "annotation_keys" = "class_label",
+    "file_annotations_upload" = TRUE,
+    "hide_blanks" = FALSE
+  )
+  ms_props_conf <- names(conf$schematic$model_submit)
+  name_check(names(ms_props_req), ms_props_conf)
+
+  if (!"table_column_names" %in% ms_props_conf) {
+    conf$schematic$model_submit$table_column_names <- "class_label"
+  }
+  if (!"annotation_keys" %in% ms_props_conf) {
+    conf$schematic$model_submit$annotation_keys <- "class_label"
+  }
+  if (!"file_annotations_upload" %in% ms_props_conf) {
+    conf$schematic$model_submit$file_annotations_upload <- TRUE
+  }
+  if (!"hide_blanks" %in% ms_props_conf) {
+    conf$schematic$model_submit$hide_blanks <- FALSE
+  }
+
+  conf
+
+}

R/schematic_rest_api.R

@@ -6,6 +6,11 @@ check_success <- function(x){
   if (tolower(status$category) == "success") {
     return()
   } else {
+    # Return content text for Data Type errors
+    if (grepl("LookupError: The DataType", httr::content(x, "text"))) {
+      stop(httr::content(x, "text"))
+    }
+
     stop(sprintf("Response from server: %s", status$reason))
   }
 }
@@ -409,7 +414,7 @@ get_asset_view_table <- function(url="http://localhost:3001/v1/storage/assets/ta
 
   check_success(req)
   if (return_type=="json") {
-    return(list2DF(fromJSON(httr::content(req))))
+    return(list2DF(jsonlite::fromJSON(httr::content(req))))
   } else {
   csv <- readr::read_csv(httr::content(req), show_col_types = FALSE)
   return(csv)

R/synapse_rest_api.R

@@ -38,7 +38,10 @@ synapse_is_certified <- function(url="https://repo-prod.prod.sagebase.org/repo/v
   ownerid <- user_profile[["ownerId"]]
   url_req <- file.path(url, ownerid, endpoint)
   req <- httr::GET(url_req)
-  httr::content(req)[["passed"]]
+  resp <- httr::content(req)
+  if ("certified" %in% names(resp)) {
+    return(resp[["certified"]])
+  } else return(FALSE)
 
 }
 

R/utils.R

@@ -0,0 +1,14 @@
+#' @title parse environment variables for configuration
+#' @param x string
+#' @param el_delim delimeter of list elements
+#' @param kv_delim delimeter of key-value pairs
+#' @export
+parse_env_var <- function(x, el_delim=",", kv_delim=":"){
+  if (!grepl(kv_delim, x)) stop(sprintf("%s delimiter not in %s", kv_delim, x))
+  # assume string of key-value pairs
+  elements <- stringr::str_split(x, el_delim, simplify = TRUE)
+  unlist(lapply(elements, function(y){
+    kv <- stringr::str_split(y, kv_delim, n=2)
+    setNames(kv[[1]][[2]], kv[[1]][[1]])
+  }))
+}