build-cran-binaries/local/failing-builds-report.R

#!/usr/bin/env Rscript

# Read-only failure triage over the `single_builds` metadata table (issue #115,
# steps 1 + 2): query every recorded build failure, group by a normalised error
# fingerprint, classify each bucket against the known signature set, and print a
# triaged report with a pre-filled `registry.json` suggestion where a *known,
# safe* fix lever applies. Novel source diffs and unknown signatures are routed
# to human triage; this script never writes to the DB or the registry.
#
# Usage:
#   PGPASS=... Rscript local/failing-builds-report.R [--platform P] [--arch A]
#                                                     [--json out.json] [--min N]
#
#   --platform / --arch   restrict to one platform/arch (default: all)
#   --min N               only show fingerprint groups with >= N failing builds
#   --json PATH           also write the machine-readable report to PATH
#
# Env fallbacks: PLATFORM, ARCH (same effect as the flags).

options(error = function() {
  cat("ERROR:", geterrmessage(), "\n", file = stdout())
  q(status = 1)
})

suppressPackageStartupMessages({
  library(DBI, quietly = TRUE)
  library(RPostgres, quietly = TRUE)
  library(jsonlite, quietly = TRUE)
})

# Locate helpers relative to this script so it runs from any CWD.
script_path <- local({
  a <- commandArgs(trailingOnly = FALSE)
  f <- sub("^--file=", "", a[grepl("^--file=", a)])
  if (length(f) == 1L && nzchar(f)) normalizePath(f) else NA_character_
})
script_dir <- if (is.na(script_path)) "local" else dirname(script_path)
source(file.path(script_dir, "failing-builds-classify.R"))

# ---------------------------------------------------------------------------
# Arguments
# ---------------------------------------------------------------------------
args <- commandArgs(trailingOnly = TRUE)
opt_val <- function(flag, default = NA_character_) {
  i <- match(flag, args)
  if (!is.na(i) && i < length(args)) args[[i + 1L]] else default
}
platform <- opt_val("--platform", Sys.getenv("PLATFORM", ""))
arch <- opt_val("--arch", Sys.getenv("ARCH", ""))
json_out <- opt_val("--json")
min_count <- suppressWarnings(as.integer(opt_val("--min", "1")))
if (is.na(min_count)) {
  min_count <- 1L
}

if (nchar(Sys.getenv("PGPASS")) == 0L) {
  stop(
    "PGPASS env var is not set; a DB password is required (no read-only role exists)."
  )
}

# ---------------------------------------------------------------------------
# Query failing builds
# ---------------------------------------------------------------------------
con <- DBI::dbConnect(
  RPostgres::Postgres(),
  dbname = "build_metadata",
  host = "r-binaries.devxy.io",
  port = 15432,
  user = "rpkgs",
  password = Sys.getenv("PGPASS"),
  sslmode = "require"
)
on.exit(DBI::dbDisconnect(con), add = TRUE)

where <- "error_occurred = TRUE AND removed = FALSE"
params <- list()
if (nzchar(platform)) {
  where <- paste0(where, " AND platform = $", length(params) + 1L)
  params <- c(params, platform)
}
if (nzchar(arch)) {
  where <- paste0(where, " AND arch = $", length(params) + 1L)
  params <- c(params, arch)
}
failures <- DBI::dbGetQuery(
  con,
  paste0(
    "SELECT name, tag, platform, arch, r_version, timestamp, error_text ",
    "FROM single_builds WHERE ",
    where
  ),
  params = if (length(params) > 0L) params else NULL
)

cat(sprintf(
  "Queried single_builds: %d failing builds%s\n",
  nrow(failures),
  if (nzchar(platform) || nzchar(arch)) {
    sprintf(
      " (filter: platform=%s arch=%s)",
      if (nzchar(platform)) platform else "*",
      if (nzchar(arch)) arch else "*"
    )
  } else {
    ""
  }
))
if (nrow(failures) == 0L) {
  cat("No failing builds to triage.\n")
  q(status = 0)
}

# ---------------------------------------------------------------------------
# Packages that already carry a registry entry (so we don't re-propose)
# ---------------------------------------------------------------------------
`%||%` <- function(a, b) if (is.null(a)) b else a
registry_file <- file.path(script_dir, "patches", "registry.json")
registered_pkgs <- character(0L)
if (file.exists(registry_file)) {
  reg <- jsonlite::fromJSON(registry_file, simplifyVector = FALSE)
  registered_pkgs <- unique(vapply(
    reg,
    function(e) as.character(e$package %||% ""),
    character(1L)
  ))
}

# ---------------------------------------------------------------------------
# Fingerprint + classify every failure, then group
# ---------------------------------------------------------------------------
signatures <- build_signatures()
failures$fingerprint <- vapply(
  seq_len(nrow(failures)),
  function(i) fingerprint_error(failures$error_text[[i]], failures$name[[i]]),
  character(1L)
)
failures$sig_id <- vapply(
  seq_len(nrow(failures)),
  function(i) classify_error(failures$error_text[[i]], signatures)$id,
  character(1L)
)

# Group by root cause: classified failures collapse by signature id (so the
# same fix candidate is one bucket regardless of surrounding log noise);
# unclassified failures fall back to the fingerprint so distinct unknowns stay
# separate for discovery.
failures$group_key <- ifelse(
  failures$sig_id == "unclassified",
  failures$fingerprint,
  failures$sig_id
)
groups <- split(failures, failures$group_key)
# Order groups by number of affected builds, descending.
groups <- groups[order(-vapply(groups, nrow, integer(1L)))]

report <- list()
cat(sprintf(
  "\n%d distinct failure fingerprint(s); showing groups with >= %d build(s).\n",
  length(groups),
  min_count
))
cat(strrep("=", 78L), "\n", sep = "")

for (g in groups) {
  n <- nrow(g)
  if (n < min_count) {
    next
  }

  # Representative classification: most common signature id in the group.
  sig_id <- names(sort(table(g$sig_id), decreasing = TRUE))[[1L]]
  sig <- Filter(function(s) s$id == sig_id, signatures)
  if (length(sig) > 0L) {
    sig <- sig[[1L]]
    sig$matched <- TRUE
  } else {
    sig <- classify_error("", signatures) # unclassified fallback (matched = FALSE)
  }

  fp_tab <- sort(table(g$fingerprint), decreasing = TRUE)
  rep_fp <- names(fp_tab)[[1L]]
  fp_variants <- length(fp_tab)
  pkgs <- sort(unique(g$name))
  plats <- sort(unique(g$platform))
  arches <- sort(unique(g$arch))
  unregistered <- setdiff(pkgs, registered_pkgs)

  status <- if (!sig$matched) {
    "HUMAN TRIAGE (unknown signature)"
  } else if (!sig$auto) {
    sprintf("HUMAN TRIAGE (classified: %s; novel source diff)", sig$id)
  } else {
    sprintf("AUTO-PROPOSABLE (%s, %s confidence)", sig$id, sig$confidence)
  }

  cat(sprintf(
    "\n[%d builds | %d pkgs | %s] %s\n",
    n,
    length(pkgs),
    toString(plats),
    status
  ))
  cat(sprintf(
    "  fingerprint: %s%s\n",
    rep_fp,
    if (fp_variants > 1L) {
      sprintf(" (+%d fingerprint variant(s))", fp_variants - 1L)
    } else {
      ""
    }
  ))
  if (sig$matched) {
    cat(sprintf("  signature  : %s\n", sig$label))
    cat(sprintf("  suggested  : [%s] %s\n", sig$tier, sig$fix))
  }
  cat(sprintf("  arch       : %s\n", toString(arches)))
  cat(sprintf(
    "  packages   : %s\n",
    paste(
      vapply(
        pkgs,
        function(p) {
          if (p %in% registered_pkgs) paste0(p, " (has entry)") else p
        },
        character(1L)
      ),
      collapse = ", "
    )
  ))

  proposals <- list()
  if (sig$matched && sig$auto && length(unregistered) > 0L) {
    cat("  proposed registry entries (validate + trial-build before merge):\n")
    for (p in unregistered) {
      p_plats <- sort(unique(g$platform[g$name == p]))
      entry <- propose_registry_entry(sig, p, p_plats)
      proposals[[p]] <- entry
      cat(paste0("    ", gsub("\n", "\n    ", entry)), "\n", sep = "")
    }
  } else if (sig$matched && sig$auto && length(unregistered) == 0L) {
    cat("  (all affected packages already have a registry entry)\n")
  }

  report[[length(report) + 1L]] <- list(
    fingerprint = rep_fp,
    fingerprint_variants = fp_variants,
    build_count = n,
    packages = pkgs,
    packages_without_entry = unregistered,
    platforms = plats,
    arches = arches,
    signature = sig$id,
    matched = sig$matched,
    auto_proposable = isTRUE(sig$auto) && sig$matched,
    tier = sig$tier,
    confidence = sig$confidence,
    suggested_fix = sig$fix,
    proposed_entries = if (length(proposals) > 0L) {
      lapply(proposals, jsonlite::fromJSON)
    } else {
      NULL
    }
  )
}

# ---------------------------------------------------------------------------
# Summary
# ---------------------------------------------------------------------------
matched <- Filter(function(r) r$matched, report)
auto <- Filter(function(r) r$auto_proposable, report)
cat("\n", strrep("=", 78L), "\n", sep = "")
cat(sprintf(
  "Summary: %d groups | %d classified | %d auto-proposable | %d for human triage\n",
  length(report),
  length(matched),
  length(auto),
  length(report) - length(matched)
))

if (!is.na(json_out)) {
  jsonlite::write_json(
    report,
    json_out,
    auto_unbox = TRUE,
    pretty = TRUE,
    null = "null"
  )
  cat(sprintf("Wrote machine-readable report to %s\n", json_out))
}