R/smtp_send.R

In rich-iannone/blastula: Easily Send HTML Email Messages

#' Send an email message through SMTP
#'
#' Send an email message to one or more recipients via an SMTP server. The email
#' message required as input to `smtp_send()` has to be created by using the
#' [compose_email()] function. The `email_message` object can be previewed by
#' printing the object, where the HTML preview will show how the message should
#' appear in recipients' email clients. File attachments can be added to the
#' email object by using the [add_attachment()] function (one call per
#' attachment) prior to sending through this function.
#'
#' We can avoid re-entering SMTP configuration and credentials information by
#' retrieving this information either from disk (with the file generated by use
#' of the [create_smtp_creds_file()] function), or, from the system's key-value
#' store (with the key set by the [create_smtp_creds_key()] function).
#'
#' @param email The email message object, as created by the [compose_email()]
#'   function. The object's class is `email_message`.
#' @param to A vector of email addresses serving as primary recipients for the
#'   message. For secondary recipients, use the `cc` and `bcc` arguments. A
#'   named character vector can be used to specify the recipient names along
#'   with the their email address (e.g., `c("Jane Doe" = "jane_doe@example.com")`).
#' @param from The email address of the sender. Often this needs to be the same
#'   email address that is associated with the account actually sending the
#'   message. As with `to`, `cc`, and `bcc`, we can either supply a single email
#'   address or use a named character vector with the sender name and email
#'   address (e.g., `c("John Doe" = "john_doe@example.com")`).
#' @param subject The subject of the message, which is usually a brief summary
#'   of the topic of the message. If not provided, an empty string will be used
#'   (which is handled differently by email clients).
#' @param cc,bcc A vector of email addresses for sending the message as a carbon
#'   copy or blind carbon copy. The CC list pertains to recipients that are to
#'   receive a copy of a message that is addressed primarily to others. The CC
#'   listing of recipients is visible to all other recipients of the message.
#'   The BCC list differs in that those recipients will be concealed from all
#'   other recipients (including those on the BCC list). A named character
#'   vector can be used to specify the recipient names along with the their
#'   email address (e.g., `c("Joe Public" = "joe_public@example.com")`).
#' @param credentials One of three credential helper functions must be used
#'   here: (1) [creds()], (2) [creds_key()], or (3) [creds_file()]. The first,
#'   [creds()], allows for a manual specification of SMTP configuration and
#'   credentials within that helper function. This is the most secure method for
#'   supplying credentials as they aren't written to disk. The [creds_key()]
#'   function is used if credentials are stored in the system-wide key-value
#'   store, through use of the [create_smtp_creds_key()] function. The
#'   [creds_file()] helper function relies on a credentials file stored on disk.
#'   Such a file is created using the [create_smtp_creds_file()] function.
#' @param creds_file An option to specify a credentials file. As this argument
#'   is deprecated, please consider using `credentials = creds_file(<file>)`
#'   instead.
#' @param verbose Should verbose output from the internal curl `send_mail()`
#'   call be printed? While the username and password will likely be echoed
#'   during the exchange, such information is encoded and won't be stored on
#'   the user's system.
#' @param login_options A string representation of login options allowed by
#'   [`CURLOPT_LOGIN_OPTIONS`](https://curl.se/libcurl/c/CURLOPT_LOGIN_OPTIONS.html).
#' @param ... Extra arguments passed to [curl::send_mail()]
#'
#' @examples
#' # Before sending out an email through
#' # SMTP, we need an `email_message`
#' # object; for the purpose of a simple
#' # example, we can use the function
#' # `prepare_test_message()` to create
#' # a test version of an email (although
#' # we'd normally use `compose_email()`)
#' email <- prepare_test_message()
#'
#' # The `email` message can be sent
#' # through the `smtp_send()` function
#' # so long as we supply the appropriate
#' # credentials; The following three
#' # examples provide scenarios for both
#' # the creation of credentials and their
#' # retrieval within the `credentials`
#' # argument of `smtp_send()`
#'
#' # (1) Providing the credentials info
#' # directly via the `creds()` helper
#' # (the most secure means of supplying
#' # credentials information)
#'
#' # email %>%
#' #   smtp_send(
#' #     from = "sender@email.com",
#' #     to = "recipient@email.com",
#' #     credentials = creds(
#' #       provider = "gmail",
#' #       user = "sender@email.com")
#' #   )
#'
#' # (2) Using a credentials key (with
#' # the `create_smtp_creds_key()` and
#' # `creds_key()` functions)
#'
#' # create_smtp_creds_key(
#' #  id = "gmail",
#' #  user = "sender@email.com",
#' #  provider = "gmail"
#' #  )
#'
#' # email %>%
#' #   smtp_send(
#' #     from = "sender@email.com",
#' #     to = "recipient@email.com",
#' #     credentials = creds_key(
#' #       "gmail"
#' #       )
#' #   )
#'
#' # (3) Using a credentials file (with
#' # the `create_smtp_creds_file()` and
#' # `creds_file()` functions)
#'
#' # create_smtp_creds_file(
#' #  file = "gmail_secret",
#' #  user = "sender@email.com",
#' #  provider = "gmail"
#' #  )
#'
#' # email %>%
#' #   smtp_send(
#' #     from = "sender@email.com",
#' #     to = "recipient@email.com",
#' #     credentials = creds_file(
#' #       "gmail_secret")
#' #   )
#'
#' @export
smtp_send <- function(
    email,
    to,
    from,
    subject = NULL,
    cc = NULL,
    bcc = NULL,
    credentials = NULL,
    creds_file = "deprecated",
    verbose = FALSE,
    login_options = NULL,
    ...
) {

  # Verify that the `message` object
  # is of the class `email_message`
  if (!inherits(email, "email_message")) {

    stop(
      "The object provided in `email` must be an ",
      "`email_message` object.\n",
      " * This can be created with the `compose_email()` function.",
      call. = FALSE
    )
  }

  # If the user provides a path to a creds file in the `creds_file`
  # argument, upgrade that through the `creds_file()` helper function
  # and provide a warning about soft deprecation
  if (!missing(creds_file)) {

    credentials <- creds_file(creds_file)

    warning(
      "The `creds_file` argument is deprecated:\n",
      " * please consider using `credentials = creds_file(\"", creds_file,
      "\")` instead"
    )
  }

  # If nothing is provided in `credentials`, stop the function
  # and include a message about which credential helpers could
  # be used
  if (is.null(credentials)) {

    stop(
      "SMTP credentials must be supplied to the `credentials` argument.\n",
      "We can use either of these three helper functions for this:\n",
      "* `creds_key()`: uses information stored in the system's key-value ",
      "store (have a look at `?creds_key`)\n",
      "* `creds_file()`: takes credentials stored in an on-disk file ",
      "(use `?creds_file` for further info)\n",
      "* `creds()`: allows for manual specification of SMTP credentials",
      call. = FALSE
    )
  }

  # If whatever is provided to `credentials` does not have a
  # `blastula_creds` class, determine whether that value is a
  # single-length character vector (which is upgraded through
  # the `creds_file()` function); if it's anything else, stop
  # the function with a message
  if (!inherits(credentials, "blastula_creds")) {

    if (is.character(credentials) && length(credentials) == 1) {

      credentials <- creds_file(file = credentials)

    } else {

      stop(
        "The value for `credentials` must be a `blastula_creds` object\n",
        "* see the article in `?creds` for information on this",
        call. = FALSE
      )
    }
  }

  # Normalize `subject` so that a `NULL` value becomes an empty string
  subject <- subject %||% ""

  # Normalize `login_options` so that a `NULL` value becomes an empty string
  login_options <- login_options %||% ""

  # Generate an email conforming to the RFC-2822 standard
  email_qp <-
    email %>%
    generate_rfc2822(
      subject = subject,
      from = from,
      to = to,
      cc = cc
    )

  # nocov start

  # Send message using `curl::send_mail()` and suppress all
  # SMTP messages since the SMTP account password in echoed
  result <-
    curl::send_mail(
      mail_from = unname(from),
      mail_rcpt = unname(c(to, cc, bcc)),
      message = email_qp,
      smtp_server = paste0(credentials$host, ":", credentials$port),
      use_ssl = credentials$use_ssl %||% TRUE,
      verbose = verbose,
      username = credentials$user,
      password = credentials$password,
      login_options = login_options,
      ...
    )

  # Transmit a message about send success depending on the status code
  if (result$status_code == 250) {

    message("The email message was sent successfully.")

  } else {

    stop(
      "The email message was NOT sent; the error code was ",
      result$status_code, ".",
      call. = FALSE
    )
  }

  # nocov end
}