Add (optional) contact info in emails sent by the server

src/web/web_election.ml

@@ -51,7 +51,9 @@ module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct
 
       let send_confirmation_email user email hash =
         let title = E.election.e_params.e_name in
-        let x = (E.election.e_params.e_uuid, ()) in
+        let uuid = E.election.e_params.e_uuid in
+        let%lwt metadata = Web_persist.get_election_metadata uuid in
+        let x = (uuid, ()) in
         let url1 = Eliom_uri.make_string_uri ~absolute:true
           ~service:Web_services.election_pretty_ballots x |> rewrite_prefix
         in
@@ -61,7 +63,8 @@ module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct
         let%lwt language = Eliom_reference.get Web_state.language in
         let module L = (val Web_i18n.get_lang language) in
         let subject = Printf.sprintf L.mail_confirmation_subject title in
-        let body = Printf.sprintf L.mail_confirmation user title hash url1 url2 in
+        let contact = Web_templates.contact_footer metadata L.please_contact in
+        let body = Printf.sprintf L.mail_confirmation user title hash url1 url2 contact in
         send_email email subject body
 
       let do_cast rawballot (user, date) =

src/web/web_i18n_sig.mli

@@ -111,9 +111,10 @@ module type LocalizedStrings = sig
   val blank_vote : string
   val no_other_blank : string
   val mail_password_subject : (string -> 'f, 'b, 'c, 'e, 'e, 'f) format6
-  val mail_password : (string -> string -> string -> string -> 'f, 'b, 'c, 'e, 'e, 'f) format6
+  val mail_password : (string -> string -> string -> string -> string -> 'f, 'b, 'c, 'e, 'e, 'f) format6
   val mail_credential_subject : (string -> 'f, 'b, 'c, 'e, 'e, 'f) format6
-  val mail_credential : (string -> string -> string -> string -> 'f, 'b, 'c, 'e, 'e, 'f) format6
+  val mail_credential : (string -> string -> string -> string -> string -> 'f, 'b, 'c, 'e, 'e, 'f) format6
   val mail_confirmation_subject : (string -> 'f, 'b, 'c, 'e, 'e, 'f) format6
-  val mail_confirmation : (string -> string -> string -> string -> string -> 'f, 'b, 'c, 'e, 'e, 'f) format6
+  val mail_confirmation : (string -> string -> string -> string -> string -> string -> 'f, 'b, 'c, 'e, 'e, 'f) format6
+  val please_contact : string
 end

src/web/web_l10n_de.ml

@@ -131,7 +131,7 @@ Benutzername: %s
 Passwort: %s
 Website der Abstimmung: %s
 
-Sie können so oft abstimmen wie Sie wollen, nur die letzte Stimme zählt."
+Sie können so oft abstimmen wie Sie wollen, nur die letzte Stimme zählt.%s"
 
 
 let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
@@ -154,7 +154,7 @@ Benutzername: %s
 Wählernummer: %s
 Website der Abstimmung: %s
 
-Sie können so oft abstimmen wie Sie wollen, nur die letzte Stimme zählt."
+Sie können so oft abstimmen wie Sie wollen, nur die letzte Stimme zählt.%s"
 
 
 let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
@@ -178,6 +178,8 @@ Wahlurne befindet:
 
 Das Ergebnis wird auf der Website der Abstimmung veröffentlicht:
 
-  %s
+  %s%s
 
 -- \nBelenios"
+
+let please_contact = "To get more information, please contact:"

src/web/web_l10n_en.ml

@@ -131,7 +131,7 @@ Password: %s
 Page of the election: %s
 
 Note that you are allowed to vote several times.  Only the last vote
-counts."
+counts.%s"
 
 
 let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
@@ -154,7 +154,7 @@ Credential: %s
 Page of the election: %s
 
 Note that you are allowed to vote several times.  Only the last vote
-counts."
+counts.%s"
 
 
 let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
@@ -177,6 +177,8 @@ You can check its presence in the ballot box, accessible at
 
 Results will be published on the election page
 
-  %s
+  %s%s
 
 -- \nBelenios"
+
+let please_contact = "To get more information, please contact:"

src/web/web_l10n_fr.ml

@@ -132,7 +132,7 @@ Mot de passe : %s
 Page de l'élection : %s
 
 Notez que vous pouvez voter plusieurs fois. Seul le dernier vote est
-pris en compte."
+pris en compte.%s"
 
 
 let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
@@ -156,7 +156,7 @@ Code de vote : %s
 Page de l'élection : %s
 
 Notez que vous pouvez voter plusieurs fois. Seul le dernier vote est
-pris en compte."
+pris en compte.%s"
 
 
 let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
@@ -179,6 +179,8 @@ Vous pouvez vérifier sa présence dans l'urne, accessible au
 
 Les résultats seront publiés sur la page de l'élection
 
-  %s
+  %s%s
 
 -- \nBelenios"
+
+let please_contact = "Pour obtenir plus d'informations, veuillez contacter :"

src/web/web_l10n_it.ml

@@ -134,7 +134,7 @@ Password : %s
 Pagina dell'elezione : %s
 
 Si nota che lei può votare più volte. Ma soltanto l'ultimo voto è
-preso in considerazione."
+preso in considerazione.%s"
 
 
 let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
@@ -160,7 +160,7 @@ Codice di voto : %s
 Pagina dell'elezione : %s
 
 Si nota che lei può votare più volte. Ma soltanto l'ultimo voto è
-preso in considerazione."
+preso in considerazione.%s"
 
 
 let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
@@ -183,6 +183,8 @@ Può verificare la sua presenza nell'urna, accessibile su
 
 I risultati saranno pubblicati sulla pagina dell'elezione
 
-  %s
+  %s%s
 
 -- \nBelenios"
+
+let please_contact = "To get more information, please contact:"

src/web/web_l10n_ro.ml

@@ -132,7 +132,7 @@ Parola: %s
 Pagina alegerii: %s
 
 Rețineți că este posibil să votați de mai multe ori.
-Numai ultimul vot va fi luat în considerare."
+Numai ultimul vot va fi luat în considerare.%s"
 
 
 let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
@@ -156,7 +156,7 @@ Cod de votare: %s
 Pagina alegerii: %s
 
 Rețineți că este posibil să votați de mai multe ori.
-Numai ultimul vot va fi luat în considerare."
+Numai ultimul vot va fi luat în considerare.%s"
 
 
 let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
@@ -179,6 +179,8 @@ Puteți verifica prezența acestuia în urma de vot, accesibilă la
 
 Rezultatele vor fi publicate pe pagina de alegere
 
-  %s
+  %s%s
 
 -- \nBelenios"
+
+let please_contact = "To get more information, please contact:"

src/web/web_persist.ml

@@ -97,6 +97,7 @@ let empty_metadata = {
   e_cred_authority = None;
   e_trustees = None;
   e_languages = None;
+  e_contact = None;
 }
 
 let return_empty_metadata = return empty_metadata

src/web/web_serializable.atd

@@ -51,6 +51,7 @@ type metadata = {
   ?cred_authority : string option;
   ?trustees : string list option;
   ?languages : string list option;
+  ?contact : string option;
 } <ocaml field_prefix="e_">
 
 type election_dates = {

src/web/web_services.ml

@@ -40,6 +40,7 @@ let election_setup_questions = service ~path:["setup"; "questions"] ~get_params:
 let election_setup_questions_post = post_coservice ~fallback:election_setup_questions ~post_params:(string "questions") ()
 let election_setup_description = post_coservice ~fallback:election_setup ~post_params:(string "name" ** string "description") ()
 let election_setup_languages = post_coservice ~fallback:election_setup ~post_params:(string "languages") ()
+let election_setup_contact = post_coservice ~fallback:election_setup ~post_params:(string "contact") ()
 let election_setup_voters = service ~path:["setup"; "voters"] ~get_params:(uuid "uuid") ()
 let election_setup_voters_add = post_service ~fallback:election_setup_voters ~post_params:(string "voters") ()
 let election_setup_voters_remove = post_coservice ~fallback:election_setup_voters ~post_params:(string "voter") ()

src/web/web_site.ml

@@ -378,6 +378,7 @@ let create_new_election owner cred auth =
     e_cred_authority;
     e_trustees = None;
     e_languages = Some ["en"; "fr"];
+    e_contact = Some "Name <user@example.org>";
   } in
   let question = {
     q_answers = [| "Answer 1"; "Answer 2"; "Answer 3" |];
@@ -520,6 +521,19 @@ let () =
         )
     )
 
+let () =
+  Any.register ~service:election_setup_contact
+    (fun uuid contact ->
+      with_setup_election uuid (fun se ->
+          let contact = if contact = "" then None else Some contact in
+          se.se_metadata <- {
+              se.se_metadata with
+              e_contact = contact
+            };
+          redir_preapply election_setup uuid ()
+        )
+    )
+
 let () =
   Any.register ~service:election_setup_description
     (fun uuid (name, description) ->
@@ -532,14 +546,15 @@ let () =
         )
     )
 
-let generate_password langs title url id =
+let generate_password metadata langs title url id =
   let email, login = split_identity id in
   let%lwt salt = generate_token () in
   let%lwt password = generate_token () in
   let hashed = sha256_hex (salt ^ password) in
   let bodies = List.map (fun lang ->
     let module L = (val Web_i18n.get_lang lang) in
-    Printf.sprintf L.mail_password title login password url
+    let contact = T.contact_footer metadata L.please_contact in
+    Printf.sprintf L.mail_password title login password url contact
   ) langs in
   let body = PString.concat "\n\n----------\n\n" bodies in
   let body = body ^ "\n\n-- \nBelenios" in
@@ -565,7 +580,7 @@ let handle_password se uuid ~force voters =
         match id.sv_password with
         | Some _ when not force -> return_unit
         | None | Some _ ->
-           let%lwt x = generate_password langs title url id.sv_id in
+           let%lwt x = generate_password se.se_metadata langs title url id.sv_id in
            return (id.sv_password <- Some x)
       ) voters
   in
@@ -604,7 +619,7 @@ let () =
             (try%lwt
                let%lwt _ = Ocsipersist.find table user in
                let langs = get_languages metadata.e_languages in
-               let%lwt x = generate_password langs title url user in
+               let%lwt x = generate_password metadata langs title url user in
                Ocsipersist.add table user x >>
                  dump_passwords (!spool_dir / raw_string_of_uuid uuid) table >>
                  T.generic_page ~title:"Success" ~service
@@ -863,7 +878,8 @@ let () =
                   let langs = get_languages se.se_metadata.e_languages in
                   let bodies = List.map (fun lang ->
                                    let module L = (val Web_i18n.get_lang lang) in
-                                   Printf.sprintf L.mail_credential title login cred url
+                                   let contact = T.contact_footer se.se_metadata L.please_contact in
+                                   Printf.sprintf L.mail_credential title login cred url contact
                                  ) langs in
                   let body = PString.concat "\n\n----------\n\n" bodies in
                   let body = body ^ "\n\n-- \nBelenios" in

src/web/web_templates.ml

@@ -395,6 +395,33 @@ let election_setup uuid se () =
       form_description;
     ]
   in
+  let form_contact =
+    post_form ~service:election_setup_contact
+      (fun contact ->
+        [
+          div [
+              pcdata "Contact: ";
+              let value =
+                match se.se_metadata.e_contact with
+                | Some x -> x
+                | None -> ""
+              in
+              string_input ~name:contact ~input_type:`Text ~value ();
+            ];
+          div [
+              pcdata "(If non-empty, this will be added to emails sent by the server. This is free-form, but we suggest that you use \"Name <user@example.org>\".)";
+            ];
+          div [
+              string_input ~input_type:`Submit ~value:"Save changes" ();
+            ];
+        ]) uuid
+  in
+  let div_contact =
+    div [
+        h2 [pcdata "Contact"];
+        form_contact;
+      ]
+  in
   let has_credentials = match se.se_metadata.e_cred_authority with
     | None -> false
     | Some _ -> true
@@ -506,6 +533,8 @@ let election_setup uuid se () =
     hr ();
     div_languages;
     hr ();
+    div_contact;
+    hr ();
     div_questions;
     hr ();
     div_voters;
@@ -2420,3 +2449,8 @@ let booth uuid =
     ];
   ] in
   return @@ html ~a:[a_dir `Ltr; a_xml_lang L.lang] head body
+
+let contact_footer metadata please_contact =
+  match metadata.e_contact with
+  | None -> ""
+  | Some x -> Printf.sprintf "\n\n%s\n\n  %s" please_contact x

src/web/web_templates.mli

@@ -79,3 +79,5 @@ val login_dummy : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
 val login_password : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
 
 val booth : uuid -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
+
+val contact_footer : metadata -> string -> string