Skip to main content

src/sendr_smtp.gleam

import gleam/list
import gleam/option.{type Option, None, Some}
import gleam/result
import gleam/string
import internal/protocol.{Done, ProtocolConfig, Receive, Send, Upgrade}
import sendr.{
  type Field, type SendrError, BackendError, Bcc, Cc, From, InvalidAttachment,
  InvalidBody, InvalidMailbox, NoBody, NoRecipients, ReplyTo,
  RequiredContentIdMissing, RequiredFieldMissing, RequiredFilenameMissing,
  Subject, To,
}
import sendr/message.{type Message}
import sendr/message/attachment.{InlinedAttachment}
import sendr/message/mailbox.{type Mailbox}

/// Errors that can occur when sending an email via SMTP.
pub type SmtpError {
  ConnectionError(ConnectionError)
  ProtocolError(protocol.ProtocolError)
}

/// Errors related to the network connection to the SMTP server.
///
/// - `Closed`: The connection was closed by the server.
/// - `Timeout`: The operation timed out.
/// - `PosixError`: A POSIX system error occurred.
/// - `SslNotStarted`: The SSL/TLS application was not started.
/// - `TlsAlert`: A TLS alert was received from the server.
pub type ConnectionError {
  /// The connection was closed.
  Closed
  /// The operation timed out.
  Timeout
  // /// The Erlang VM can't allocate more resources for network operations.
  // SystemLimit
  /// A POSIX error.
  PosixError(PosixError)
  /// The SSL application has not been started. It probably failed to start.
  SslNotStarted
  /// A TLS alert.
  TlsAlert(TlsAlert, String)
  // /// A generic TCP error with a description.
  // TcpError(String)
}

/// TLS alert descriptions as defined in the [Erlang ssl module documentation][1].
///
/// [1]: https://www.erlang.org/doc/apps/ssl/ssl.html#t:tls_alert/0
pub type TlsAlert {
  CloseNotify
  UnexpectedMessage
  BadRecordMac
  RecordOverflow
  HandshakeFailure
  BadCertificate
  UnsupportedCertificate
  CertificateRevoked
  CertificateExpired
  CertificateUnknown
  IllegalParameter
  UnknownCa
  AccessDenied
  DecodeError
  DecryptError
  ExportRestriction
  ProtocolVersion
  InsufficientSecurity
  InternalError
  InappropriateFallback
  UserCanceled
  NoRenegotiation
  UnsupportedExtension
  CertificateUnobtainable
  UnrecognizedName
  BadCertificateStatusResponse
  BadCertificateHashValue
  UnknownPskIdentity
  NoApplicationProtocol
}

/// POSIX error codes.
///
/// See the [Erlang inet documentation](https://www.erlang.org/doc/apps/kernel/inet.html#module-posix-error-codes)
/// for descriptions of each error code.
pub type PosixError {
  Eaddrinuse
  Eaddrnotavail
  Eafnosupport
  Ealready
  Econnaborted
  Econnrefused
  Econnreset
  Edestaddrreq
  Ehostdown
  Ehostunreach
  Einprogress
  Eisconn
  Emsgsize
  Enetdown
  Enetreset
  Enetunreach
  Enopkg
  Enoprotoopt
  Enotconn
  Enotty
  Enotsock
  Eproto
  Eprotonosupport
  Eprototype
  Esocktnosupport
  Etimedout
  Ewouldblock
  Exbadport
  Exbadseq
  Nxdomain
  Eacces
  Eagain
  Ebadf
  Ebadmsg
  Ebusy
  Edeadlk
  Edeadlock
  Edquot
  Eexist
  Efault
  Efbig
  Eftype
  Eintr
  Einval
  Eio
  Eisdir
  Eloop
  Emfile
  Emlink
  Emultihop
  Enametoolong
  Enfile
  Enobufs
  Enodev
  Enolck
  Enolink
  Enoent
  Enomem
  Enospc
  Enosr
  Enostr
  Enosys
  Enotblk
  Enotdir
  Enotsup
  Enxio
  Eopnotsupp
  Eoverflow
  Eperm
  Epipe
  Erange
  Erofs
  Eshutdown
  Espipe
  Esrch
  Estale
  Etxtbsy
  Exdev
}

/// SMTP authentication credentials (username and password).
pub type Credentials {
  Credentials(username: String, password: String)
}

/// The TLS mode for the SMTP connection.
///
/// - `ImplicitTls`: Connect with TLS immediately (default port 465).
/// - `StartTls`: Upgrade to TLS after connecting (default port 587).
pub type TlsMode {
  ImplicitTls
  StartTls
}

/// TLS configuration for the SMTP connection.
pub type Tls {
  Tls(mode: TlsMode, allow_invalid_certs: Bool)
}

/// Configuration for connecting to an SMTP server.
///
/// - `hostname`: The SMTP server hostname.
/// - `port`: The SMTP server port.
/// - `tls`: The TLS configuration.
/// - `timeout_ms`: Timeout in milliseconds for network operations.
/// - `helo_host`: Custom hostname for the EHLO/HELO command, if none given
///                the hostname is guessed. If guessing fails localhost is used.
/// - `credentials`: Optional authentication credentials.
pub type SmtpConfig {
  SmtpConfig(
    hostname: String,
    port: Int,
    tls: Tls,
    timeout_ms: Int,
    helo_host: Option(String),
    credentials: Option(Credentials),
  )
}

type ConnectOptions {
  ConnectOptions(hostname: String, port: Int, tls: Tls, timeout_ms: Int)
}

type Socket

type Connection {
  TcpConnection(socket: Socket, timeout_ms: Int)
  SslConnection(socket: Socket, timeout_ms: Int)
}

/// Create a default `SmtpConfig` for the given hostname and port.
///
/// Automatically sets TLS mode based on the port:
/// - Port 465: `ImplicitTls` with `allow_invalid_certs: False`
/// - Other ports: `StartTls` with `allow_invalid_certs: True`
/// Default timeout is 10 seconds.
///
/// - `hostname`: The SMTP server hostname.
/// - `port`: The SMTP server port.
///
/// Returns a new `SmtpConfig`.
pub fn config(connect_to hostname: String, on port: Int) -> SmtpConfig {
  let tls = case port {
    465 -> Tls(ImplicitTls, False)
    _ -> Tls(StartTls, True)
  }

  SmtpConfig(
    hostname:,
    port:,
    tls:,
    timeout_ms: 10_000,
    credentials: None,
    helo_host: None,
  )
}

/// Set the SMTP server port on the config.
pub fn port(config config: SmtpConfig, set port: Int) -> SmtpConfig {
  SmtpConfig(..config, port:)
}

/// Set the TLS mode on the config.
pub fn tls_mode(
  config config: SmtpConfig,
  set tls_mode: TlsMode,
) -> SmtpConfig {
  SmtpConfig(..config, tls: Tls(tls_mode, config.tls.allow_invalid_certs))
}

/// Set whether to allow invalid TLS certificates.
pub fn allow_invalid_certs(
  config config: SmtpConfig,
  set allow_invalid_certs: Bool,
) -> SmtpConfig {
  SmtpConfig(..config, tls: Tls(config.tls.mode, allow_invalid_certs))
}

/// Set the SMTP authentication credentials on the config.
pub fn credentials(
  config config: SmtpConfig,
  username username: String,
  password password: String,
) -> SmtpConfig {
  SmtpConfig(..config, credentials: Some(Credentials(username, password)))
}

/// Set a custom hostname for the EHLO/HELO command.
pub fn helo_host(
  config config: SmtpConfig,
  set helo_host: String,
) -> SmtpConfig {
  SmtpConfig(..config, helo_host: Some(helo_host))
}

/// Deliver an email message via SMTP.
///
/// Validates the message fields upfront, then connects to the SMTP server,
/// performs the SMTP protocol session, and disconnects.
///
/// - `message`: The `sendr/message.Message` to deliver.
/// - `config`: The `SmtpConfig` for the connection.
///
/// Returns `Ok(Nil)` on success, or `Error(SendrError(SmtpError))` if
/// validation or delivery fails.
pub fn deliver(
  email message: Message,
  with config: SmtpConfig,
) -> Result(Nil, SendrError(SmtpError)) {
  use _ <- result.try(validate_from(message))
  use _ <- result.try(validate_reply_to(message))
  use _ <- result.try(validate_recipients(message))
  use _ <- result.try(validate_subject(message))
  use _ <- result.try(validate_attachments(message))
  use _ <- result.try(validate_body(message))

  do_deliver(message, config)
  |> result.map_error(fn(e) { BackendError(e) })
}

fn validate_from(message: Message) -> Result(Nil, SendrError(error)) {
  case message.from {
    None -> Error(RequiredFieldMissing(From))
    Some(mailbox) -> validate_mailbox(mailbox, From)
  }
}

fn validate_reply_to(message: Message) -> Result(Nil, SendrError(error)) {
  case message.reply_to {
    None | Some([]) -> Ok(Nil)
    Some(mailboxes) ->
      list.try_each(mailboxes, validate_mailbox(_, ReplyTo))
      |> result.replace(Nil)
  }
}

fn validate_recipients(message: Message) -> Result(Nil, SendrError(error)) {
  let recipients =
    [message.to, message.cc, message.bcc]
    |> option.values()
    |> list.flatten()

  let validate = fn(mailboxes, field) {
    mailboxes
    |> option.unwrap([])
    |> list.try_each(validate_mailbox(_, field))
  }

  case recipients {
    [] -> Error(NoRecipients)
    _ ->
      validate(message.bcc, Bcc)
      |> result.or(validate(message.cc, Cc))
      |> result.or(validate(message.to, To))
  }
}

fn validate_mailbox(
  mailbox: Mailbox,
  field: Field,
) -> Result(Nil, SendrError(error)) {
  case string.split_once(mailbox.address, "@") {
    Ok(#(local, domain)) if local != "" && domain != "" -> Ok(Nil)
    _ -> Error(InvalidMailbox(field, mailbox))
  }
}

fn validate_subject(message: Message) -> Result(Nil, SendrError(error)) {
  case message.subject {
    None | Some("") -> Error(RequiredFieldMissing(Subject))
    _ -> Ok(Nil)
  }
}

fn validate_attachments(message: Message) -> Result(Nil, SendrError(error)) {
  list.try_each(message.attachments, fn(attachment) {
    case attachment.filename, attachment.filename_utf8 {
      "", "" -> Error(InvalidAttachment(RequiredFilenameMissing, attachment))
      _, _ ->
        case attachment {
          InlinedAttachment(content_id: "", ..) ->
            Error(InvalidAttachment(RequiredContentIdMissing, attachment))
          _ -> Ok(Nil)
        }
    }
  })
}

fn validate_body(message: Message) -> Result(Nil, SendrError(error)) {
  case message.body.text, message.body.html {
    None, None -> Error(InvalidBody(NoBody))
    _, _ -> Ok(Nil)
  }
}

fn do_deliver(message: Message, config: SmtpConfig) -> Result(Nil, SmtpError) {
  let connection_options =
    ConnectOptions(config.hostname, config.port, config.tls, config.timeout_ms)
  let protocol_config =
    ProtocolConfig(
      helo_host: option.lazy_unwrap(config.helo_host, fqdn),
      credentials: option.map(config.credentials, fn(credentials) {
        #(credentials.username, credentials.password)
      }),
    )

  use connection <- result.try(connect(connection_options))
  let result =
    smtp_session(
      connection,
      connection_options,
      protocol.start_session(message, protocol_config),
    )
  disconnect(connection)
  result
}

fn fqdn() -> String {
  get_hostname()
  |> get_host_by_name()
  |> result.unwrap("localhost")
}

fn smtp_session(
  connection: Connection,
  options: ConnectOptions,
  action: Result(protocol.Action, protocol.ProtocolError),
) -> Result(Nil, SmtpError) {
  case action {
    Ok(Receive(callback)) ->
      connection
      |> receive()
      |> result.try(handle_response(_, callback))
      |> result.try(fn(r) { smtp_session(connection, options, Ok(r)) })
    Ok(Send(command, callback)) ->
      connection
      |> send(command)
      |> result.map(fn(_) { callback() })
      |> result.try(smtp_session(connection, options, _))
    Ok(Upgrade(callback)) ->
      connection
      |> upgrade(options)
      |> result.try(smtp_session(_, options, callback()))
    Ok(Done) -> Ok(Nil)
    Error(error) -> Error(ProtocolError(error))
  }
}

fn handle_response(
  response: String,
  callback: fn(String) -> Result(b, protocol.ProtocolError),
) -> Result(b, SmtpError) {
  response
  |> callback()
  |> result.map_error(ProtocolError)
}

fn connect(options: ConnectOptions) -> Result(Connection, SmtpError) {
  case options.tls.mode {
    ImplicitTls -> {
      ssl_connect(
        options.hostname,
        options.port,
        options.tls.allow_invalid_certs,
        options.timeout_ms,
      )
      |> result.map(SslConnection(_, options.timeout_ms))
    }
    StartTls ->
      tcp_connect(options.hostname, options.port, options.timeout_ms)
      |> result.map(TcpConnection(_, options.timeout_ms))
  }
  |> result.map_error(ConnectionError)
}

fn disconnect(connection: Connection) -> Nil {
  case connection {
    TcpConnection(socket:, ..) -> tcp_close(socket)
    SslConnection(socket:, ..) -> ssl_close(socket)
  }
}

fn receive(connection: Connection) -> Result(String, SmtpError) {
  case connection {
    TcpConnection(socket:, timeout_ms:) -> tcp_receive(socket, timeout_ms)
    SslConnection(socket:, timeout_ms:) -> ssl_receive(socket, timeout_ms)
  }
  |> result.map_error(ConnectionError)
}

fn send(connection: Connection, command: String) -> Result(Nil, SmtpError) {
  case connection {
    TcpConnection(socket:, ..) -> tcp_send(socket, <<command:utf8>>)
    SslConnection(socket:, ..) -> ssl_send(socket, <<command:utf8>>)
  }
  |> result.map_error(ConnectionError)
}

fn upgrade(
  connection: Connection,
  options: ConnectOptions,
) -> Result(Connection, SmtpError) {
  case connection {
    TcpConnection(socket:, timeout_ms:) ->
      tcp_upgrade_to_tls(
        socket,
        options.hostname,
        options.tls.allow_invalid_certs,
        options.timeout_ms,
      )
      |> result.map(SslConnection(_, timeout_ms))
      |> result.map_error(ConnectionError)
    SslConnection(..) -> Ok(connection)
  }
}

@external(erlang, "sendr_smtp_ffi", "get_hostname")
fn get_hostname() -> String

@external(erlang, "sendr_smtp_ffi", "get_host_by_name")
fn get_host_by_name(hostname: String) -> Result(String, PosixError)

@external(erlang, "sendr_smtp_ffi", "upgrade")
fn tcp_upgrade_to_tls(
  socket: Socket,
  host: String,
  allow_invalid_certs: Bool,
  timeout: Int,
) -> Result(Socket, ConnectionError)

@external(erlang, "sendr_smtp_ffi", "tcp_connect")
fn tcp_connect(
  host: String,
  port: Int,
  timeout: Int,
) -> Result(Socket, ConnectionError)

@external(erlang, "sendr_smtp_ffi", "tcp_close")
fn tcp_close(socket: Socket) -> Nil

@external(erlang, "sendr_smtp_ffi", "tcp_receive")
fn tcp_receive(socket: Socket, timeout: Int) -> Result(String, ConnectionError)

@external(erlang, "sendr_smtp_ffi", "tcp_send")
fn tcp_send(socket: Socket, data: BitArray) -> Result(Nil, ConnectionError)

@external(erlang, "sendr_smtp_ffi", "ssl_connect")
fn ssl_connect(
  host: String,
  port: Int,
  allow_invalid_certs: Bool,
  timeout: Int,
) -> Result(Socket, ConnectionError)

@external(erlang, "sendr_smtp_ffi", "ssl_close")
fn ssl_close(socket: Socket) -> Nil

@external(erlang, "sendr_smtp_ffi", "ssl_receive")
fn ssl_receive(socket: Socket, timeout: Int) -> Result(String, ConnectionError)

@external(erlang, "sendr_smtp_ffi", "ssl_send")
fn ssl_send(socket: Socket, data: BitArray) -> Result(Nil, ConnectionError)