Source file contract_email.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
type t =
  { sender : string
  ; recipient : string
  ; subject : string
  ; text : string
  ; html : string option
  ; cc : string list
  ; bcc : string list
  }

let name = "email"

exception Exception of string

module type Sig = sig
  (** [inbox ()] returns the content of the development in-memory mailbox.
      Intercepted emails land here, they can be used during testing to make sure
      that certain emails were sent. *)
  val inbox : unit -> t list

  (** [clear_inbox ()] removes all the emails from the development in-memory
      mailbox. A subsequent call on `inbox ()` will return an empty list. *)
  val clear_inbox : unit -> unit

  (** [send ?ctx email] sends the email [email]. The returned Lwt.t fulfills if
      the underlying email transport acknowledges sending. In case of SMTP, this
      might take a while. *)
  val send : ?ctx:(string * string) list -> t -> unit Lwt.t

  (** [bulk_send ?ctx emails] Sends the list of emails [emails]. If sending of
      one of them fails, the returned Lwt.t fails. *)
  val bulk_send : ?ctx:(string * string) list -> t list -> unit Lwt.t

  val register : unit -> Core_container.Service.t

  include Core_container.Service.Sig
end

(* Common functions and combinators *)

let to_sexp { sender; recipient; subject; text; html; cc; bcc } =
  let open Sexplib0.Sexp_conv in
  let open Sexplib0.Sexp in
  let cc = List (List.cons (Atom "cc") (List.map sexp_of_string cc)) in
  let bcc = List (List.cons (Atom "bcc") (List.map sexp_of_string bcc)) in
  List
    [ List [ Atom "sender"; sexp_of_string sender ]
    ; List [ Atom "recipient"; sexp_of_string recipient ]
    ; List [ Atom "subject"; sexp_of_string subject ]
    ; List [ Atom "text"; sexp_of_string text ]
    ; List [ Atom "html"; sexp_of_option sexp_of_string html ]
    ; cc
    ; bcc
    ]
;;

let pp fmt t = Sexplib0.Sexp.pp_hum fmt (to_sexp t)

let of_yojson json =
  let open Yojson.Safe.Util in
  try
    let sender = json |> member "sender" |> to_string in
    let recipient = json |> member "recipient" |> to_string in
    let subject = json |> member "subject" |> to_string in
    let text = json |> member "text" |> to_string in
    let html = json |> member "html" |> to_string_option in
    let cc = json |> member "cc" |> to_list |> List.map to_string in
    let bcc = json |> member "bcc" |> to_list |> List.map to_string in
    Some { sender; recipient; subject; text; html; cc; bcc }
  with
  | _ -> None
;;

let to_yojson email =
  `Assoc
    [ "sender", `String email.sender
    ; "recipient", `String email.recipient
    ; "subject", `String email.subject
    ; "text", `String email.text
    ; ( "html"
      , match email.html with
        | Some html -> `String html
        | None -> `Null )
    ; "cc", `List (List.map (fun el -> `String el) email.cc)
    ; "bcc", `List (List.map (fun el -> `String el) email.bcc)
    ]
;;

let set_text text email = { email with text }
let set_html html email = { email with html }

let create ?html ?(cc = []) ?(bcc = []) ~sender ~recipient ~subject text =
  { sender; recipient; subject; html; text; cc; bcc }
;;