Commit 50e460ff authored by Stephane Glondu's avatar Stephane Glondu

Make the booth independent of the server and usable offline

parent cba76337
......@@ -368,10 +368,16 @@ let get_prefix str =
let n = String.length str in
if n >= 4 then String.sub str 0 (n-4) else str
let () =
Dom_html.window##onload <- Dom_html.handler (fun _ ->
let s = Js.to_string Dom_html.window##location##pathname in
let url = get_prefix s in
let get_url x =
let n = String.length x in
if n <= 1 || String.sub x 0 1 <> "#" then
None
else
let args = Url.decode_arguments (String.sub x 1 (n-1)) in
try Some (List.assoc "url" args)
with Not_found -> None
let load_url url =
withElementById "ballot_form" (fun e ->
Js.Opt.iter
(Dom_html.CoerceTo.form e)
......@@ -382,6 +388,37 @@ let () =
lwt raw = get (url ^ "election.json") in
let () = setTextarea "election_params" raw.content in
Lwt.return (runHandler loadElection ())
)
let load_url_handler _ =
let url = getTextarea "url" in
let encoded = Url.encode_arguments ["url", url] in
Dom_html.window##location##hash <- Js.string encoded;
load_url url;
Js._false
let load_params_handler _ =
setDisplayById "div_ballot" "block";
setDisplayById "div_submit" "none";
setDisplayById "div_submit_manually" "block";
Lwt.async (fun () ->
Lwt.return (runHandler loadElection ())
);
Js._false
)
let onload_handler _ =
let () =
withElementById "load_url"
(fun e -> e##onclick <- Dom_html.handler load_url_handler);
withElementById "load_params"
(fun e -> e##onclick <- Dom_html.handler load_params_handler);
in
let () =
match get_url (Js.to_string Dom_html.window##location##hash) with
| None ->
setDisplayById "wait_div" "none";
setDisplayById "election_loader" "block";
| Some url -> load_url url
in Js._false
let () = Dom_html.window##onload <- Dom_html.handler onload_handler
......@@ -87,7 +87,7 @@ let election_close = post_coservice ~fallback:election_admin ~post_params:unit (
let election_archive = post_coservice ~fallback:election_admin ~post_params:unit ()
let election_update_credential = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "update-cred")) ()
let election_update_credential_post = post_service ~fallback:election_update_credential ~post_params:(string "old_credential" ** string "new_credential") ()
let election_vote = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "vote")) ()
let election_vote = service ~path:["vote.html"] ~get_params:unit ()
let election_cast = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "cast")) ()
let election_cast_post = post_service ~fallback:election_cast ~post_params:(opt (string "encrypted_vote") ** opt (file "encrypted_vote_file")) ()
let election_cast_confirm = post_coservice ~csrf_safe:true ~fallback:election_cast ~post_params:unit ()
......
......@@ -1316,9 +1316,9 @@ let () =
let () =
Any.register ~service:election_vote
(fun (uuid, ()) () ->
(fun () () ->
Eliom_reference.unset Web_state.ballot >>
Web_templates.booth uuid >>= Html5.send)
Web_templates.booth () >>= Html5.send)
let () =
Any.register ~service:election_cast
......
......@@ -269,8 +269,12 @@ let admin ~elections () =
let%lwt login_box = site_login_box () in
base ~title ?login_box ~content ()
let make_button ~service ~disabled contents =
let make_button ~service ?hash ~disabled contents =
let uri = Eliom_uri.make_string_uri ~service () in
let uri = match hash with
| None -> uri
| Some x -> uri ^ "#" ^ x
in
Printf.ksprintf Unsafe.data (* FIXME: unsafe *)
"<button onclick=\"location.href='%s';\" style=\"font-size:35px;\"%s>%s</button>"
uri (if disabled then " disabled" else "")
......@@ -1596,9 +1600,13 @@ let election_home election state () =
in
div ~a:[a_style "text-align:center;"] [
div [
make_button
~service:(Eliom_service.preapply election_vote (uuid, ()))
~disabled L.start;
let url =
Eliom_uri.make_string_uri
~service:election_home ~absolute:true (uuid, ()) |>
rewrite_prefix
in
let hash = Netencoding.Url.mk_url_encoded_parameters ["url", url] in
make_button ~service:election_vote ~hash ~disabled L.start;
];
div [
a
......@@ -2354,7 +2362,9 @@ let login_password () =
] in
base ~title:L.password_login ~content ()
let booth uuid =
let dummy_uuid = uuid_of_raw_string "00000000-0000-0000-0000-000000000000"
let booth () =
let%lwt language = Eliom_reference.get Web_state.language in
let module L = (val Web_i18n.get_lang language) in
let head = head (title (pcdata L.belenios_booth)) [
......@@ -2373,17 +2383,22 @@ let booth uuid =
in
let election_loader =
div ~a:[a_id "election_loader"; a_style "display:none;"] [
h1 [pcdata "Election loader"];
pcdata "Election parameters:";
h1 [pcdata L.belenios_booth];
br ();
pcdata "Load an election by giving its URL:";
div [unsafe_textarea "url" ""];
div [button ~button_type:`Button ~a:[a_id "load_url"] [pcdata "Load URL"]];
br ();
pcdata "Load an election by giving its parameters:";
div [unsafe_textarea "election_params" ""];
div [button ~button_type:`Button ~a:[a_id "load_election"] [pcdata "Load election"]];
div [button ~button_type:`Button ~a:[a_id "load_params"] [pcdata "Load parameters"]];
]
in
let text_choices = unsafe_textarea "choices" "" in
let ballot_form =
post_form ~a:[a_id "ballot_form"] ~service:election_cast_post
(fun (encrypted_vote, _) -> [
div ~a:[a_style "display:none;"] [
div ~a:[a_id "div_ballot"; a_style "display:none;"] [
pcdata "Encrypted ballot:";
div [
textarea
......@@ -2404,10 +2419,15 @@ let booth uuid =
pcdata L.we_invite_you_to_save_it;
];
br ();
div ~a:[a_id "div_submit"] [
string_input ~input_type:`Submit ~value:L.continue ~a:[a_style "font-size:30px;"] ();
];
div ~a:[a_id "div_submit_manually"; a_style "display:none;"] [
pcdata "You must submit your ballot manually.";
];
br (); br ();
])
(uuid, ())
(dummy_uuid, ())
in
let main =
div ~a:[a_id "main"] [
......@@ -2508,8 +2528,8 @@ let booth uuid =
in
let body = body [
wait_div;
div ~a:[a_id "wrapper"] [
election_loader;
div ~a:[a_id "wrapper"] [
booth_div;
];
] in
......
......@@ -79,6 +79,6 @@ val login_choose :
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 booth : unit -> [> `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