elapsed <- function() {
  proc.time()[["elapsed"]]
}

MONTH_NUMBERS <- c(
  Jan = 1L, Feb = 2L, Mar = 3L, Apr = 4L, May = 5L, Jun = 6L,
  Jul = 7L, Aug = 8L, Sep = 9L, Oct = 10L, Nov = 11L, Dec = 12L
)

http_date_seconds <- function(value) {
  parts <- regmatches(
    value,
    regexec(
      paste0(
        "^[A-Za-z]{3}, ([0-9]{2}) ([A-Za-z]{3}) ([0-9]{4}) ",
        "([0-9]{2}):([0-9]{2}):([0-9]{2}) GMT$"
      ),
      value
    )
  )[[1L]]
  if (length(parts) != 7L) {
    return(NULL)
  }
  month <- MONTH_NUMBERS[parts[3L]]
  if (is.na(month)) {
    return(NULL)
  }
  target <- ISOdatetime(
    as.integer(parts[4L]), month, as.integer(parts[2L]),
    as.integer(parts[5L]), as.integer(parts[6L]), as.integer(parts[7L]),
    tz = "GMT"
  )
  if (is.na(target)) {
    return(NULL)
  }
  max(0, as.numeric(difftime(target, Sys.time(), units = "secs")))
}

retry_after_seconds <- function(value) {
  if (is.null(value) || length(value) != 1L || is.na(value)) {
    return(NULL)
  }
  value <- trimws(value)
  if (!nzchar(value)) {
    return(NULL)
  }
  seconds <- suppressWarnings(as.numeric(value))
  if (!is.na(seconds)) {
    return(max(0, seconds))
  }
  http_date_seconds(value)
}

backoff_wait <- function(client, attempt, retry_after) {
  if (!is.null(retry_after)) {
    return(min(retry_after, client$backoff_max))
  }
  ceiling <- min(client$backoff_base * 2^(attempt - 1L), client$backoff_max)
  stats::runif(1L, 0, ceiling)
}

cepis_handle <- function(client) {
  handle <- curl::new_handle()
  curl::handle_setheaders(
    handle,
    "User-Agent" = client$user_agent,
    "Accept" = "application/json, text/csv;q=0.9, */*;q=0.1",
    "Accept-Encoding" = "identity"
  )
  curl::handle_setopt(
    handle,
    connecttimeout_ms = as.integer(client$timeout * 1000),
    timeout_ms = as.integer(client$timeout * 1000)
  )
  handle
}

cepis_fetch <- function(client, path, accepted_status = 200L) {
  url <- paste0(client$base_url, path)
  deadline <- if (is.null(client$total_timeout)) {
    NULL
  } else {
    elapsed() + client$total_timeout
  }

  last_status <- NULL
  last_retry_after <- NULL
  last_message <- NULL

  for (attempt in seq_len(client$max_attempts)) {
    if (!is.null(deadline) && elapsed() >= deadline) {
      break
    }

    response <- tryCatch(
      curl::curl_fetch_memory(url, handle = cepis_handle(client)),
      error = function(e) e
    )

    if (inherits(response, "condition")) {
      last_status <- NULL
      last_retry_after <- NULL
      last_message <- conditionMessage(response)
    } else {
      status <- as.integer(response$status_code)
      headers <- curl::parse_headers_list(response$headers)
      if (status %in% accepted_status || !(status %in% RETRIABLE_STATUS)) {
        return(list(status = status, body = response$content,
                    headers = headers))
      }
      last_status <- status
      last_retry_after <- retry_after_seconds(headers[["retry-after"]])
      last_message <- NULL
    }

    if (attempt == client$max_attempts) {
      break
    }

    wait <- backoff_wait(client, attempt, last_retry_after)
    if (!is.null(deadline)) {
      remaining <- deadline - elapsed()
      if (remaining <= 0) {
        break
      }
      wait <- min(wait, remaining)
    }
    Sys.sleep(wait)
  }

  attempts <- paste0(" (after ", client$max_attempts, " attempt(s))")
  if (identical(last_status, 429L)) {
    stop(rate_limited_error(
      paste0("rate limit reached at ", url, attempts),
      retry_after = last_retry_after
    ))
  }
  if (!is.null(last_status)) {
    stop(server_error(
      paste0("the API answered ", last_status, " at ", url, attempts),
      status = last_status
    ))
  }
  stop(network_error(
    paste0("could not reach ", url, attempts, ": ", last_message),
    url = url
  ))
}

decode_body <- function(body) {
  if (length(body) >= 3L &&
      identical(as.integer(body[1:3]), c(239L, 187L, 191L))) {
    body <- body[-(1:3)]
  }
  text <- rawToChar(body)
  Encoding(text) <- "UTF-8"
  text
}

json_object <- function(body) {
  text <- decode_body(body)
  data <- tryCatch(
    jsonlite::parse_json(text, simplifyVector = FALSE),
    error = function(e) e
  )
  if (inherits(data, "condition") || !is.list(data) ||
      (length(data) > 0L && is.null(names(data)))) {
    stop(invalid_response_error(paste0(
      "response is not a JSON object - something between you and the API is ",
      "answering instead of it: ", substr(text, 1L, 120L)
    )))
  }
  data
}

# The counterpart of json_object() for a body that is already an error: it
# never signals, because a broken error body must not replace the error the
# caller is being told about. Missing, malformed, empty: all of them NULL.
json_field <- function(body, name) {
  data <- tryCatch(
    jsonlite::parse_json(decode_body(body), simplifyVector = FALSE),
    error = function(e) NULL
  )
  if (!is.list(data) || is.null(names(data))) {
    return(NULL)
  }
  data[[name]]
}

api_message <- function(body, fallback) {
  message <- json_field(body, "mensagem")
  if (is.character(message) && length(message) == 1L && nzchar(message)) {
    message
  } else {
    fallback
  }
}

csv_rows <- function(body) {
  path <- tempfile(fileext = ".csv")
  on.exit(unlink(path), add = TRUE)
  writeBin(body, path)

  table <- tryCatch(
    utils::read.csv(
      path,
      colClasses = "character",
      na.strings = character(0L),
      check.names = FALSE,
      encoding = "UTF-8"
    ),
    error = function(e) e
  )
  if (inherits(table, "condition")) {
    stop(invalid_response_error(paste0(
      "batch response is not valid CSV: ", conditionMessage(table)
    )))
  }
  table
}