futur.blue
objective categorical abstract machine language personal data server
HTML emails
+1
dune-project
+1
dune-project
+1
pegasus.opam
+1
pegasus.opam
+2
-1
pegasus/lib/api/admin/sendEmail.ml
+2
-1
pegasus/lib/api/admin/sendEmail.ml
···
21
21
in
22
22
let%lwt () =
23
23
Util.send_email_or_log ~recipients:[To recipient.email] ~subject
24
-
~body:(Plain content)
24
+
~body:(Emails.AdminEmail.make ~sender_handle:sender.handle
25
+
~recipient_handle:recipient.handle ~subject ~content)
25
26
in
26
27
Dream.json @@ Yojson.Safe.to_string @@ output_to_yojson {sent= true}
27
28
) )
+1
-6
pegasus/lib/api/identity/requestPlcOperationSignature.ml
+1
-6
pegasus/lib/api/identity/requestPlcOperationSignature.ml
···
10
10
let%lwt () =
11
11
Util.send_email_or_log ~recipients:[To email]
12
12
~subject:"Confirm PLC operation"
13
-
~body:
14
-
(Plain
15
-
(Printf.sprintf
16
-
"Confirm that you would like to update your PLC identity for \
17
-
%s (%s) using the following token: %s"
18
-
handle did code ) )
13
+
~body:(Emails.PlcOperation.make ~handle ~did ~code)
19
14
in
20
15
Dream.empty `OK )
+1
-4
pegasus/lib/api/server/requestAccountDelete.ml
+1
-4
pegasus/lib/api/server/requestAccountDelete.ml
···
11
11
let%lwt () = Data_store.set_auth_code ~did ~code ~expires_at db in
12
12
Util.send_email_or_log ~recipients:[To actor.email]
13
13
~subject:(Printf.sprintf "Account deletion request for %s" actor.handle)
14
-
~body:
15
-
(Plain
16
-
(Printf.sprintf "Delete your account using the following token: %s"
17
-
code ) )
14
+
~body:(Emails.AccountDelete.make ~handle:actor.handle ~code)
18
15
19
16
let calc_key_did ctx = Some (Auth.get_authed_did_exn ctx.Xrpc.auth)
20
17
+1
-5
pegasus/lib/api/server/requestEmailConfirmation.ml
+1
-5
pegasus/lib/api/server/requestEmailConfirmation.ml
···
13
13
let%lwt () =
14
14
Util.send_email_or_log ~recipients:[To actor.email]
15
15
~subject:(Printf.sprintf "Confirm email for %s" actor.handle)
16
-
~body:
17
-
(Plain
18
-
(Printf.sprintf
19
-
"Confirm your email address using the following token: %s"
20
-
code ) )
16
+
~body:(Emails.EmailConfirmation.make ~handle:actor.handle ~code)
21
17
in
22
18
Lwt.return_ok ()
23
19
+1
-7
pegasus/lib/api/server/requestEmailUpdate.ml
+1
-7
pegasus/lib/api/server/requestEmailUpdate.ml
···
28
28
in
29
29
Util.send_email_or_log ~recipients:[To to_email]
30
30
~subject:(Printf.sprintf "Confirm email change for %s" actor.handle)
31
-
~body:
32
-
(Plain
33
-
(Printf.sprintf
34
-
"Confirm that you would like to change your email address%s \
35
-
using the following token: %s"
36
-
(match pending_email with Some e -> " to " ^ e | None -> "")
37
-
code ) )
31
+
~body:(Emails.EmailUpdate.make ~handle:actor.handle ~new_email:pending_email ~code)
38
32
else Lwt.return_unit
39
33
in
40
34
Lwt.return token_required
+1
-4
pegasus/lib/api/server/requestPasswordReset.ml
+1
-4
pegasus/lib/api/server/requestPasswordReset.ml
···
13
13
let%lwt () = Data_store.set_auth_code ~did ~code ~expires_at db in
14
14
Util.send_email_or_log ~recipients:[To actor.email]
15
15
~subject:(Printf.sprintf "Password reset for %s" actor.handle)
16
-
~body:
17
-
(Plain
18
-
(Printf.sprintf "Reset your password using the following token: %s"
19
-
code ) )
16
+
~body:(Emails.PasswordReset.make ~handle:actor.handle ~code)
20
17
21
18
let handler =
22
19
Xrpc.handler
+2
-1
pegasus/lib/dune
+2
-1
pegasus/lib/dune
···
14
14
emile
15
15
frontend
16
16
hermes
17
+
html_of_jsx
17
18
ipld
18
19
kleidos
19
20
letters
···
32
33
ppx_deriving_yojson.runtime
33
34
ppx_rapper_lwt)
34
35
(preprocess
35
-
(pps hermes_ppx lwt_ppx ppx_deriving_yojson ppx_rapper)))
36
+
(pps hermes_ppx html_of_jsx.ppx lwt_ppx ppx_deriving_yojson ppx_rapper)))
36
37
37
38
(include_subdirs qualified)
+45
pegasus/lib/emails/accountDelete.mlx
+45
pegasus/lib/emails/accountDelete.mlx
···
1
+
open EmailStyles
2
+
3
+
let html_body ~handle ~code : JSX.element =
4
+
<div>
5
+
<p style=Styles.paragraph>(JSX.string ("Hello, " ^ handle ^ "!"))</p>
6
+
<p style=Styles.paragraph>
7
+
(JSX.string
8
+
"You have requested to delete your account. Use the token below to \
9
+
confirm this action:" )
10
+
</p>
11
+
<div style=Styles.code_block>(JSX.string code)</div>
12
+
<p style=Styles.small_text>
13
+
(JSX.string "This token will expire in 15 minutes.")
14
+
</p>
15
+
<p style=Styles.small_text>
16
+
(JSX.string
17
+
"If you didn't request account deletion, you should update your \
18
+
account credentials." )
19
+
</p>
20
+
</div>
21
+
22
+
let plain_text ~handle ~code : string =
23
+
Printf.sprintf
24
+
"Hello, %s!\n\n\
25
+
You have requested to delete your account. Use the token below to confirm \
26
+
this action:\n\n\
27
+
%s\n\n\
28
+
This token will expire in 15 minutes.\n\n\
29
+
If you didn't request account deletion, you should update your account \
30
+
credentials."
31
+
handle code
32
+
33
+
let make ~handle ~code : Letters.body =
34
+
let html_content = html_body ~handle ~code in
35
+
let template_content =
36
+
EmailTemplate.
37
+
{ title= "Account deletion request for " ^ handle
38
+
; heading= "account deletion request"
39
+
; body= html_content
40
+
; footer= Some ("This is an automated message from " ^ Env.hostname ^ ".")
41
+
}
42
+
in
43
+
let html = EmailTemplate.make ~content:template_content () |> JSX.render in
44
+
let plain = plain_text ~handle ~code in
45
+
Mixed (plain, html, None)
+26
pegasus/lib/emails/adminEmail.mlx
+26
pegasus/lib/emails/adminEmail.mlx
···
1
+
open EmailStyles
2
+
3
+
let html_body ~recipient_handle ~content : JSX.element =
4
+
<div>
5
+
<p style=Styles.paragraph>
6
+
(JSX.string ("Hello, " ^ recipient_handle ^ "!"))
7
+
</p>
8
+
<p style=Styles.paragraph>(JSX.string content)</p>
9
+
</div>
10
+
11
+
let plain_text ~recipient_handle ~content : string =
12
+
Printf.sprintf "Hello, %s!\n\n%s" recipient_handle content
13
+
14
+
let make ~sender_handle ~recipient_handle ~subject ~content : Letters.body =
15
+
let html_content = html_body ~recipient_handle ~content in
16
+
let template_content =
17
+
EmailTemplate.
18
+
{ title= subject
19
+
; heading= subject
20
+
; body= html_content
21
+
; footer= Some ("Sent by @" ^ sender_handle ^ " via " ^ Env.hostname ^ ".")
22
+
}
23
+
in
24
+
let html = EmailTemplate.make ~content:template_content () |> JSX.render in
25
+
let plain = plain_text ~recipient_handle ~content in
26
+
Mixed (plain, html, None)
+45
pegasus/lib/emails/emailConfirmation.mlx
+45
pegasus/lib/emails/emailConfirmation.mlx
···
1
+
open EmailStyles
2
+
3
+
let html_body ~handle ~code : JSX.element =
4
+
<div>
5
+
<p style=Styles.paragraph>
6
+
(JSX.string "Hello, ")
7
+
<span style=Styles.link>(JSX.string handle)</span>
8
+
(JSX.string "!")
9
+
</p>
10
+
<p style=Styles.paragraph>
11
+
(JSX.string "Please confirm your email address using the token below:")
12
+
</p>
13
+
<div style=Styles.code_block>(JSX.string code)</div>
14
+
<p style=Styles.small_text>
15
+
(JSX.string "This token will expire in 10 minutes.")
16
+
</p>
17
+
<p style=Styles.small_text>
18
+
(JSX.string
19
+
"If you didn't request this email confirmation, you can ignore this \
20
+
email." )
21
+
</p>
22
+
</div>
23
+
24
+
let plain_text ~handle ~code : string =
25
+
Printf.sprintf
26
+
"Hello, %s!\n\n\
27
+
Please confirm your email address using the token below:\n\n\
28
+
%s\n\n\
29
+
This token will expire in 10 minutes.\n\n\
30
+
If you didn't request this email confirmation, you can ignore this email."
31
+
handle code
32
+
33
+
let make ~handle ~code : Letters.body =
34
+
let html_content = html_body ~handle ~code in
35
+
let template_content =
36
+
EmailTemplate.
37
+
{ title= "Confirm email for " ^ handle
38
+
; heading= "confirm email"
39
+
; body= html_content
40
+
; footer= Some ("This is an automated message from " ^ Env.hostname ^ ".")
41
+
}
42
+
in
43
+
let html = EmailTemplate.make ~content:template_content () |> JSX.render in
44
+
let plain = plain_text ~handle ~code in
45
+
Mixed (plain, html, None)
+52
pegasus/lib/emails/emailStyles.mlx
+52
pegasus/lib/emails/emailStyles.mlx
···
1
+
module Colors = struct
2
+
let white = "#ffffff"
3
+
4
+
let feather_100 = "#c8cfd2"
5
+
6
+
let mana_40 = "#9b9eaa"
7
+
8
+
let mana_100 = "#6558a1"
9
+
10
+
let mana_200 = "#312b4d"
11
+
12
+
let mist_20 = "#ecedf8"
13
+
14
+
let mist_40 = "#dee1e3"
15
+
16
+
let mist_60 = "#a4a9ac"
17
+
18
+
let mist_80 = "#737579"
19
+
20
+
let mist_100 = "#4f4f53"
21
+
end
22
+
23
+
module Fonts = struct
24
+
let sans =
25
+
"-apple-system, BlinkMacSystemFont, 'Roboto', 'Oxygen', 'Ubuntu', \
26
+
'Cantarell', 'Fira Sans', 'Droid Sans', 'Helvetica Neue', sans-serif"
27
+
28
+
let serif = "Georgia, 'Times New Roman', Times, serif"
29
+
30
+
let mono = "monospace"
31
+
end
32
+
33
+
module Styles = struct
34
+
let paragraph =
35
+
"margin: 0 0 16px 0; color: " ^ Colors.mist_100
36
+
^ "; font-size: 16px; line-height: 1.6; letter-spacing: 0.01em; \
37
+
font-family: " ^ Fonts.sans ^ ";"
38
+
39
+
let code_block =
40
+
"background-color: " ^ Colors.mist_20 ^ "; border: 1px solid "
41
+
^ Colors.mist_40
42
+
^ "; border-radius: 4px; padding: 16px 20px; margin: 24px 0; font-family: "
43
+
^ Fonts.mono ^ "; font-size: 18px; color: " ^ Colors.mana_200
44
+
^ "; text-align: center; letter-spacing: 0.05em; font-weight: bold;"
45
+
46
+
let link =
47
+
"color: " ^ Colors.mana_100 ^ "; text-decoration: none; font-weight: 500;"
48
+
49
+
let small_text =
50
+
"margin: 0 0 12px 0; font-size: 14px; color: " ^ Colors.mist_80
51
+
^ "; line-height: 1.5; font-family: " ^ Fonts.sans ^ ";"
52
+
end
+69
pegasus/lib/emails/emailTemplate.mlx
+69
pegasus/lib/emails/emailTemplate.mlx
···
1
+
open EmailStyles
2
+
3
+
type email_content =
4
+
{title: string; heading: string; body: JSX.element; footer: string option}
5
+
6
+
let make ~content () : JSX.element =
7
+
<html>
8
+
<head>
9
+
<meta charset="utf-8" />
10
+
<meta name="viewport" content="width=device-width, initial-scale=1.0" />
11
+
<title>(JSX.string content.title)</title>
12
+
</head>
13
+
<body
14
+
style=( "margin: 0; padding: 0; background-color: " ^ Colors.feather_100
15
+
^ "; font-family: " ^ Fonts.sans ^ ";" )>
16
+
<table
17
+
role="presentation"
18
+
cellspacing="0"
19
+
cellpadding="0"
20
+
width="100%"
21
+
style=("background-color: " ^ Colors.feather_100 ^ ";")>
22
+
<tr>
23
+
<td style="padding: 40px 20px;">
24
+
<table
25
+
role="presentation"
26
+
cellspacing="0"
27
+
cellpadding="0"
28
+
width="600"
29
+
style=( "margin: 0 auto; background-color: " ^ Colors.white
30
+
^ "; border-radius: 8px; box-shadow: 0 2px 8px rgba(49, \
31
+
43, 77, 0.1);" )>
32
+
<tr>
33
+
<td
34
+
style=( "padding: 32px 40px; background-color: "
35
+
^ Colors.mana_100 ^ "; border-radius: 8px 8px 0 0;" )>
36
+
<h1
37
+
style=( "margin: 0; color: " ^ Colors.white
38
+
^ "; font-size: 24px; font-weight: normal; \
39
+
letter-spacing: 0.01em; font-family: "
40
+
^ Fonts.serif ^ ";" )>
41
+
(JSX.string content.heading)
42
+
</h1>
43
+
</td>
44
+
</tr>
45
+
<tr><td style="padding: 40px;">content.body</td></tr>
46
+
( match content.footer with
47
+
| Some footer_text ->
48
+
<tr>
49
+
<td
50
+
style=( "padding: 24px 40px; border-top: 1px solid "
51
+
^ Colors.mist_40 ^ "; background-color: "
52
+
^ Colors.mist_20 ^ "; border-radius: 0 0 8px 8px;"
53
+
)>
54
+
<p
55
+
style=( "margin: 0; color: " ^ Colors.mist_80
56
+
^ "; font-size: 13px; line-height: 1.5; \
57
+
font-family: " ^ Fonts.sans ^ ";" )>
58
+
(JSX.string footer_text)
59
+
</p>
60
+
</td>
61
+
</tr>
62
+
| None ->
63
+
JSX.null )
64
+
</table>
65
+
</td>
66
+
</tr>
67
+
</table>
68
+
</body>
69
+
</html>
+58
pegasus/lib/emails/emailUpdate.mlx
+58
pegasus/lib/emails/emailUpdate.mlx
···
1
+
open EmailStyles
2
+
3
+
let html_body ~handle ~new_email ~code : JSX.element =
4
+
let destination_text =
5
+
match new_email with
6
+
| Some email ->
7
+
<span style=Styles.link>(JSX.string (" to " ^ email))</span>
8
+
| None ->
9
+
JSX.string ""
10
+
in
11
+
<div>
12
+
<p style=Styles.paragraph>
13
+
(JSX.string "Hello, ")
14
+
<span style=Styles.link>(JSX.string handle)</span>
15
+
(JSX.string "!")
16
+
</p>
17
+
<p style=Styles.paragraph>
18
+
(JSX.string
19
+
"Please confirm that you would like to change your email address" )
20
+
destination_text
21
+
(JSX.string " using the token below:")
22
+
</p>
23
+
<div style=Styles.code_block>(JSX.string code)</div>
24
+
<p style=Styles.small_text>
25
+
(JSX.string "This token will expire in 10 minutes.")
26
+
</p>
27
+
<p style=Styles.small_text>
28
+
(JSX.string
29
+
"If you didn't request this email change, you can ignore this email." )
30
+
</p>
31
+
</div>
32
+
33
+
let plain_text ~handle ~new_email ~code : string =
34
+
let destination_text =
35
+
match new_email with Some email -> " to " ^ email | None -> ""
36
+
in
37
+
Printf.sprintf
38
+
"Hello, %s!\n\n\
39
+
Please confirm that you would like to change your email address%s using \
40
+
the token below:\n\n\
41
+
%s\n\n\
42
+
This token will expire in 10 minutes.\n\n\
43
+
If you didn't request this email change, you can ignore this email."
44
+
handle destination_text code
45
+
46
+
let make ~handle ~new_email ~code : Letters.body =
47
+
let html_content = html_body ~handle ~new_email ~code in
48
+
let template_content =
49
+
EmailTemplate.
50
+
{ title= "Confirm email change for " ^ handle
51
+
; heading= "confirm email change"
52
+
; body= html_content
53
+
; footer= Some ("This is an automated message from " ^ Env.hostname ^ ".")
54
+
}
55
+
in
56
+
let html = EmailTemplate.make ~content:template_content () |> JSX.render in
57
+
let plain = plain_text ~handle ~new_email ~code in
58
+
Mixed (plain, html, None)
+47
pegasus/lib/emails/passwordReset.mlx
+47
pegasus/lib/emails/passwordReset.mlx
···
1
+
open EmailStyles
2
+
3
+
let html_body ~handle ~code : JSX.element =
4
+
<div>
5
+
<p style=Styles.paragraph>
6
+
(JSX.string "Hello, ")
7
+
<span style=Styles.link>(JSX.string handle)</span>
8
+
(JSX.string "!")
9
+
</p>
10
+
<p style=Styles.paragraph>
11
+
(JSX.string
12
+
"You requested a password reset for your account. Use the token below \
13
+
to reset your password:" )
14
+
</p>
15
+
<div style=Styles.code_block>(JSX.string code)</div>
16
+
<p style=Styles.small_text>
17
+
(JSX.string "This token will expire in 10 minutes.")
18
+
</p>
19
+
<p style=Styles.small_text>
20
+
(JSX.string
21
+
"If you didn't request this password reset, you can ignore this email." )
22
+
</p>
23
+
</div>
24
+
25
+
let plain_text ~handle ~code : string =
26
+
Printf.sprintf
27
+
"Hello, %s!\n\n\
28
+
You requested a password reset for your account. Use the token below to \
29
+
reset your password:\n\n\
30
+
%s\n\n\
31
+
This token will expire in 10 minutes.\n\n\
32
+
If you didn't request this password reset, you can ignore this email."
33
+
handle code
34
+
35
+
let make ~handle ~code : Letters.body =
36
+
let html_content = html_body ~handle ~code in
37
+
let template_content =
38
+
EmailTemplate.
39
+
{ title= "Password reset for " ^ handle
40
+
; heading= "password reset"
41
+
; body= html_content
42
+
; footer= Some ("This is an automated message from " ^ Env.hostname ^ ".")
43
+
}
44
+
in
45
+
let html = EmailTemplate.make ~content:template_content () |> JSX.render in
46
+
let plain = plain_text ~handle ~code in
47
+
Mixed (plain, html, None)
+45
pegasus/lib/emails/plcOperation.mlx
+45
pegasus/lib/emails/plcOperation.mlx
···
1
+
open EmailStyles
2
+
3
+
let html_body ~handle ~did ~code : JSX.element =
4
+
<div>
5
+
<p style=Styles.paragraph>
6
+
(JSX.string
7
+
"Use the following code to confirm that you would like to update your \
8
+
identity for:" )
9
+
</p>
10
+
<p style=Styles.link>(JSX.string (handle ^ " (" ^ did ^ ")"))</p>
11
+
<div style=Styles.code_block>(JSX.string code)</div>
12
+
<p style=Styles.small_text>
13
+
(JSX.string "This token will expire in 1 hour.")
14
+
</p>
15
+
<p style=Styles.small_text>
16
+
(JSX.string
17
+
"If you didn't request this operation, you can safely ignore this \
18
+
email." )
19
+
</p>
20
+
</div>
21
+
22
+
let plain_text ~handle ~did ~code : string =
23
+
Printf.sprintf
24
+
"Use the following code to confirm that you would like to update your \
25
+
identity for:\n\n\
26
+
%s (%s)\n\n\
27
+
%s\n\n\
28
+
This token will expire in 1 hour.\n\n\
29
+
If you didn't request this operation, you can safely ignore this email."
30
+
handle did code
31
+
32
+
(* Generate complete email body *)
33
+
let make ~handle ~did ~code : Letters.body =
34
+
let html_content = html_body ~handle ~did ~code in
35
+
let template_content =
36
+
EmailTemplate.
37
+
{ title= "Confirm PLC operation"
38
+
; heading= "confirm plc operation"
39
+
; body= html_content
40
+
; footer= Some ("This is an automated message from " ^ Env.hostname ^ ".")
41
+
}
42
+
in
43
+
let html = EmailTemplate.make ~content:template_content () |> JSX.render in
44
+
let plain = plain_text ~handle ~did ~code in
45
+
Mixed (plain, html, None)