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

Make the booth independent of the server and usable offline

parent cba76337
...@@ -368,20 +368,57 @@ let get_prefix str = ...@@ -368,20 +368,57 @@ let get_prefix str =
let n = String.length str in let n = String.length str in
if n >= 4 then String.sub str 0 (n-4) else str if n >= 4 then String.sub str 0 (n-4) else str
let () = let get_url x =
Dom_html.window##onload <- Dom_html.handler (fun _ -> let n = String.length x in
let s = Js.to_string Dom_html.window##location##pathname in if n <= 1 || String.sub x 0 1 <> "#" then
let url = get_prefix s in None
withElementById "ballot_form" (fun e -> 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 Js.Opt.iter
(Dom_html.CoerceTo.form e) (Dom_html.CoerceTo.form e)
(fun e -> e##action <- Js.string (url ^ "cast")) (fun e -> e##action <- Js.string (url ^ "cast"))
); );
let open XmlHttpRequest in let open XmlHttpRequest in
Lwt.async (fun () -> Lwt.async (fun () ->
lwt raw = get (url ^ "election.json") in lwt raw = get (url ^ "election.json") in
let () = setTextarea "election_params" raw.content in let () = setTextarea "election_params" raw.content in
Lwt.return (runHandler loadElection ()) 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 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 ( ...@@ -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_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 = 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_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 = 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_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 () let election_cast_confirm = post_coservice ~csrf_safe:true ~fallback:election_cast ~post_params:unit ()
......
...@@ -1316,9 +1316,9 @@ let () = ...@@ -1316,9 +1316,9 @@ let () =
let () = let () =
Any.register ~service:election_vote Any.register ~service:election_vote
(fun (uuid, ()) () -> (fun () () ->
Eliom_reference.unset Web_state.ballot >> Eliom_reference.unset Web_state.ballot >>
Web_templates.booth uuid >>= Html5.send) Web_templates.booth () >>= Html5.send)
let () = let () =
Any.register ~service:election_cast Any.register ~service:election_cast
......
...@@ -269,8 +269,12 @@ let admin ~elections () = ...@@ -269,8 +269,12 @@ let admin ~elections () =
let%lwt login_box = site_login_box () in let%lwt login_box = site_login_box () in
base ~title ?login_box ~content () 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 = 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 *) Printf.ksprintf Unsafe.data (* FIXME: unsafe *)
"<button onclick=\"location.href='%s';\" style=\"font-size:35px;\"%s>%s</button>" "<button onclick=\"location.href='%s';\" style=\"font-size:35px;\"%s>%s</button>"
uri (if disabled then " disabled" else "") uri (if disabled then " disabled" else "")
...@@ -1596,9 +1600,13 @@ let election_home election state () = ...@@ -1596,9 +1600,13 @@ let election_home election state () =
in in
div ~a:[a_style "text-align:center;"] [ div ~a:[a_style "text-align:center;"] [
div [ div [
make_button let url =
~service:(Eliom_service.preapply election_vote (uuid, ())) Eliom_uri.make_string_uri
~disabled L.start; ~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 [ div [
a a
...@@ -2354,7 +2362,9 @@ let login_password () = ...@@ -2354,7 +2362,9 @@ let login_password () =
] in ] in
base ~title:L.password_login ~content () 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%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 head = head (title (pcdata L.belenios_booth)) [ let head = head (title (pcdata L.belenios_booth)) [
...@@ -2373,17 +2383,22 @@ let booth uuid = ...@@ -2373,17 +2383,22 @@ let booth uuid =
in in
let election_loader = let election_loader =
div ~a:[a_id "election_loader"; a_style "display:none;"] [ div ~a:[a_id "election_loader"; a_style "display:none;"] [
h1 [pcdata "Election loader"]; h1 [pcdata L.belenios_booth];
pcdata "Election parameters:"; 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 [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 in
let text_choices = unsafe_textarea "choices" "" in let text_choices = unsafe_textarea "choices" "" in
let ballot_form = let ballot_form =
post_form ~a:[a_id "ballot_form"] ~service:election_cast_post post_form ~a:[a_id "ballot_form"] ~service:election_cast_post
(fun (encrypted_vote, _) -> [ (fun (encrypted_vote, _) -> [
div ~a:[a_style "display:none;"] [ div ~a:[a_id "div_ballot"; a_style "display:none;"] [
pcdata "Encrypted ballot:"; pcdata "Encrypted ballot:";
div [ div [
textarea textarea
...@@ -2404,10 +2419,15 @@ let booth uuid = ...@@ -2404,10 +2419,15 @@ let booth uuid =
pcdata L.we_invite_you_to_save_it; pcdata L.we_invite_you_to_save_it;
]; ];
br (); br ();
string_input ~input_type:`Submit ~value:L.continue ~a:[a_style "font-size:30px;"] (); 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 (); br (); br ();
]) ])
(uuid, ()) (dummy_uuid, ())
in in
let main = let main =
div ~a:[a_id "main"] [ div ~a:[a_id "main"] [
...@@ -2508,8 +2528,8 @@ let booth uuid = ...@@ -2508,8 +2528,8 @@ let booth uuid =
in in
let body = body [ let body = body [
wait_div; wait_div;
election_loader;
div ~a:[a_id "wrapper"] [ div ~a:[a_id "wrapper"] [
election_loader;
booth_div; booth_div;
]; ];
] in ] in
......
...@@ -79,6 +79,6 @@ val login_choose : ...@@ -79,6 +79,6 @@ val login_choose :
val login_dummy : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t 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 : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val contact_footer : metadata -> string -> string 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