# Assembles data/nhanes: downloads each NHANES file the analyses read from CDC, records its
# SHA-256 and size in data/nhanes/sources.csv, and stores it compressed with xz. code/run never
# calls this; it records how the data were gathered, and with --check, on a machine with network
# access, compares every recorded file with CDC's current one.
#
# Usage: Rscript code/fetch_data.R [--replication] cycle:FILE ...   fetches the named files
#        Rscript code/fetch_data.R --check                          checks the recorded ones
# Without --replication it refuses the 2021-2023 files, which stay unread until the plan is
# registered.

args <- commandArgs(trailingOnly = TRUE)
allow_replication <- "--replication" %in% args
source("code/lib/cycles.R")

sources_path <- "data/nhanes/sources.csv"
columns <- c("cycle", "file", "url", "sha256", "bytes", "downloaded_utc")
if (!file.exists(sources_path)) write.csv(setNames(data.frame(matrix(character(), 0, 6)), columns), sources_path, row.names = FALSE)

fetch <- function(name, cycle) {
  sources <- read.csv(sources_path, colClasses = "character")
  if (any(sources$cycle == cycle & sources$file == name)) return(invisible(FALSE))
  if (cycle == REPLICATION_CYCLE && !allow_replication) stop("Refusing to fetch ", name, ": 2021-2023 data wait for the registered plan")
  url <- file_url(name, cycle)
  transport <- tempfile(fileext = ".xpt")
  status <- download.file(url, transport, mode = "wb", quiet = TRUE, headers = c("User-Agent" = "Mozilla/5.0"))
  if (status != 0) stop("Download failed: ", url)
  head <- readBin(transport, "raw", 80)
  if (!identical(rawToChar(head[1:20]), "HEADER RECORD*******")) stop(url, " is not a SAS transport file")
  bytes <- file.size(transport)
  digest <- unname(tools::sha256sum(transport))
  dir.create(file.path("data/nhanes", cycle), recursive = TRUE, showWarnings = FALSE)
  raw <- readBin(transport, "raw", bytes)
  connection <- xzfile(file.path("data/nhanes", cycle, paste0(name, ".xpt.xz")), "wb", compression = -9)
  writeBin(raw, connection)
  close(connection)
  unlink(transport)
  row <- data.frame(cycle = cycle, file = name, url = url, sha256 = digest, bytes = format(bytes, scientific = FALSE),
                    downloaded_utc = format(Sys.time(), "%Y-%m-%dT%H:%M:%SZ", tz = "UTC"))
  write.table(row, sources_path, append = TRUE, sep = ",", col.names = FALSE, row.names = FALSE, qmethod = "double")
  message("fetched ", cycle, " ", name, " (", bytes, " bytes)")
  invisible(TRUE)
}

# Files named on the command line as cycle:FILE.
named <- grep(":", args, value = TRUE)
for (item in named) {
  parts <- strsplit(item, ":", fixed = TRUE)[[1]]
  fetch(parts[2], parts[1])
}

# Every recorded file against CDC's current one at the same address (CDC sometimes re-releases a
# file; the analysis reads the recorded one, which the bundle carries).
if ("--check" %in% args) {
  sources <- read.csv(sources_path, colClasses = "character")
  differ <- 0
  for (i in seq_len(nrow(sources))) {
    transport <- tempfile(fileext = ".xpt")
    status <- tryCatch(download.file(sources$url[i], transport, mode = "wb", quiet = TRUE, headers = c("User-Agent" = "Mozilla/5.0")),
                       error = function(e) 1)
    same <- status == 0 && unname(tools::sha256sum(transport)) == sources$sha256[i]
    if (!same) {
      differ <- differ + 1
      message(sources$cycle[i], " ", sources$file[i], ": ", if (status != 0) "could not be downloaded" else "differs from the recorded file")
    }
    unlink(transport)
  }
  message(nrow(sources) - differ, " of ", nrow(sources), " recorded files match CDC's current ones")
}