From c6d6233964196b5dcd2f9560c5acf569801ab68e Mon Sep 17 00:00:00 2001
From: Kyle Meyer <kylem@metrumrg.com>
Date: Sun, 4 Aug 2024 16:37:10 -0400
Subject: [PATCH] external: add some basic validation of inputs

---
 R/aaa.R      |  1 +
 R/external.R | 44 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 45 insertions(+)

diff --git a/R/aaa.R b/R/aaa.R
index 3d12264..b9c1dcf 100644
--- a/R/aaa.R
+++ b/R/aaa.R
@@ -12,6 +12,7 @@ RISK_LEVELS <-  c("NA - unexpected", "High Risk", "Medium Risk", "Low Risk")
 
 utils::globalVariables(c("."))
 
+METRIC_CATEGORIES <- c("testing", "documentation", "maintenance", "transparency")
 
 DOCUMENTATION_METRICS <- c("has_vignettes", "has_website", "has_news") #, export_help)
 MAINTENANCE_METRICS <- c("has_maintainer", "news_current")#, "last_30_bugs_status")
diff --git a/R/external.R b/R/external.R
index 4cb1efb..1760c5c 100644
--- a/R/external.R
+++ b/R/external.R
@@ -202,6 +202,26 @@ build_pkg_scores <- function(results_dir) {
     metadata = list(jsonlite::read_json(meta_json))
   )
 
+  to_drop <- c(
+    "mpn_scorecard_version", "out_dir", "pkg_tar_path", "md5sum_check",
+    "category_scores"
+  )
+  extkeys <- SCORECARD_JSON_KEYS[!SCORECARD_JSON_KEYS %in% to_drop]
+  assert_json_keys(res, extkeys)
+  assert_json_keys(res[["metadata"]], c("date", "executor"))
+
+  scores <- res[["scores"]]
+  # In general, these score names aren't are hard-coded set, but there should at
+  # least be one per category...
+  assert_json_keys(scores, METRIC_CATEGORIES)
+  nscores_per_cat <- purrr::map_int(scores[METRIC_CATEGORIES], length)
+  if (any(nscores_per_cat < 1)) {
+    no_scores <- names(scores[METRIC_CATEGORIES])[nscores_per_cat < 1]
+    abort(c("The following categories do not have any scores:", no_scores))
+  }
+  # ... and check and coverage scores should be present.
+  assert_json_keys(scores[["testing"]], c("check", "coverage"))
+
   return(calc_overall_scores(res))
 }
 
@@ -211,6 +231,10 @@ read_traceability_matrix <- function(results_dir) {
 
   entries <- yaml::read_yaml(fname)
   entries <- purrr::discard(entries, function(e) isTRUE(e[["skip"]]))
+  for (e in entries) {
+    assert_keys(e, c("entrypoint", "code", "doc", "tests"), yaml::as.yaml)
+  }
+
   tibble::tibble(
     entrypoint = purrr::map_chr(entries, "entrypoint"),
     code_file = purrr::map_chr(entries, "code"),
@@ -233,8 +257,28 @@ read_coverage_results <- function(results_dir) {
 
   data <- jsonlite::read_json(fname)
   filecov <- data[["files"]]
+  for (e in filecov) {
+    assert_json_keys(e, c("file", "coverage"))
+  }
+
   tibble::tibble(
     code_file = purrr::map_chr(filecov, "file"),
     test_coverage = purrr::map_dbl(filecov, "coverage")
   )
 }
+
+assert_json_keys <- function(entry, keys) {
+  assert_keys(
+    entry,
+    keys,
+    function(...) jsonlite::toJSON(..., auto_unbox = TRUE, pretty = TRUE)
+  )
+}
+
+assert_keys <- function(entry, keys, render_fn) {
+  for (k in keys) {
+    if (is.null(entry[[k]])) {
+      abort(paste0("entry is missing key: ", k, "\n", render_fn(entry)))
+    }
+  }
+}