tests/testthat/helper-network.R

In writeAlizer: Generate Predicted Writing Quality Scores

# Helper to extract all artifact URLs for one or more model keys
# Uses the internal registry accessor to mirror production behavior.
.wa_urls_for_models <- function(keys) {
  parts_for <- getFromNamespace(".wa_parts_for", "writeAlizer")
  keys <- unique(as.character(keys))

  # Query both RDA and RDS parts to cover fits + varlists
  all <- lapply(keys, function(k) {
    rds <- tryCatch(parts_for("rds", k), error = function(e) NULL)
    rda <- tryCatch(parts_for("rda", k), error = function(e) NULL)
    do.call(rbind, Filter(Negate(is.null), list(rds, rda)))
  })
  urls <- unique(as.character(do.call(rbind, all)$url))
  urls[is.finite(match(urls, urls))]  # drop NAs / keep unique
}

# Skip the calling test if *any* of the given URLs/paths are unavailable.
# - file:// URLs: require the underlying file to exist.
# - http(s) URLs: require internet; optionally attempt a very fast HEAD.
skip_if_unavailable <- function(urls, reason = "required artifact(s) unavailable") {
  urls <- as.character(urls)
  urls <- urls[nzchar(urls)]
  if (!length(urls)) return(invisible(TRUE))

  # Allow tests to force offline behavior:
  if (isTRUE(getOption("writeAlizer.offline", FALSE))) {
    testthat::skip(paste(reason, "(offline mode forced via option)"))
  }

  has_curl <- requireNamespace("curl", quietly = TRUE)
  has_net  <- if (has_curl) curl::has_internet() else TRUE  # best-effort

  # Quick checks first
  for (u in urls) {
    lu <- tolower(u)
    if (startsWith(lu, "file://")) {
      # Work across OSes; strip scheme then normalize
      path <- sub("^file:/+", "/", u)
      if (!file.exists(path)) {
        testthat::skip(paste0(reason, ": missing local file\n  ", path))
      }
    } else if (startsWith(lu, "http://") || startsWith(lu, "https://")) {
      if (!has_net) {
        testthat::skip(paste0(reason, ": no internet"))
      }
    }
  }

  # Optional: fast HEAD probe for http(s) if curl is available
  if (has_curl) {
    h <- curl::new_handle(nobody = TRUE, followlocation = TRUE)
    for (u in urls) {
      if (grepl("^https?://", u, ignore.case = TRUE)) {
        ok <- tryCatch({
          # 2s connect, 3s total; CRAN-friendly and non-flaky
          curl::handle_setopt(h, connecttimeout = 2, timeout = 3)
          curl::curl_fetch_memory(u, handle = h)
          TRUE
        }, error = function(e) FALSE)
        if (!ok) {
          testthat::skip(paste0(reason, ": HEAD failed\n  ", u))
        }
      }
    }
  }

  invisible(TRUE)
}