Attention une mise à jour du serveur va être effectuée le vendredi 16 avril entre 12h et 12h30. Cette mise à jour va générer une interruption du service de quelques minutes.

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