Skip to main content

src/internal/renderer/internet_message.gleam

//// This module implements functions to render a sendr message into the
//// internet message format as specified in
//// [RFC 5322](https://tools.ietf.org/html/rfc5322) and updated by
//// [RFC 6854](https://tools.ietf.org/html/rfc6854).

import gleam/bit_array
import gleam/bool
import gleam/crypto
import gleam/int
import gleam/list.{Continue, Stop}
import gleam/option.{type Option, None, Some}
import gleam/order
import gleam/pair
import gleam/result
import gleam/string
import gleam/time/calendar.{
  type Month, April, August, Date, December, February, January, July, June,
  March, May, November, October, September, TimeOfDay,
}
import gleam/time/duration.{type Duration}
import gleam/time/timestamp.{type Timestamp}
import internal/encoder
import internal/encoder/encoding.{
  type EncoderError, type Encoding, type EncodingMode,
}
import sendr/message.{type Message}
import sendr/message/attachment.{
  type Attachment, AttachedAttachment, InlinedAttachment,
}
import sendr/message/body.{type Body}
import sendr/message/mailbox.{type Mailbox}

const structured_encoders: List(Encoding) = [
  encoding.Text(encoding.Structured),
  encoding.QuotedPrintable(encoding.Rfc2047),
  encoding.Base64,
]

const unstructured_encoders: List(Encoding) = [
  encoding.Text(encoding.Unstructured),
  encoding.QuotedPrintable(encoding.Rfc2047),
  encoding.Base64,
]

const body_encoders: List(Encoding) = [
  encoding.Bit(7),
  encoding.Bit(8),
  encoding.QuotedPrintable(encoding.Rfc2045),
  encoding.Base64,
]

//
// Constants
//

const preferred_line_size: Int = 78

const maximum_line_size: Int = 998

//
// Types
//

/// Errors that can occur when encoding header field bodies.
pub type FieldBodyError {
  /// The date value is invalid.
  InvalidDate(#(Timestamp, Duration))
  /// The email address is invalid.
  InvalidEmailAddress(String)
}

/// Errors that can occur during message rendering.
pub type RenderError {
  /// The header field name is invalid (e.g., contains spaces or special characters).
  InvalidHeaderFieldName(String)
  /// The header field body is invalid and can't be encoded.
  InvalidHeaderFieldBody(FieldBodyError)
  /// An invalid encoding was specified for the context (header/body) it is used in.
  InvalidEncoding(encoding.Encoding)
  /// No suitable encoder could be found for the given input and constraints.
  NoUsableEncodingFound(List(Encoding))
  /// Encoding failed due to an encoder error.
  EncodingFailed(EncoderError)
}

type BodyPart {
  BodyPart(headers: List(#(String, List(String))), body: List(String))
}

/// Render a sendr Message into an Internet Message format string.
///
/// This function converts a `sendr/message.Message` into a string
/// conforming to [RFC 5322](https://tools.ietf.org/html/rfc5322)
/// and updated by [RFC 6854](https://tools.ietf.org/html/rfc6854).
///
/// The rendered message includes:
/// - `Date` header (automatically generated from the current system time)
/// - `From`, `Reply-To`, `To`, `Cc` headers (if set on the message)
/// - `Subject` header (if set on the message)
/// - `Message-ID` header (generated from the sender's address)
/// - `MIME-Version: 1.0` header
/// - Message body (text and/or HTML) with appropriate MIME encoding
/// - Attachments (if any), wrapped in multipart/mixed or multipart/related
pub fn encode(
  mail message: Message,
  with mode: EncodingMode,
) -> Result(List(String), RenderError) {
  let date = #(timestamp.system_time(), calendar.utc_offset)
  let message_id = option.or(message.from, Some(mailbox.new("", "@localhost")))

  Ok([])
  |> append_strings(date, date_header("Date", _))
  |> maybe_append_strings(message.from, mailbox_header("From", _, mode))
  |> maybe_append_strings(message.reply_to, mailbox_list_header(
    "Reply-To",
    _,
    mode,
  ))
  |> maybe_append_strings(message.to, mailbox_list_header("To", _, mode))
  |> maybe_append_strings(message.cc, mailbox_list_header("Cc", _, mode))
  |> maybe_append_strings(message.subject, unstructured_header(
    "Subject",
    _,
    mode,
  ))
  |> maybe_append_strings(message_id, message_id_header("Message-ID", _, mode))
  |> append_strings("1.0", unstructured_header("MIME-Version", _, mode))
  |> append_strings(#(message.body, message.attachments), body(_, mode))
  |> result.map(list.reverse)
}

//
// Date header encoding
//

fn date_header(
  field_name: String,
  field_body: #(Timestamp, Duration),
) -> Result(List(String), RenderError) {
  use field_name <- result.map(encode_field_name(field_name))
  let #(timestamp, offset) = field_body
  let #(Date(day:, month:, year:), TimeOfDay(hours:, minutes:, seconds:, ..)) =
    timestamp.to_calendar(timestamp, calendar.utc_offset)

  let weekday = weekday_to_string(timestamp)
  let date =
    string.join([pad(day), month_to_string(month), int.to_string(year)], " ")
  let time = string.join([pad(hours), pad(minutes), pad(seconds)], ":")
  let zone = duration_to_string(offset)

  prepend_field_name(field_name, [
    weekday <> ", " <> date <> " " <> time <> " " <> zone,
  ])
}

fn weekday_to_string(timestamp: Timestamp) -> String {
  // Unix epoch is Thursday 1 January 1970, 00:00:00 UTC. There are 86400 seconds
  // in a day, and Thursday is the 4 day in the week (starting counting at 0).
  let #(seconds, _milliseconds) =
    timestamp.to_unix_seconds_and_nanoseconds(timestamp)
  let weekday = { seconds / 86_400 + 4 } % 7

  case weekday {
    0 -> "Sun"
    1 -> "Mon"
    2 -> "Tue"
    3 -> "Wed"
    4 -> "Thu"
    5 -> "Fri"
    6 -> "Sat"
    // nolint: avoid_panic -- fallback body is unreachable due to modulo
    _ -> panic as { "Unexpectely received " <> int.to_string(weekday) }
  }
}

fn month_to_string(month: Month) -> String {
  case month {
    January -> "Jan"
    February -> "Feb"
    March -> "Mar"
    April -> "Apr"
    May -> "May"
    June -> "Jun"
    July -> "Jul"
    August -> "Aug"
    September -> "Sep"
    October -> "Oct"
    November -> "Nov"
    December -> "Dec"
  }
}

fn duration_to_string(duration: Duration) -> String {
  let #(seconds, _milliseconds) = duration.to_seconds_and_nanoseconds(duration)

  let hours = int.absolute_value(seconds / 3600)
  let minutes = int.absolute_value(seconds / 60 % 60)

  case seconds >= 0 {
    True -> "+" <> pad(hours) <> pad(minutes)
    False -> "-" <> pad(hours) <> pad(minutes)
  }
}

fn pad(value: Int) -> String {
  string.pad_start(int.to_string(value), 2, "0")
}

//
// Mailbox header encoding
//

fn mailbox_header(
  field_name: String,
  field_body: Mailbox,
  mode: EncodingMode,
) -> Result(List(String), RenderError) {
  mailbox_list_header(field_name, [field_body], mode)
}

fn mailbox_list_header(
  field_name: String,
  field_body: List(Mailbox),
  mode: EncodingMode,
) -> Result(List(String), RenderError) {
  use field_name <- result.try(encode_field_name(field_name))
  use encoded_mailboxes <- result.map(encode_mailbox_list(
    field_body,
    string.byte_size(field_name) + 2,
    mode,
  ))
  prepend_field_name(field_name, encoded_mailboxes)
}

fn encode_mailbox_list(
  mailboxes: List(Mailbox),
  count: Int,
  mode: encoding.EncodingMode,
) -> Result(List(String), RenderError) {
  let last_mailbox_index = list.length(mailboxes) - 1

  mailboxes
  |> try_index_fold(#(count, []), fn(accumulator, mailbox, index) {
    let #(count, lines) = accumulator

    let indent = case index {
      0 -> ""
      _ -> " "
    }
    let separator = case index {
      index if index < last_mailbox_index -> ","
      _ -> ""
    }
    encode_mailbox(mailbox, count + 1, mode, indent, separator)
    |> result.map(fn(mailbox_lines) {
      case mailbox_lines, lines {
        [], lines -> lines
        mailbox_lines, [] -> mailbox_lines
        ["", ..other_mailbox_lines], [last_line, ..other_lines] ->
          list.append(other_mailbox_lines, [last_line, ..other_lines])
        [first_mailbox_line, ..other_mailbox_lines], [last_line, ..other_lines]
        ->
          list.append(other_mailbox_lines, [
            last_line <> first_mailbox_line,
            ..other_lines
          ])
      }
    })
    |> result.map(fn(lines) {
      case lines {
        [] -> #(0, lines)
        [last_line, ..] -> #(string.byte_size(last_line), lines)
      }
    })
  })
  |> result.map(fn(result) { pair.second(result) })
}

fn encode_mailbox(
  mailbox: Mailbox,
  used_size: Int,
  mode: encoding.EncodingMode,
  indent: String,
  separator: String,
) -> Result(List(String), RenderError) {
  use display_name <- result.try(encode_field_body(
    mailbox.name,
    used_size,
    structured_encoders,
    mode,
  ))
  use address <- result.try(encode_mailbox_address(mailbox, mode))
  let address = address <> separator
  let address_size = string.byte_size(address)
  let reversed_display_name = list.reverse(display_name)
  let last_display_name_size =
    list.first(reversed_display_name) |> result.unwrap("") |> string.byte_size()
  let indent_size = string.byte_size(indent)

  use <- bool.guard(
    when: address_size + indent_size >= maximum_line_size,
    return: Error(
      EncodingFailed(encoding.MaximumSizeExceeded(maximum_line_size)),
    ),
  )

  case reversed_display_name {
    [] if used_size + indent_size + address_size <= preferred_line_size -> [
      indent <> address,
    ]
    [] -> ["", " " <> address]

    [display_name]
      if used_size + indent_size + last_display_name_size + 1 + address_size
      <= preferred_line_size
    -> [display_name <> " " <> address]

    [last_display_name, ..other_display_name]
      if last_display_name_size + 1 + address_size <= preferred_line_size
    ->
      [last_display_name <> " " <> address, ..other_display_name]
      |> list.reverse()

    display_name ->
      [" " <> address, ..display_name]
      |> list.reverse()
  }
  |> fn(lines) {
    case lines {
      [] -> Ok([])
      ["", ..rest] -> Ok(["", ..rest])
      [first_line, ..rest] -> Ok([indent <> first_line, ..rest])
    }
  }
}

fn encode_mailbox_address(
  mailbox: Mailbox,
  mode: EncodingMode,
) -> Result(String, RenderError) {
  mailbox.address
  |> encode_email_address(mode)
  |> result.map(fn(address) {
    case mailbox.name {
      "" -> address
      _ -> "<" <> address <> ">"
    }
  })
}

fn encode_email_address(
  address: String,
  mode: encoding.EncodingMode,
) -> Result(String, RenderError) {
  encoder.encode_email_address(address, mode)
  |> result.map_error(EncodingFailed)
}

//
// Message ID header encoding
//

fn message_id_header(
  name: String,
  mailbox: Mailbox,
  mode: EncodingMode,
) -> Result(List(String), RenderError) {
  use field_name <- result.try(encode_field_name(name))
  string.split_once(mailbox.address, "@")
  |> result.replace_error(
    InvalidHeaderFieldBody(InvalidEmailAddress(mailbox.address)),
  )
  |> result.try(fn(local_domain) {
    let #(seconds, _nanoseconds) =
      timestamp.to_unix_seconds_and_nanoseconds(timestamp.system_time())
    let random = bit_array.base64_encode(crypto.strong_random_bytes(10), False)

    let message_id =
      int.to_base16(seconds)
      <> "."
      <> random
      <> "@"
      <> pair.second(local_domain)

    message_id
    |> encode_email_address(mode)
    |> result.map(fn(address) { prepend_field_name(field_name, [address]) })
  })
}

//
// Unstructered header encoding
//

fn unstructured_header(
  name: String,
  value: String,
  mode: EncodingMode,
) -> Result(List(String), RenderError) {
  use field_name <- result.try(encode_field_name(name))
  use field_body <- result.map(encode_field_body(
    value,
    string.byte_size(field_name) + 2,
    unstructured_encoders,
    mode,
  ))
  prepend_field_name(field_name, field_body)
}

//
// Field name encoding
//

fn encode_field_name(field_name: String) -> Result(String, RenderError) {
  let normalized_field_name = normalize_field_name(field_name)
  case is_valid_field_name(normalized_field_name) {
    True -> Ok(normalized_field_name)
    False -> Error(InvalidHeaderFieldName(field_name))
  }
}

fn normalize_field_name(field_name: String) -> String {
  field_name
  |> string.replace("_", "-")
  |> string.split("-")
  |> list.map(fn(part) {
    let part = string.uppercase(string.trim(part))
    case part {
      "ID" | "MIME" -> part
      _ -> string.capitalise(part)
    }
  })
  |> string.join("-")
}

fn is_valid_field_name(field_name: String) -> Bool {
  field_name != ""
  && {
    field_name
    |> string.split("")
    |> list.all(fn(char) {
      string.compare(char, "\u{20}") == order.Gt
      && string.compare(char, "\u{7f}") == order.Lt
      && string.compare(char, ":") != order.Eq
    })
  }
}

fn prepend_field_name(
  field_name: String,
  field_body: List(String),
) -> List(String) {
  case field_body {
    [] -> [field_name <> ":"]
    [head, ..rest] -> [field_name <> ": " <> head, ..rest]
  }
}

//
// Body encoding
//
fn body(
  value: #(Body, List(Attachment)),
  mode: encoding.EncodingMode,
) -> Result(List(String), RenderError) {
  let #(body, attachments) = value

  use text_body <- result.try(create_body("plain", body.text, mode))
  use html_body <- result.try(create_body("html", body.html, mode))
  use #(inlined_attachments, attached_attachments) <- result.try(
    create_attachments(attachments, !list.is_empty(html_body)),
  )

  create_multipart("mixed", [
    create_multipart("alternative", [
      text_body,
      create_multipart("related", [html_body, inlined_attachments]),
    ]),
    attached_attachments,
  ])
  |> fn(message_part) {
    case message_part {
      [] -> Ok([])
      [part] -> Ok(["", ..part_to_strings(part)])
      _otherwise -> Error(EncodingFailed(encoding.UnknownError))
    }
  }
}

fn create_body(
  subtype: String,
  value: Option(String),
  mode: encoding.EncodingMode,
) -> Result(List(BodyPart), RenderError) {
  case value {
    None -> Ok([])
    Some(value) -> {
      body_encoders
      |> encoder.determine_encoding_order(value, mode, maximum_line_size)
      |> list.fold_until(
        Error(EncodingFailed(encoding.NoEncoderFound)),
        fn(_acc, enc) {
          let result = encode_body_part(subtype, value, enc, mode)

          case result {
            Ok(body_part) -> Stop(Ok([body_part]))
            Error(result) -> Continue(Error(EncodingFailed(result)))
          }
        },
      )
    }
  }
}

fn encode_body_part(
  subtype: String,
  value: String,
  encoding: Encoding,
  mode: EncodingMode,
) -> Result(BodyPart, EncoderError) {
  value
  |> encoder.encode_string(
    encoding,
    mode,
    0,
    preferred_line_size,
    maximum_line_size,
  )
  |> result.map(fn(lines) {
    let charset = guess_charset(value)
    let content_type =
      string.join(["text/", subtype, "; charset=", charset], "")

    BodyPart(
      headers: [
        #("Content-Transfer-Encoding", [encoder.name(encoding)]),
        #("Content-Type", [content_type]),
      ],
      body: lines,
    )
  })
}

fn create_attachments(
  attachments: List(Attachment),
  should_inline: Bool,
) -> Result(#(List(BodyPart), List(BodyPart)), RenderError) {
  list.try_fold(attachments, #([], []), fn(accumulator, attachment) {
    attachment
    |> create_part
    |> result.map(fn(part) {
      let #(inlined_attachments, attached_attachments) = accumulator
      case attachment {
        InlinedAttachment(..) if should_inline -> #(
          [part, ..inlined_attachments],
          attached_attachments,
        )
        _otherwise -> #(inlined_attachments, [part, ..attached_attachments])
      }
    })
  })
  |> result.map(fn(attachments) {
    let #(inlined_attachments, attached_attachments) = attachments
    #(list.reverse(inlined_attachments), list.reverse(attached_attachments))
  })
  |> result.map_error(fn(error) { EncodingFailed(error) })
}

fn create_part(attachment: Attachment) -> Result(BodyPart, EncoderError) {
  use headers <- result.map(
    case attachment {
      InlinedAttachment(content_id:, ..) ->
        disposition("inline", attachment)
        |> result.map(pair.new("Content-Disposition", _))
        |> result.map(list.wrap)
        |> result.map(
          list.append(_, [#("Content-ID", ["<" <> content_id <> ">"])]),
        )

      AttachedAttachment(..) ->
        disposition("attachment", attachment)
        |> result.map(pair.new("Content-Disposition", _))
        |> result.map(list.wrap)
    }
    |> result.map(
      list.append(_, [
        #("Content-Type", [attachment.content_type]),
        #("Content-Transfer-Encoding", ["base64"]),
      ]),
    ),
  )
  let body =
    attachment.data
    |> bit_array.base64_encode(True)
    |> string_chunk([], _, preferred_line_size)

  BodyPart(headers, body)
}

fn disposition(
  disposition: String,
  attachment: Attachment,
) -> Result(List(String), EncoderError) {
  use filename <- result.try(encoder.encode_string(
    attachment.filename,
    encoding.Text(encoding.Structured),
    encoding.Ascii,
    10,
    preferred_line_size,
    maximum_line_size,
  ))
  use filename_utf8 <- result.map(encoder.encode_string(
    attachment.filename_utf8,
    encoding.PercentEncoding,
    encoding.Ascii,
    7,
    preferred_line_size - 13,
    maximum_line_size - 13,
  ))
  let filename = case filename {
    [] | [""] -> []
    [line, ..rest] -> [" filename=" <> line, ..rest]
  }
  let filename_utf8 = case filename_utf8 {
    [] | [""] -> []
    [line] -> [" filename*=UTF-8''" <> line]
    lines ->
      list.index_map(lines, fn(line, index) {
        case index {
          0 -> " filename*1*=UTF-8''" <> line
          index -> " filename*" <> int.to_string(index + 1) <> "=" <> line
        }
      })
  }

  let disposition_header =
    [disposition, ..filename]
    |> list.append(filename_utf8)

  let disposition_header_last_item = list.length(disposition_header) - 1
  list.index_map(disposition_header, fn(line, index) {
    case line {
      line if index == disposition_header_last_item -> line
      line -> line <> ";"
    }
  })
}

fn create_multipart(
  subtype: String,
  parts: List(List(BodyPart)),
) -> List(BodyPart) {
  case list.flatten(parts) {
    [] -> []
    [parts] -> [parts]
    parts -> {
      let boundary =
        "__sendr__" <> bit_array.base16_encode(crypto.strong_random_bytes(10))

      let headers = [
        #("Content-Type", [
          "multipart/" <> subtype <> "; boundary=\"" <> boundary <> "\"",
        ]),
      ]

      let body =
        list.fold(parts, [], fn(acc, part) {
          acc
          |> list.append(["--" <> boundary])
          |> list.append(part_to_strings(part))
        })
        |> list.append(["--" <> boundary <> "--"])

      [BodyPart(headers, body)]
    }
  }
}

fn part_to_strings(part: BodyPart) -> List(String) {
  let BodyPart(headers:, body:) = part

  headers
  |> list.flat_map(fn(header) {
    let #(field_name, field_body) = header
    prepend_field_name(field_name, field_body)
  })
  |> list.append([""])
  |> list.append(body)
}

//
// Utility functions
//
fn append_strings(
  data: Result(List(String), RenderError),
  value: a,
  callback: fn(a) -> Result(List(String), RenderError),
) -> Result(List(String), RenderError) {
  data
  |> result.try(fn(data) {
    value
    |> callback()
    |> result.map(fn(lines) {
      lines
      |> list.reverse()
      |> list.append(data)
    })
  })
}

fn maybe_append_strings(
  data: Result(List(String), RenderError),
  value: Option(a),
  callback: fn(a) -> Result(List(String), RenderError),
) -> Result(List(String), RenderError) {
  case value {
    None -> data
    Some(value) -> append_strings(data, value, callback)
  }
}

fn string_chunk(
  accumulator: List(String),
  string: String,
  chunk_size: Int,
) -> List(String) {
  case string {
    "" -> list.reverse(accumulator)
    string ->
      string_chunk(
        [string.slice(string, 0, chunk_size), ..accumulator],
        string.drop_start(string, chunk_size),
        chunk_size,
      )
  }
}

fn guess_charset(text: String) -> String {
  let is_ascii = fn(char) {
    string.compare(char, "\u{0}") == order.Gt
    && string.compare(char, "\u{80}") == order.Lt
  }

  case list.all(string.split(text, ""), is_ascii) {
    True -> "us-ascii"
    False -> "utf-8"
  }
}

fn encode_field_body(
  value: String,
  used: Int,
  encoders: List(Encoding),
  mode: encoding.EncodingMode,
) -> Result(List(String), RenderError) {
  encoders
  |> encoder.determine_encoding_order(value, mode, maximum_line_size)
  |> list.fold_until(Error(NoUsableEncodingFound(encoders)), fn(_acc, encoding) {
    case try_encode_field_body(encoding, value, mode, used) {
      Ok(_) as result -> Stop(result)
      Error(_) as error -> Continue(error)
    }
  })
}

fn try_encode_field_body(
  encoding: Encoding,
  value: String,
  mode: EncodingMode,
  used: Int,
) -> Result(List(String), RenderError) {
  use #(first_prefix, prefix, postfix) <- result.try(case encoding {
    encoding.Base64 -> Ok(#("=?utf-8?B?", " =?utf-8?B?", "?="))
    encoding.QuotedPrintable(_) -> Ok(#("=?utf-8?Q?", " =?utf-8?Q?", "?="))
    encoding.Text(_) -> Ok(#("", "", ""))
    encoding -> Error(InvalidEncoding(encoding))
  })

  let encoding_size = string.byte_size(prefix) - string.byte_size(postfix)

  encoder.encode_string(
    value,
    encoding,
    mode,
    used + string.byte_size(first_prefix),
    preferred_line_size - encoding_size,
    maximum_line_size - encoding_size,
  )
  |> result.map_error(EncodingFailed)
  |> result.map(fn(encoded_string) {
    encoded_string
    |> list.index_map(fn(line, index) {
      case index {
        0 -> first_prefix <> line <> postfix
        _ -> prefix <> line <> postfix
      }
    })
  })
}

//
// Generic functions
//

fn try_index_fold(
  over list: List(a),
  from initial: acc,
  with fun: fn(acc, a, Int) -> Result(acc, e),
) -> Result(acc, e) {
  list.try_fold(list, #(0, initial), fn(accumulator, item) {
    let #(index, accumulator) = accumulator

    fun(accumulator, item, index)
    |> result.map(fn(accumulator) { #(index + 1, accumulator) })
  })
  |> result.map(pair.second)
}