Commit 1f5176c7 authored by Stephane Glondu's avatar Stephane Glondu

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

parent ce187d25
......@@ -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) =
......
......@@ -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
......@@ -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:"
......@@ -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:"
......@@ -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 :"
......@@ -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:"
......@@ -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:"
......@@ -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
......
......@@ -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 = {
......
......@@ -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") ()
......
......@@ -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
......
......@@ -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
......@@ -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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment