Commit dab2e349 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Refactor Templates

parent 81f62d9a
......@@ -132,7 +132,7 @@ module Make (N : CONFIG) = struct
| None ->
match !auth_instance_names with
| [name] -> use name
| _ -> T.generic_login () >>= Eliom_registration.Html5.send
| _ -> T.Auth.login_choose () >>= Eliom_registration.Html5.send
)
let () = Eliom_registration.Redirection.register
......
......@@ -61,7 +61,7 @@ module Make (N : NAME) (S : CONT_SERVICE) (T : TEMPLATES) : AUTH_INSTANCE = stru
lwt on_success = Eliom_reference.get on_success_ref in
on_success ~user_name ~user_logout >>
S.cont ())
in T.dummy_login ~service
in T.Auth.login_dummy ~service
)
let handler ~on_success () =
......
......@@ -84,7 +84,7 @@ module Make (C : CONFIG) (N : NAME) (S : CONT_SERVICE) (T : TEMPLATES) : AUTH_IN
on_success ~user_name ~user_logout >>
S.cont ()
) else forbidden ())
in T.password_login ~service
in T.Auth.login_password ~service
)
let handler ~on_success () =
......
......@@ -256,7 +256,7 @@ module SSite = struct
(fun () () ->
Eliom_reference.unset saved_service >>
lwt featured = get_featured_elections () in
T.index ~featured
T.Site.home ~featured
)
| Some uuid ->
Redirection.register ~service:home
......@@ -302,7 +302,7 @@ module SSite = struct
lwt election = get_election_by_uuid uuid in
let module X = (val election : WEB_ELECTION) in
if X.metadata.e_owner = Some u.user_user then (
T.election_update_credential ~election
T.Election.update_credential ~election
) else (
forbidden ()
)
......@@ -411,7 +411,7 @@ module SElection = struct
| _ -> forbidden ()
let f_index uuid election user () =
T.election_view ~election ~user
T.Election.home ~election ~user
let handle_pseudo_file u f =
let open Eliom_registration in
......@@ -518,7 +518,7 @@ module SVoting = struct
with Error e -> return (`Error e)
in
Eliom_reference.unset ballot >>
T.do_cast_ballot ~election ~result
T.Election.cast_confirmed ~election ~result
) else forbidden ()
| None -> forbidden ()
end
......@@ -535,7 +535,7 @@ module SVoting = struct
in service
in
let can_vote = can_vote X.metadata user in
T.ballot_received ~election ~confirm ~user ~can_vote
T.Election.cast_confirmation ~election ~confirm ~user ~can_vote
let () = Html5.register
~service:election_cast
......@@ -546,7 +546,7 @@ module SVoting = struct
Eliom_reference.set S.saved_service x >>
match_lwt Eliom_reference.get ballot with
| Some _ -> ballot_received uuid election user
| None -> T.election_cast_raw ~election
| None -> T.Election.cast_raw ~election
)
)
......
......@@ -100,82 +100,90 @@ module Make (S : ALL_SERVICES) : TEMPLATES = struct
p [pcdata e.e_description];
]
let index ~featured =
let featured_box = match featured with
| _::_ ->
div [
h2 [pcdata "Current featured elections"];
ul (List.map format_one_featured_election featured);
]
| [] ->
div [
pcdata "No featured elections at the moment.";
]
in
let content = [
h1 [pcdata site_title];
div [
pcdata welcome_message;
featured_box;
];
] in
base ~title:site_title ~content
module Site = struct
let dummy_login ~service =
let title, field_name, input_type =
"Dummy login", "Username:", `Text
in
let form = post_form ~service
(fun name ->
[
tablex [tbody [
tr [
th [label ~a:[a_for name] [pcdata field_name]];
td [string_input ~a:[a_maxlength 50] ~input_type ~name ()];
]]
];
let home ~featured =
let featured_box = match featured with
| _::_ ->
div [
string_input ~input_type:`Submit ~value:"Login" ();
h2 [pcdata "Current featured elections"];
ul (List.map format_one_featured_election featured);
]
]) ()
in
let content = [
h1 [pcdata title];
form;
] in
base ~title ~content
let password_login ~service =
let form = post_form ~service
(fun (llogin, lpassword) ->
[
tablex [tbody [
tr [
th [label ~a:[a_for llogin] [pcdata "Username:"]];
td [string_input ~a:[a_maxlength 50] ~input_type:`Text ~name:llogin ()];
];
tr [
th [label ~a:[a_for lpassword] [pcdata "Password:"]];
td [string_input ~a:[a_maxlength 50] ~input_type:`Password ~name:lpassword ()];
];
]];
| [] ->
div [
string_input ~input_type:`Submit ~value:"Login" ();
pcdata "No featured elections at the moment.";
]
]) ()
in
let content = [
h1 [pcdata "Password login"];
form;
] in
base ~title:"Password login" ~content
in
let content = [
h1 [pcdata site_title];
div [
pcdata welcome_message;
featured_box;
];
] in
base ~title:site_title ~content
end
let generic_login () =
let content = [
h1 [pcdata "Log in"];
div [p [pcdata "Please choose one authentication system."]];
] in
base ~title:"Log in" ~content
module Auth = struct
let login_dummy ~service =
let title, field_name, input_type =
"Dummy login", "Username:", `Text
in
let form = post_form ~service
(fun name ->
[
tablex [tbody [
tr [
th [label ~a:[a_for name] [pcdata field_name]];
td [string_input ~a:[a_maxlength 50] ~input_type ~name ()];
]]
];
div [
string_input ~input_type:`Submit ~value:"Login" ();
]
]) ()
in
let content = [
h1 [pcdata title];
form;
] in
base ~title ~content
let login_password ~service =
let form = post_form ~service
(fun (llogin, lpassword) ->
[
tablex [tbody [
tr [
th [label ~a:[a_for llogin] [pcdata "Username:"]];
td [string_input ~a:[a_maxlength 50] ~input_type:`Text ~name:llogin ()];
];
tr [
th [label ~a:[a_for lpassword] [pcdata "Password:"]];
td [string_input ~a:[a_maxlength 50] ~input_type:`Password ~name:lpassword ()];
];
]];
div [
string_input ~input_type:`Submit ~value:"Login" ();
]
]) ()
in
let content = [
h1 [pcdata "Password login"];
form;
] in
base ~title:"Password login" ~content
let login_choose () =
let content = [
h1 [pcdata "Log in"];
div [p [pcdata "Please choose one authentication system."]];
] in
base ~title:"Log in" ~content
end
let format_date (date, _) =
CalendarLib.Printer.Precise_Fcalendar.sprint "%a, %d %b %Y %T %z" date
......@@ -187,237 +195,243 @@ module Make (S : ALL_SERVICES) : TEMPLATES = struct
uri
contents
let election_view ~election ~user =
let module X = (val election : WEB_ELECTION) in
let params = X.election.e_params and m = X.metadata in
let service = S.election_file params ESRaw in
lwt permissions =
match user with
| None ->
Lwt.return [
pcdata "Log in to check if you can vote. ";
pcdata "Alternatively, you can try to vote and ";
pcdata "log in at the last moment.";
]
| Some u ->
let can = if check_acl m.e_voters u.user_user then "can" else "cannot" in
Lwt.return [
pcdata "You ";
pcdata can;
pcdata " vote in this election.";
]
in
let voting_period =
match m.e_voting_starts_at, m.e_voting_ends_at with
| None, None ->
[
pcdata "This election starts and ends at the administrator's discretion."
]
| Some s, None ->
[
pcdata "This election starts on ";
em [pcdata (format_date s)];
pcdata " and ends at the administrator's discretion.";
]
| None, Some s ->
[
pcdata "This election starts at the administrator's discretion and ends on ";
em [pcdata (format_date s)];
pcdata ".";
]
| Some s, Some e ->
[
pcdata "This election starts on ";
em [pcdata (format_date s)];
pcdata " and ends on ";
em [pcdata (format_date e)];
pcdata ".";
]
in
let audit_info = div [
h3 [pcdata "Audit Info"];
div [
div [
pcdata "Election fingerprint: ";
code [ pcdata X.election.e_fingerprint ];
];
div [
pcdata "Election data: ";
a ~service [ pcdata "parameters" ] ();
pcdata ", ";
a ~service:(S.election_file params ESCreds) [
pcdata "public credentials"
] ();
pcdata ", ";
a ~service:(S.election_file params ESKeys) [
pcdata "trustee public keys"
] ();
pcdata ", ";
a ~service:(S.election_file params ESBallots) [
pcdata "ballots";
] ();
pcdata ".";
];
]
] in
let content = [
h1 [ pcdata params.e_name ];
p ~a:[a_style "margin: 1em; padding: 2pt; font-style: italic; border: 1pt solid;"] [
pcdata params.e_description
];
p voting_period;
p permissions;
div [
div [
make_button
~service:(Eliom_service.preapply S.election_vote params.e_uuid)
"Go to the booth";
pcdata " or ";
make_button
~service:(Eliom_service.preapply S.election_cast params.e_uuid)
"Submit a raw ballot";
];
];
br ();
audit_info;
] in
base ~title:params.e_name ~content
module Election = struct
let election_cast_raw ~election =
let module X = (val election : WEB_ELECTION) in
let params = X.election.e_params in
let form_rawballot = post_form ~service:S.election_cast_post
(fun (name, _) ->
[
div [pcdata "Please paste your raw ballot in JSON format in the following box:"];
div [textarea ~a:[a_rows 10; a_cols 40] ~name ()];
div [string_input ~input_type:`Submit ~value:"Submit" ()];
]
) params.e_uuid
in
let form_upload = post_form ~service:S.election_cast_post
(fun (_, name) ->
[
div [pcdata "Alternatively, you can also upload a file containing your ballot:"];
let home ~election ~user =
let module X = (val election : WEB_ELECTION) in
let params = X.election.e_params and m = X.metadata in
let service = S.election_file params ESRaw in
lwt permissions =
match user with
| None ->
Lwt.return [
pcdata "Log in to check if you can vote. ";
pcdata "Alternatively, you can try to vote and ";
pcdata "log in at the last moment.";
]
| Some u ->
let can = if check_acl m.e_voters u.user_user then "can" else "cannot" in
Lwt.return [
pcdata "You ";
pcdata can;
pcdata " vote in this election.";
]
in
let voting_period =
match m.e_voting_starts_at, m.e_voting_ends_at with
| None, None ->
[
pcdata "This election starts and ends at the administrator's discretion."
]
| Some s, None ->
[
pcdata "This election starts on ";
em [pcdata (format_date s)];
pcdata " and ends at the administrator's discretion.";
]
| None, Some s ->
[
pcdata "This election starts at the administrator's discretion and ends on ";
em [pcdata (format_date s)];
pcdata ".";
]
| Some s, Some e ->
[
pcdata "This election starts on ";
em [pcdata (format_date s)];
pcdata " and ends on ";
em [pcdata (format_date e)];
pcdata ".";
]
in
let audit_info = div [
h3 [pcdata "Audit Info"];
div [
div [
pcdata "File: ";
file_input ~name ();
pcdata "Election fingerprint: ";
code [ pcdata X.election.e_fingerprint ];
];
div [string_input ~input_type:`Submit ~value:"Submit" ()];
]
) params.e_uuid
in
let content = [
h1 [ pcdata params.e_name ];
h3 [ pcdata "Submit by copy/paste" ];
form_rawballot;
h3 [ pcdata "Submit by file" ];
form_upload;
] in
base ~title:params.e_name ~content
let ballot_received ~election ~confirm ~user ~can_vote =
let module X = (val election : WEB_ELECTION) in
let params = X.election.e_params in
let name = params.e_name in
let user_div = match user with
| Some u when can_vote ->
let service = confirm () in
post_form ~service (fun () -> [
div [
pcdata "I am ";
format_user u;
pcdata " and ";
string_input ~input_type:`Submit ~value:"I confirm my vote" ();
pcdata "Election data: ";
a ~service [ pcdata "parameters" ] ();
pcdata ", ";
a ~service:(S.election_file params ESCreds) [
pcdata "public credentials"
] ();
pcdata ", ";
a ~service:(S.election_file params ESKeys) [
pcdata "trustee public keys"
] ();
pcdata ", ";
a ~service:(S.election_file params ESBallots) [
pcdata "ballots";
] ();
pcdata ".";
]
]) params.e_uuid
| Some _ ->
div [
pcdata "You cannot vote in this election!";
];
]
| None ->
] in
let content = [
h1 [ pcdata params.e_name ];
p ~a:[a_style "margin: 1em; padding: 2pt; font-style: italic; border: 1pt solid;"] [
pcdata params.e_description
];
p voting_period;
p permissions;
div [
pcdata "Please log in to confirm your vote.";
]
in
let content = [
h1 [ pcdata name ];
p [
pcdata "Your ballot for ";
em [pcdata name];
pcdata " has been received, but not recorded yet.";
];
user_div;
p [
a ~service:(S.election_file params ESIndex) [
pcdata "Go back to election"
] ();
pcdata ".";
];
] in
base ~title:name ~content
let do_cast_ballot ~election ~result =
let module X = (val election : WEB_ELECTION) in
let params = X.election.e_params in
let name = params.e_name in
let content = [
h1 [ pcdata name ];
p [
pcdata "Your ballot for ";
em [pcdata name];
(match result with
| `Valid hash -> pcdata (" has been accepted, its hash is " ^ hash ^ ".")
| `Error e -> pcdata (" is rejected, because " ^ Web_common.explain_error e ^ ".")
);
];
p [
a ~service:(S.election_file params ESIndex) [
pcdata "Go back to election"
] ();
pcdata ".";
];
] in
base ~title:name ~content
let election_update_credential ~election =
let module X = (val election : WEB_ELECTION) in
let params = X.election.e_params in
let form = post_form ~service:S.election_update_credential_post
(fun (old, new_) ->
[
div [
p [
pcdata "\
This form allows you to change a single credential at a time. To get \
the hash of a credential, run the following command:";
make_button
~service:(Eliom_service.preapply S.election_vote params.e_uuid)
"Go to the booth";
pcdata " or ";
make_button
~service:(Eliom_service.preapply S.election_cast params.e_uuid)
"Submit a raw ballot";
];
];
br ();
audit_info;
] in
base ~title:params.e_name ~content
let update_credential ~election =
let module X = (val election : WEB_ELECTION) in
let params = X.election.e_params in
let form = post_form ~service:S.election_update_credential_post
(fun (old, new_) ->
[
div [
p [
pcdata "\
This form allows you to change a single credential at \
a time. To get the hash of a credential, run the \
following command:\
";
];
pre [
pcdata "printf old-credential | sha256sum";
];
p [
pcdata "In the above command, ";
code [pcdata "old-credential"];
pcdata " should look like a big number written in base 10.";
];
];
pre [
pcdata "printf old-credential | sha256sum";
p [
pcdata "Hash of the old credential: ";
string_input ~name:old ~input_type:`Text ~a:[a_size 64] ();
];
p [
pcdata "In the above command, ";
code [pcdata "old-credential"];
pcdata " should look like a big number written in base 10.";
pcdata "New credential: ";
string_input ~name:new_ ~input_type:`Text ~a:[a_size 617] ();
];
];
p [
pcdata "Hash of the old credential: ";
string_input ~name:old ~input_type:`Text ~a:[a_size 64] ();
];
p [
pcdata "New credential: ";
string_input ~name:new_ ~input_type:`Text ~a:[a_size 617] ();
];
p [string_input ~input_type:`Submit ~value:"Submit" ()];
]
) params.e_uuid
in
let content = [
h1 [ pcdata params.e_name ];
form;
] in
base ~title:params.e_name ~content
p [string_input ~input_type:`Submit ~value:"Submit" ()];
]
) params.e_uuid
in
let content = [
h1 [ pcdata params.e_name ];
form;
] in
base ~title:params.e_name ~content
let cast_raw ~election =
let module X = (val election : WEB_ELECTION) in
let params = X.election.e_params in
let form_rawballot = post_form ~service:S.election_cast_post
(fun (name, _) ->
[
div [pcdata "Please paste your raw ballot in JSON format in the following box:"];
div [textarea ~a:[a_rows 10; a_cols 40] ~name ()];
div [string_input ~input_type:`Submit ~value:"Submit" ()];