R/populate-sandbox.R

In mRpostman: An IMAP Client for R

#' @title Populate a Mailbox with the Synthetic Sandbox Corpus
#' @description Stores the deterministic corpus generated by
#'   \code{\link{sandbox_corpus}} in a mailbox, using the package's own IMAP
#'   operations: each message is uploaded with \code{APPEND}
#'   (\code{ImapCon$append_msg()}), a secondary folder is created with
#'   \code{CREATE}, and flags are set with \code{STORE}. It is meant to be run
#'   against the disposable local Docker IMAP server shipped in
#'   \code{system.file("docker", package = "mRpostman")} — see the
#'   \emph{"A reproducible IMAP sandbox with Docker"} vignette — but works
#'   against any IMAP account (mind your provider's rate limits).
#' @param con An \code{ImapCon} object, as returned by
#'   \code{\link{configure_imap}}.
#' @param n Number of messages to append to INBOX. Default is \code{200}.
#' @param seed An integer used as the RNG seed for
#'   \code{\link{sandbox_corpus}}. Default is \code{3501}, after RFC 3501.
#' @param extra_folder A string with the name of a secondary folder to be
#'   created and populated with every 10th message (for folder, COPY, and MOVE
#'   demonstrations), or \code{NULL} to skip it. Default is
#'   \code{"ProjectAtlas"}.
#' @param mute A \code{logical}. If \code{FALSE}, prints progress and a final
#'   summary. Default is \code{FALSE}.
#' @return Invisibly, the \code{info} data.frame of the generated corpus (see
#'   \code{\link{sandbox_corpus}}).
#' @details \code{APPEND} via libcurl stores messages with the \code{\\Seen}
#'   flag (hardcoded in libcurl's IMAP module) and the current internal date,
#'   so flags are adjusted afterwards with \code{ImapCon$add_flags()} and
#'   \code{ImapCon$remove_flags()}. Internal-date searches
#'   (\code{BEFORE}/\code{SINCE}/\code{ON}, \code{WITHIN}) therefore only make
#'   sense relative to the population time; searches on fixed dates should use
#'   the \code{SENT*} variants, which read the \code{Date:} header — spread
#'   over the year 2020 in this corpus.
#' @family sandbox
#' @export
#' @examples
#' \dontrun{
#' # against the local Docker sandbox (see the vignette):
#' con <- configure_imap(url = "imap://localhost:1430",
#'                       username = "testuser",
#'                       password = "sandbox",
#'                       use_ssl = FALSE)
#' info <- populate_sandbox(con, n = 200)
#' }
populate_sandbox <- function(con, n = 200, seed = 3501,
                             extra_folder = "ProjectAtlas", mute = FALSE) {

  assertthat::assert_that(
    inherits(con, "ImapCon"),
    msg='"con" must be an ImapCon object, as returned by configure_imap().')

  if (!is.null(extra_folder)) {
    assertthat::assert_that(
      is.character(extra_folder), length(extra_folder) == 1,
      msg='"extra_folder" must be a string or NULL.')
  }

  check_args(mute = mute)

  corpus <- sandbox_corpus(n = n, seed = seed)
  n <- length(corpus$messages)

  if (!mute) {
    cat(sprintf("Appending %d synthetic messages to INBOX at %s ...\n",
                n, con$con_params$url))
  }

  for (i in seq_len(n)) {
    con$append_msg(message = corpus$messages[[i]], folder = "INBOX",
                   mute = TRUE)
    if (!mute && i %% 50 == 0) cat(sprintf("  %d/%d\n", i, n))
  }

  # a secondary folder with a small deterministic subset
  extra_ids <- integer(0)
  if (!is.null(extra_folder)) {
    con$create_folder(extra_folder, mute = TRUE)
    extra_ids <- which(seq_len(n) %% 10 == 0)
    for (i in extra_ids) {
      con$append_msg(message = corpus$messages[[i]], folder = extra_folder,
                     mute = TRUE)
    }
  }

  # flags are set after the append -- which conveniently also exercises STORE.
  # libcurl hardcodes the \Seen flag in its APPEND command, so every uploaded
  # message arrives marked as read; the planned unseen ones have it removed.
  con$select_folder("INBOX", mute = TRUE)

  unseen_ids   <- which(!corpus$info$seen)
  flagged_ids  <- which(corpus$info$flagged)
  answered_ids <- which(corpus$info$is_reply)

  if (length(unseen_ids)) {
    con$remove_flags(msg_id = unseen_ids, flags_to_unset = "\\Seen",
                     mute = TRUE)
  }
  if (length(flagged_ids)) {
    con$add_flags(msg_id = flagged_ids, flags_to_set = "\\Flagged", mute = TRUE)
  }
  if (length(answered_ids)) {
    con$add_flags(msg_id = answered_ids, flags_to_set = "\\Answered",
                  mute = TRUE)
  }

  if (!mute) {
    counts <- con$examine_folder("INBOX")
    cat("\nDone. INBOX now reports:\n")
    print(counts)
    if (!is.null(extra_folder)) {
      cat(sprintf('"%s" received %d messages.\n', extra_folder,
                  length(extra_ids)))
    }
    cat(sprintf("Flags - Seen: %d | Flagged: %d | Answered: %d\n",
                sum(corpus$info$seen), length(flagged_ids),
                length(answered_ids)))
    # examine_folder leaves the folder in read-only mode; reselect
    con$select_folder("INBOX", mute = TRUE)
  }

  invisible(corpus$info)

}