build-cran-binaries/local/proposal-tracking.R

#!/usr/bin/env Rscript

# Feedback loop for the failure classifier (issue #115, step 4): report the
# signature hit rate, proposed-vs-merged status, registry entries that look
# retirable, and -- so the classifier's blind spots get the same visibility as
# its proposals -- the failures it could NOT classify (candidates for new
# signatures) plus the groups blocked on a dependency build.
# Read-only on the DB/registry; the only optional write is the Forgejo issue.
#
# Usage:
#   PGPASS=... Rscript local/proposal-tracking.R [--json PATH] [--open-issue]
#       --open-issue   post/update a Forgejo issue listing the unclassified and
#                      dependency-blocked failures (needs FORGEJO_TOKEN)

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)
})

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"))
source(file.path(script_dir, "proposal-tracking-lib.R"))

args <- commandArgs(trailingOnly = TRUE)
json_out <- local({
  i <- match("--json", args)
  if (!is.na(i) && i < length(args)) args[[i + 1L]] else NA_character_
})
do_issue <- "--open-issue" %in% args

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

registry_file <- file.path(script_dir, "patches", "registry.json")
ledger_file <- file.path(script_dir, "patches", "proposals-log.json")

con <- DBI::dbConnect(
  RPostgres::Postgres(),
  dbname = "build_metadata",
  host = "r-binaries.devxy.io",
  port = 15432,
  user = "rpkgs",
  password = Sys.getenv("PGPASS"),
  sslmode = "verify-full",
  sslrootcert = bincraft::postgres_sslrootcert("verify-full")
)
on.exit(DBI::dbDisconnect(con), add = TRUE)

failures <- DBI::dbGetQuery(
  con,
  paste0(
    "SELECT name, tag, platform, arch, r_version, timestamp, error_text ",
    "FROM single_builds WHERE error_occurred = TRUE AND removed = FALSE"
  )
)

existing_entries <- if (file.exists(registry_file)) {
  jsonlite::fromJSON(registry_file, simplifyVector = FALSE)
} else {
  list()
}
registered_pkgs <- unique(vapply(
  existing_entries,
  function(e) as.character(e$package %||% ""),
  character(1L)
))
ledger <- if (file.exists(ledger_file)) {
  jsonlite::fromJSON(ledger_file, simplifyVector = FALSE)
} else {
  list()
}

report <- build_triage_report(failures, registered_pkgs)
failing_pkgs <- unique(unlist(lapply(report, function(g) g$packages)))

hit <- signature_hit_rate(report, registered_pkgs)
pvm <- proposed_vs_merged(ledger, registered_pkgs)
retire <- retirement_candidates(existing_entries, failing_pkgs)

cat(sprintf(
  "Feedback loop over %d failing builds, %d registry entries, %d ledger records.\n",
  nrow(failures),
  length(existing_entries),
  length(ledger)
))

cat("\nSignature hit rate:\n")
cat(strrep("-", 60L), "\n", sep = "")
for (h in hit) {
  cat(sprintf(
    "  %-26s %3d builds | %2d pkgs | %2d addressed | %2d open%s\n",
    h$signature,
    h$builds,
    h$packages,
    h$addressed,
    h$open,
    if (isTRUE(h$auto_proposable)) " [auto]" else ""
  ))
}

cat(sprintf("\nProposed vs merged: %d / %d merged.\n", pvm$merged, pvm$total))
for (r in pvm$records) {
  cat(sprintf("  %-24s %-26s %s\n", r$package, r$signature, r$status))
}

cat(sprintf(
  "\nRetirement candidates (%d): registry entries with no current failure.\n",
  length(retire)
))
if (length(retire) > 0L) {
  cat(paste0("  - ", retire, "\n"), sep = "")
} else {
  cat("  (none)\n")
}

# ---------------------------------------------------------------------------
# Blind spots: failures the classifier could not auto-propose.
# ---------------------------------------------------------------------------
blocked <- blocked_by_dependency(report)
unmatched <- unclassified_summary(report)

cat("\nBlocked on a dependency (fix the dependency, not each dependent):\n")
if (length(blocked) > 0L) {
  for (b in blocked) {
    cat(sprintf("  %-20s %5d dependent(s)\n", b$dependency, b$n_packages))
  }
} else {
  cat("  (none)\n")
}

cat(sprintf(
  "\nUnclassified failures (candidates for new signatures): %d group(s), %d builds.\n",
  unmatched$total_groups,
  unmatched$total_builds
))
cat(strrep("-", 60L), "\n", sep = "")
for (g in unmatched$groups) {
  cat(sprintf(
    "  [%d builds | %d pkgs] %s\n     e.g. %s%s\n",
    g$build_count,
    g$n_packages,
    g$fingerprint,
    toString(g$packages),
    if (isTRUE(g$packages_truncated)) ", ..." else ""
  ))
}
if (unmatched$dropped_groups > 0L) {
  cat(sprintf(
    "  (+%d more unclassified group(s) not shown)\n",
    unmatched$dropped_groups
  ))
}

if (!is.na(json_out)) {
  jsonlite::write_json(
    list(
      signature_hit_rate = hit,
      proposed_vs_merged = pvm,
      retirement_candidates = retire,
      blocked = blocked,
      unclassified = unmatched
    ),
    json_out,
    auto_unbox = TRUE,
    pretty = TRUE,
    null = "null"
  )
  cat(sprintf("\nWrote metrics to %s\n", json_out))
}

# ---------------------------------------------------------------------------
# Optionally publish the blind-spots to a Forgejo tracking issue.
# ---------------------------------------------------------------------------
if (do_issue) {
  forgejo_token <- Sys.getenv("FORGEJO_TOKEN")
  if (nchar(forgejo_token) == 0L) {
    stop("--open-issue requires FORGEJO_TOKEN.")
  }
  suppressPackageStartupMessages(library(httr2, quietly = TRUE))
  forgejo_base <- "https://git.devxy.io/api/v1"
  repo <- "devxy/build-cran-binaries"
  issue_title <- "Unclassified build failures (needs signatures) (#115)"
  now <- format(Sys.time(), "%Y-%m-%d %H:%M:%S")

  body_lines <- c(
    sprintf("_Generated %s from `single_builds` failures._", now),
    "",
    "Failures the classifier could **not** auto-propose a fix for.",
    "Each unclassified group is a candidate for a new signature in `local/failing-builds-classify.R`; the blocked groups clear once the named dependency builds.",
    ""
  )

  body_lines <- c(body_lines, "## Blocked on a dependency", "")
  if (length(blocked) > 0L) {
    for (b in blocked) {
      body_lines <- c(
        body_lines,
        sprintf(
          "- **%s**: %d dependent(s) (e.g. %s%s)",
          b$dependency,
          b$n_packages,
          toString(b$packages),
          if (isTRUE(b$packages_truncated)) ", ..." else ""
        )
      )
    }
  } else {
    body_lines <- c(body_lines, "_None._")
  }

  body_lines <- c(
    body_lines,
    "",
    sprintf(
      "## Unclassified failures (%d groups, %d builds)",
      unmatched$total_groups,
      unmatched$total_builds
    ),
    ""
  )
  if (length(unmatched$groups) > 0L) {
    for (g in unmatched$groups) {
      body_lines <- c(
        body_lines,
        sprintf(
          "### %d builds / %d pkg(s)",
          g$build_count,
          g$n_packages
        ),
        "",
        sprintf("Fingerprint: `%s`", g$fingerprint),
        sprintf(
          "Packages: %s%s",
          toString(g$packages),
          if (isTRUE(g$packages_truncated)) ", ..." else ""
        ),
        sprintf("Platforms: %s", toString(g$platforms)),
        ""
      )
    }
    if (unmatched$dropped_groups > 0L) {
      body_lines <- c(
        body_lines,
        sprintf("_(+%d more group(s) not shown.)_", unmatched$dropped_groups)
      )
    }
  } else {
    body_lines <- c(body_lines, "_None -- every failure is classified._")
  }
  new_body <- paste(body_lines, collapse = "\n")

  search_url <- sprintf(
    "%s/repos/%s/issues?type=issues&state=open&q=%s&limit=50",
    forgejo_base,
    repo,
    utils::URLencode(issue_title, reserved = TRUE)
  )
  existing <- httr2::request(search_url) |>
    httr2::req_headers(Authorization = paste("token", forgejo_token)) |>
    httr2::req_perform() |>
    httr2::resp_body_json(simplifyVector = FALSE)
  match_idx <- which(vapply(
    existing,
    function(x) identical(x$title, issue_title),
    logical(1L)
  ))
  if (length(match_idx) > 0L) {
    num <- existing[[match_idx[1]]]$number
    httr2::request(sprintf("%s/repos/%s/issues/%d", forgejo_base, repo, num)) |>
      httr2::req_headers(
        Authorization = paste("token", forgejo_token),
        `Content-Type` = "application/json"
      ) |>
      httr2::req_body_json(list(body = new_body)) |>
      httr2::req_method("PATCH") |>
      httr2::req_perform()
    cat(sprintf("\nUpdated tracking issue #%d.\n", num))
  } else {
    created <- httr2::request(sprintf(
      "%s/repos/%s/issues",
      forgejo_base,
      repo
    )) |>
      httr2::req_headers(
        Authorization = paste("token", forgejo_token),
        `Content-Type` = "application/json"
      ) |>
      httr2::req_body_json(list(title = issue_title, body = new_body)) |>
      httr2::req_perform() |>
      httr2::resp_body_json()
    cat(sprintf("\nOpened tracking issue #%d.\n", created$number))
  }
}