Commit 7cdfc4b8 authored by Stephane Glondu's avatar Stephane Glondu

An administrator can choose the languages of mails sent by the server

parent afa31b3b
......@@ -229,3 +229,14 @@ let split_identity x =
x, x
let langs = ["en"; "fr"; "de"]
let get_languages xs =
match xs with
| None -> langs
| Some xs -> xs
let string_of_languages xs =
String.concat " " (get_languages xs)
let languages_of_string x =
Some (Pcre.split x)
......@@ -104,4 +104,6 @@ val send_email : string -> string -> string -> unit Lwt.t
val split_identity : string -> string * string
val langs : string list
val get_languages : string list option -> string list
val string_of_languages : string list option -> string
val languages_of_string : string -> string list option
......@@ -101,6 +101,7 @@ let empty_metadata = {
e_auth_config = None;
e_cred_authority = None;
e_trustees = None;
e_languages = None;
}
let return_empty_metadata = return empty_metadata
......
......@@ -51,6 +51,7 @@ type metadata = {
?auth_config: auth_config list option;
?cred_authority : string option;
?trustees : string list option;
?languages : string list option;
} <ocaml field_prefix="e_">
type datadir_item = {
......
......@@ -40,6 +40,7 @@ let election_setup = service ~path:["setup"; "election"] ~get_params:(uuid "uuid
let election_setup_questions = service ~path:["setup"; "questions"] ~get_params:(uuid "uuid") ()
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_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") ()
......
......@@ -328,6 +328,7 @@ let create_new_election owner cred auth =
e_auth_config;
e_cred_authority;
e_trustees = None;
e_languages = None;
} in
let question = {
q_answers = [| "Answer 1"; "Answer 2"; "Blank" |];
......@@ -417,6 +418,17 @@ let handle_setup f uuid x =
let redir_preapply s u () = Redirection.send (preapply s u)
let () =
Any.register
~service:election_setup_languages
(handle_setup
(fun se languages _ uuid ->
se.se_metadata <- {
se.se_metadata with
e_languages = languages_of_string languages
};
return (redir_preapply election_setup uuid)))
let () =
Any.register
~service:election_setup_description
......@@ -448,6 +460,7 @@ let handle_password se uuid ~force voters =
let url = Eliom_uri.make_string_uri ~absolute:true ~service:election_home
(uuid, ()) |> rewrite_prefix
in
let langs = get_languages se.se_metadata.e_languages in
Lwt_list.iter_s (fun id ->
match id.sv_password with
| Some _ when not force -> return_unit
......@@ -494,6 +507,7 @@ let () =
let service = preapply election_admin (uuid, ()) in
begin 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
Ocsipersist.add table user x >>
dump_passwords (!spool_dir / uuid_s) table >>
......@@ -761,6 +775,7 @@ let () =
let y = G.(g **~ x) in
G.to_string y
in
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
......
......@@ -360,6 +360,29 @@ let election_setup_pre () =
let election_setup uuid se () =
let title = "Preparation of election " ^ se.se_questions.t_name in
let form_languages =
post_form ~service:election_setup_languages
(fun languages ->
[
div [
pcdata "Languages: ";
string_input ~name:languages ~input_type:`Text
~value:(string_of_languages se.se_metadata.e_languages) ();
];
div [
pcdata "(This is a space-separated list of languages that will be used in emails sent by the server.)";
];
div [
string_input ~input_type:`Submit ~value:"Save changes" ();
];
]) uuid
in
let div_languages =
div [
h2 [pcdata "Languages"];
form_languages;
]
in
let form_description =
post_form ~service:election_setup_description
(fun (name, description) ->
......@@ -481,6 +504,8 @@ let election_setup uuid se () =
let content = [
div_description;
hr ();
div_languages;
hr ();
div_questions;
hr ();
div_voters;
......@@ -1168,7 +1193,7 @@ let election_home w state () =
div ~a:[a_class ["languages"]]
(list_concat (pcdata " ") @@ List.map (fun lang ->
a ~service:set_language [pcdata lang] lang
) langs)
) (get_languages None))
in
let%lwt scd = Eliom_reference.get Web_state.show_cookie_disclaimer in
let cookie_disclaimer =
......
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