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 ...@@ -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 send_confirmation_email user email hash =
let title = E.election.e_params.e_name in 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 let url1 = Eliom_uri.make_string_uri ~absolute:true
~service:Web_services.election_pretty_ballots x |> rewrite_prefix ~service:Web_services.election_pretty_ballots x |> rewrite_prefix
in in
...@@ -61,7 +63,8 @@ module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct ...@@ -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%lwt language = Eliom_reference.get Web_state.language in
let module L = (val Web_i18n.get_lang language) in let module L = (val Web_i18n.get_lang language) in
let subject = Printf.sprintf L.mail_confirmation_subject title 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 send_email email subject body
let do_cast rawballot (user, date) = let do_cast rawballot (user, date) =
......
...@@ -111,9 +111,10 @@ module type LocalizedStrings = sig ...@@ -111,9 +111,10 @@ module type LocalizedStrings = sig
val blank_vote : string val blank_vote : string
val no_other_blank : string val no_other_blank : string
val mail_password_subject : (string -> 'f, 'b, 'c, 'e, 'e, 'f) format6 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_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_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 end
...@@ -131,7 +131,7 @@ Benutzername: %s ...@@ -131,7 +131,7 @@ Benutzername: %s
Passwort: %s Passwort: %s
Website der Abstimmung: %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 = let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
...@@ -154,7 +154,7 @@ Benutzername: %s ...@@ -154,7 +154,7 @@ Benutzername: %s
Wählernummer: %s Wählernummer: %s
Website der Abstimmung: %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 = let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
...@@ -178,6 +178,8 @@ Wahlurne befindet: ...@@ -178,6 +178,8 @@ Wahlurne befindet:
Das Ergebnis wird auf der Website der Abstimmung veröffentlicht: Das Ergebnis wird auf der Website der Abstimmung veröffentlicht:
%s %s%s
-- \nBelenios" -- \nBelenios"
let please_contact = "To get more information, please contact:"
...@@ -131,7 +131,7 @@ Password: %s ...@@ -131,7 +131,7 @@ Password: %s
Page of the election: %s Page of the election: %s
Note that you are allowed to vote several times. Only the last vote 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 = let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
...@@ -154,7 +154,7 @@ Credential: %s ...@@ -154,7 +154,7 @@ Credential: %s
Page of the election: %s Page of the election: %s
Note that you are allowed to vote several times. Only the last vote 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 = 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 ...@@ -177,6 +177,8 @@ You can check its presence in the ballot box, accessible at
Results will be published on the election page Results will be published on the election page
%s %s%s
-- \nBelenios" -- \nBelenios"
let please_contact = "To get more information, please contact:"
...@@ -132,7 +132,7 @@ Mot de passe : %s ...@@ -132,7 +132,7 @@ Mot de passe : %s
Page de l'élection : %s Page de l'élection : %s
Notez que vous pouvez voter plusieurs fois. Seul le dernier vote est 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 = let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
...@@ -156,7 +156,7 @@ Code de vote : %s ...@@ -156,7 +156,7 @@ Code de vote : %s
Page de l'élection : %s Page de l'élection : %s
Notez que vous pouvez voter plusieurs fois. Seul le dernier vote est 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 = 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 ...@@ -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 Les résultats seront publiés sur la page de l'élection
%s %s%s
-- \nBelenios" -- \nBelenios"
let please_contact = "Pour obtenir plus d'informations, veuillez contacter :"
...@@ -134,7 +134,7 @@ Password : %s ...@@ -134,7 +134,7 @@ Password : %s
Pagina dell'elezione : %s Pagina dell'elezione : %s
Si nota che lei può votare più volte. Ma soltanto l'ultimo voto è 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 = let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
...@@ -160,7 +160,7 @@ Codice di voto : %s ...@@ -160,7 +160,7 @@ Codice di voto : %s
Pagina dell'elezione : %s Pagina dell'elezione : %s
Si nota che lei può votare più volte. Ma soltanto l'ultimo voto è 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 = let mail_confirmation_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
...@@ -183,6 +183,8 @@ Può verificare la sua presenza nell'urna, accessibile su ...@@ -183,6 +183,8 @@ Può verificare la sua presenza nell'urna, accessibile su
I risultati saranno pubblicati sulla pagina dell'elezione I risultati saranno pubblicati sulla pagina dell'elezione
%s %s%s
-- \nBelenios" -- \nBelenios"
let please_contact = "To get more information, please contact:"
...@@ -132,7 +132,7 @@ Parola: %s ...@@ -132,7 +132,7 @@ Parola: %s
Pagina alegerii: %s Pagina alegerii: %s
Rețineți că este posibil să votați de mai multe ori. 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 = let mail_credential_subject : ('a, 'b, 'c, 'd, 'e, 'f) format6 =
...@@ -156,7 +156,7 @@ Cod de votare: %s ...@@ -156,7 +156,7 @@ Cod de votare: %s
Pagina alegerii: %s Pagina alegerii: %s
Rețineți că este posibil să votați de mai multe ori. 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 = 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 ...@@ -179,6 +179,8 @@ Puteți verifica prezența acestuia în urma de vot, accesibilă la
Rezultatele vor fi publicate pe pagina de alegere Rezultatele vor fi publicate pe pagina de alegere
%s %s%s
-- \nBelenios" -- \nBelenios"
let please_contact = "To get more information, please contact:"
...@@ -97,6 +97,7 @@ let empty_metadata = { ...@@ -97,6 +97,7 @@ let empty_metadata = {
e_cred_authority = None; e_cred_authority = None;
e_trustees = None; e_trustees = None;
e_languages = None; e_languages = None;
e_contact = None;
} }
let return_empty_metadata = return empty_metadata let return_empty_metadata = return empty_metadata
......
...@@ -51,6 +51,7 @@ type metadata = { ...@@ -51,6 +51,7 @@ type metadata = {
?cred_authority : string option; ?cred_authority : string option;
?trustees : string list option; ?trustees : string list option;
?languages : string list option; ?languages : string list option;
?contact : string option;
} <ocaml field_prefix="e_"> } <ocaml field_prefix="e_">
type election_dates = { type election_dates = {
......
...@@ -40,6 +40,7 @@ let election_setup_questions = service ~path:["setup"; "questions"] ~get_params: ...@@ -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_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_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_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 = 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_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") () 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 = ...@@ -378,6 +378,7 @@ let create_new_election owner cred auth =
e_cred_authority; e_cred_authority;
e_trustees = None; e_trustees = None;
e_languages = Some ["en"; "fr"]; e_languages = Some ["en"; "fr"];
e_contact = Some "Name <user@example.org>";
} in } in
let question = { let question = {
q_answers = [| "Answer 1"; "Answer 2"; "Answer 3" |]; q_answers = [| "Answer 1"; "Answer 2"; "Answer 3" |];
...@@ -520,6 +521,19 @@ let () = ...@@ -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 () = let () =
Any.register ~service:election_setup_description Any.register ~service:election_setup_description
(fun uuid (name, description) -> (fun uuid (name, description) ->
...@@ -532,14 +546,15 @@ let () = ...@@ -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 email, login = split_identity id in
let%lwt salt = generate_token () in let%lwt salt = generate_token () in
let%lwt password = generate_token () in let%lwt password = generate_token () in
let hashed = sha256_hex (salt ^ password) in let hashed = sha256_hex (salt ^ password) in
let bodies = List.map (fun lang -> let bodies = List.map (fun lang ->
let module L = (val Web_i18n.get_lang lang) in 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 ) langs in
let body = PString.concat "\n\n----------\n\n" bodies in let body = PString.concat "\n\n----------\n\n" bodies in
let body = body ^ "\n\n-- \nBelenios" in let body = body ^ "\n\n-- \nBelenios" in
...@@ -565,7 +580,7 @@ let handle_password se uuid ~force voters = ...@@ -565,7 +580,7 @@ let handle_password se uuid ~force voters =
match id.sv_password with match id.sv_password with
| Some _ when not force -> return_unit | Some _ when not force -> return_unit
| None | Some _ -> | 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) return (id.sv_password <- Some x)
) voters ) voters
in in
...@@ -604,7 +619,7 @@ let () = ...@@ -604,7 +619,7 @@ let () =
(try%lwt (try%lwt
let%lwt _ = Ocsipersist.find table user in let%lwt _ = Ocsipersist.find table user in
let langs = get_languages metadata.e_languages 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 >> Ocsipersist.add table user x >>
dump_passwords (!spool_dir / raw_string_of_uuid uuid) table >> dump_passwords (!spool_dir / raw_string_of_uuid uuid) table >>
T.generic_page ~title:"Success" ~service T.generic_page ~title:"Success" ~service
...@@ -863,7 +878,8 @@ let () = ...@@ -863,7 +878,8 @@ let () =
let langs = get_languages se.se_metadata.e_languages in let langs = get_languages se.se_metadata.e_languages in
let bodies = List.map (fun lang -> let bodies = List.map (fun lang ->
let module L = (val Web_i18n.get_lang lang) in 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 ) langs in
let body = PString.concat "\n\n----------\n\n" bodies in let body = PString.concat "\n\n----------\n\n" bodies in
let body = body ^ "\n\n-- \nBelenios" in let body = body ^ "\n\n-- \nBelenios" in
......
...@@ -395,6 +395,33 @@ let election_setup uuid se () = ...@@ -395,6 +395,33 @@ let election_setup uuid se () =
form_description; form_description;
] ]
in 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 let has_credentials = match se.se_metadata.e_cred_authority with
| None -> false | None -> false
| Some _ -> true | Some _ -> true
...@@ -506,6 +533,8 @@ let election_setup uuid se () = ...@@ -506,6 +533,8 @@ let election_setup uuid se () =
hr (); hr ();
div_languages; div_languages;
hr (); hr ();
div_contact;
hr ();
div_questions; div_questions;
hr (); hr ();
div_voters; div_voters;
...@@ -2420,3 +2449,8 @@ let booth uuid = ...@@ -2420,3 +2449,8 @@ let booth uuid =
]; ];
] in ] in
return @@ html ~a:[a_dir `Ltr; a_xml_lang L.lang] head body 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 ...@@ -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 login_password : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val booth : uuid -> [> `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