Commit 12d306c7 authored by Stephane Glondu's avatar Stephane Glondu

Use monadic style instead of with_element

parent c17ca235
......@@ -60,10 +60,15 @@ let encryptBallot params cred plaintext () =
Lwt.return ()
let progress_step n =
let old_ = Printf.sprintf "progress%d" (n-1) in
let new_ = Printf.sprintf "progress%d" n in
with_element old_ (fun e -> e##.style##.fontWeight := Js.string "normal");
with_element new_ (fun e -> e##.style##.fontWeight := Js.string "bold")
js_ignore (
let old_ = Printf.sprintf "progress%d" (n-1) in
document##getElementById (Js.string old_) >>= fun old_ ->
old_##.style##.fontWeight := Js.string "normal";
let new_ = Printf.sprintf "progress%d" n in
document##getElementById (Js.string new_) >>= fun new_ ->
new_##.style##.fontWeight := Js.string "bold";
return_unit
)
let rec createQuestionNode sk params question_div num_questions i prev (q, answers) next =
(* Create div element for the current question. [i] and [(q,
......@@ -187,35 +192,37 @@ let rec createQuestionNode sk params question_div num_questions i prev (q, answe
let all_questions = List.rev_map fst all |> Array.of_list in
set_textarea "choices" (string_of_plaintext all_answers);
question_div##.style##.display := Js.string "none";
with_element "pretty_choices" (fun e ->
Array.iteri (fun i a ->
let q = all_questions.(i) in
let h = document##createElement (Js.string "h3") in
let t = document##createTextNode (Js.string q.q_question) in
Dom.appendChild h t;
Dom.appendChild e h;
let ul = document##createElement (Js.string "ul") in
let checked = ref 0 in
js_ignore (
document##getElementById (Js.string "pretty_choices") >>= fun e ->
Array.iteri (fun i a ->
if a > 0 then (
incr checked;
let li = document##createElement (Js.string "li") in
let text = match q.q_blank with
| Some true -> if i = 0 then get_content "str_blank_vote" else q.q_answers.(i-1)
| _ -> q.q_answers.(i)
in
let t = document##createTextNode (Js.string text) in
Dom.appendChild li t;
Dom.appendChild ul li;
)
) a;
if !checked = 0 then (
let t = document##createTextNode (Js.string @@ get_content "str_nothing") in
Dom.appendChild ul t
);
Dom.appendChild e ul;
) all_answers
);
let q = all_questions.(i) in
let h = document##createElement (Js.string "h3") in
let t = document##createTextNode (Js.string q.q_question) in
Dom.appendChild h t;
Dom.appendChild e h;
let ul = document##createElement (Js.string "ul") in
let checked = ref 0 in
Array.iteri (fun i a ->
if a > 0 then (
incr checked;
let li = document##createElement (Js.string "li") in
let text = match q.q_blank with
| Some true -> if i = 0 then get_content "str_blank_vote" else q.q_answers.(i-1)
| _ -> q.q_answers.(i)
in
let t = document##createTextNode (Js.string text) in
Dom.appendChild li t;
Dom.appendChild ul li;
)
) a;
if !checked = 0 then (
let t = document##createTextNode (Js.string @@ get_content "str_nothing") in
Dom.appendChild ul t
);
Dom.appendChild e ul;
) all_answers;
return_unit
);
Lwt_js_events.async (encryptBallot params sk all_answers);
set_element_display "plaintext_div" "block";
progress_step 3;
......@@ -244,18 +251,20 @@ let rec createQuestionNode sk params question_div num_questions i prev (q, answe
div
let addQuestions sk params qs =
with_element "question_div" (fun e ->
let n = Array.length qs in
let qs =
Array.to_list qs |>
List.map (fun q -> q, Array.make (Election.question_length q) 0)
in
match qs with
| [] -> failwith "no questions"
| q :: next ->
let div = createQuestionNode sk params e n 0 [] q next in
Dom.appendChild e div
)
js_ignore (
document##getElementById (Js.string "question_div") >>= fun e ->
let n = Array.length qs in
let qs =
Array.to_list qs |>
List.map (fun q -> q, Array.make (Election.question_length q) 0)
in
match qs with
| [] -> failwith "no questions"
| q :: next ->
let div = createQuestionNode sk params e n 0 [] q next in
Dom.appendChild e div;
return_unit
)
let createStartButton params intro_div qs =
let b = document##createElement (Js.string "button") in
......@@ -300,9 +309,12 @@ let loadElection () =
set_content "election_description" params.e_description;
set_content "election_uuid" (raw_string_of_uuid params.e_uuid);
set_content "election_fingerprint" P.election.e_fingerprint;
with_element "intro" (fun e ->
let b = createStartButton election_params e params.e_questions in
with_element "input_code" (fun e -> Dom.appendChild e b)
js_ignore (
document##getElementById (Js.string "intro") >>= fun e ->
let b = createStartButton election_params e params.e_questions in
document##getElementById (Js.string "input_code") >>= fun e ->
Dom.appendChild e b;
return_unit
)
let get_prefix str =
......@@ -344,12 +356,13 @@ let load_params_handler _ =
Js._false
let onload_handler _ =
let () =
with_element "load_url"
(fun e -> e##.onclick := Dom_html.handler load_url_handler);
with_element "load_params"
(fun e -> e##.onclick := Dom_html.handler load_params_handler);
in
js_ignore (
document##getElementById (Js.string "load_url") >>= fun e ->
e##.onclick := Dom_html.handler load_url_handler;
document##getElementById (Js.string "load_params") >>= fun e ->
e##.onclick := Dom_html.handler load_params_handler;
return_unit
);
let () =
match get_url (Js.to_string Dom_html.window##.location##.hash) with
| None ->
......
......@@ -24,6 +24,17 @@ open Common
let document = Dom_html.document
let ( >>= ) = Js.Opt.bind
let js_ignore x =
Js.Opt.get x (fun () -> ())
let return_unit =
Js.some ()
let wrap_for_handler x =
js_ignore x; Js._false
let alert s =
Dom_html.window##alert (Js.string s)
......@@ -31,9 +42,6 @@ let prompt s =
let x = Dom_html.window##prompt (Js.string s) (Js.string "") in
Js.Opt.to_option (Js.Opt.map x Js.to_string)
let with_element x f =
Option.iter f (Dom_html.getElementById_opt x)
let get_textarea_opt id =
Option.map (fun x -> Js.to_string x##.value)
(Dom_html.getElementById_coerce id Dom_html.CoerceTo.textarea)
......@@ -57,7 +65,11 @@ let get_input id =
| None -> Printf.ksprintf failwith "<input> %s is missing" id
let set_element_display id x =
with_element id (fun e -> e##.style##.display := Js.string x)
js_ignore (
document##getElementById (Js.string id) >>= fun e ->
e##.style##.display := Js.string x;
return_unit
)
let set_download id mime fn x =
let x = (Js.string ("data:" ^ mime ^ ","))##concat (Js.encodeURI (Js.string x)) in
......@@ -68,16 +80,19 @@ let set_download id mime fn x =
e##.href := x
let get_content x =
let r = ref x in
with_element x (fun x ->
Js.Opt.iter (x##.textContent) (fun x -> r := Js.to_string x)
); !r
Js.Opt.get (
document##getElementById (Js.string x) >>= fun e ->
e##.textContent >>= fun x ->
Js.some (Js.to_string x)
) (fun () -> x)
let set_content id x =
with_element id (fun e ->
let t = document##createTextNode (Js.string x) in
Dom.appendChild e t
)
js_ignore (
document##getElementById (Js.string id) >>= fun e ->
let t = document##createTextNode (Js.string x) in
Dom.appendChild e t;
return_unit
)
let run_handler handler () =
(try handler ()
......
......@@ -28,8 +28,6 @@ open Tool_js_common
let election = ref None
let encrypted_tally = ref None
let ( >>= ) = Js.Opt.bind
let wrap f x =
(try
Js.Opt.case (f x)
......
......@@ -26,19 +26,23 @@ open Common
open Tool_js_common
let set_step i =
with_element "current_step" (fun e ->
js_ignore (
document##getElementById (Js.string "current_step") >>= fun e ->
e##.innerHTML := Js.string "";
let t = Printf.sprintf "Step %d/3" i in
let t = document##createTextNode (Js.string t) in
Dom.appendChild e t
Dom.appendChild e t;
return_unit
)
let set_explain str =
with_element "explain" (fun e ->
js_ignore (
document##getElementById (Js.string "explain") >>= fun e ->
e##.innerHTML := Js.string "";
let t = document##createTextNode (Js.string str) in
Dom.appendChild e t;
Dom.appendChild e (document##createElement (Js.string "br"));
Dom.appendChild e (Dom_html.createBr document);
return_unit
)
let gen_cert e _ =
......@@ -55,15 +59,11 @@ let gen_cert e _ =
set_textarea "data" cert;
Js._false
let proceed step _ =
let proceed step =
let group = get_textarea "group" in
let key =
let r = ref "" in
with_element "compute_private_key" (fun e ->
Js.Opt.iter (Dom_html.CoerceTo.input e) (fun x -> r := Js.to_string x##.value)
);
!r
in
document##getElementById (Js.string "compute_private_key") >>= fun e ->
Dom_html.CoerceTo.input e >>= fun e ->
let key = Js.to_string e##.value in
let certs = certs_of_string (get_textarea "certs") in
let threshold = int_of_string (get_textarea "threshold") in
let module G = (val Group.of_string group : GROUP) in
......@@ -74,71 +74,72 @@ let proceed step _ =
| 3 ->
let polynomial = T.step3 certs key threshold in
set_textarea "compute_data" (string_of_polynomial polynomial);
Js._false
return_unit
| 5 ->
let vinput = get_textarea "vinput" in
let vinput = vinput_of_string vinput in
let voutput = T.step5 certs key vinput in
set_textarea "compute_data" (string_of_voutput G.write voutput);
Js._false
return_unit
| _ ->
alert "Unexpected state!";
Js._false
return_unit
let fill_interactivity _ =
Js.Opt.iter
(document##getElementById (Js.string "interactivity"))
(fun e ->
let step = int_of_string (get_textarea "step") in
match step with
| 0 ->
set_element_display "data_form" "none";
let t = document##createTextNode (Js.string "Waiting for the election administrator to set the threshold... Reload the page to check progress.") in
Dom.appendChild e t
| 2 | 4 ->
set_step (step / 2);
set_element_display "data_form" "none";
let t = document##createTextNode (Js.string "Waiting for the other trustees... Reload the page to check progress.") in
Dom.appendChild e t
| 6 | 7 ->
set_step 3;
set_element_display "data_form" "none";
let t = document##createTextNode (Js.string "Your job in the key establishment protocol is done! Please download your ") in
Dom.appendChild e t;
let a = document##createTextNode (Js.string "public key") in
let t = Dom_html.createA document in
t##.id := Js.string "public_key";
Dom.appendChild t a;
Dom.appendChild e t;
let t = document##createTextNode (Js.string " and check that it is in the public threshold parameters when the election is open. Your private key will be needed to decrypt the election result.") in
Dom.appendChild e t;
let group = get_textarea "group" in
let module G = (val Group.of_string group : GROUP) in
let voutput = voutput_of_string G.read (get_textarea "voutput") in
set_download "public_key" "application/json" "public_key.json" (string_of_group_element G.write voutput.vo_public_key.trustee_public_key)
| 1 ->
set_step 1;
let b = document##createElement (Js.string "button") in
let t = document##createTextNode (Js.string "Generate private key") in
b##.onclick := Dom_html.handler (gen_cert e);
Dom.appendChild b t;
Dom.appendChild e b;
| 3 | 5 ->
let explain = match step with
| 3 -> "Now, all the certificates of the trustees have been generated. Proceed to generate your share of the decryption key."
| 5 -> "Now, all the trustees have generated their secret shares. Proceed to the final checks so that the election can be validated."
| _ -> failwith "impossible step"
in
set_step ((step + 1) / 2);
set_explain explain;
set_element_display "compute_form" "block";
with_element "compute_button" (fun e ->
e##.onclick := Dom_html.handler (proceed step)
);
| _ ->
alert "Unexpected state!"
);
Js._false
let main () =
document##getElementById (Js.string "interactivity") >>= fun e ->
let step = int_of_string (get_textarea "step") in
match step with
| 0 ->
set_element_display "data_form" "none";
let t = document##createTextNode (Js.string "Waiting for the election administrator to set the threshold... Reload the page to check progress.") in
Dom.appendChild e t;
return_unit
| 2 | 4 ->
set_step (step / 2);
set_element_display "data_form" "none";
let t = document##createTextNode (Js.string "Waiting for the other trustees... Reload the page to check progress.") in
Dom.appendChild e t;
return_unit
| 6 | 7 ->
set_step 3;
set_element_display "data_form" "none";
let t = document##createTextNode (Js.string "Your job in the key establishment protocol is done! Please download your ") in
Dom.appendChild e t;
let a = document##createTextNode (Js.string "public key") in
let t = Dom_html.createA document in
t##.id := Js.string "public_key";
Dom.appendChild t a;
Dom.appendChild e t;
let t = document##createTextNode (Js.string " and check that it is in the public threshold parameters when the election is open. Your private key will be needed to decrypt the election result.") in
Dom.appendChild e t;
let group = get_textarea "group" in
let module G = (val Group.of_string group : GROUP) in
let voutput = voutput_of_string G.read (get_textarea "voutput") in
set_download "public_key" "application/json" "public_key.json" (string_of_group_element G.write voutput.vo_public_key.trustee_public_key);
return_unit
| 1 ->
set_step 1;
let b = document##createElement (Js.string "button") in
let t = document##createTextNode (Js.string "Generate private key") in
b##.onclick := Dom_html.handler (gen_cert e);
Dom.appendChild b t;
Dom.appendChild e b;
return_unit
| 3 | 5 ->
let explain = match step with
| 3 -> "Now, all the certificates of the trustees have been generated. Proceed to generate your share of the decryption key."
| 5 -> "Now, all the trustees have generated their secret shares. Proceed to the final checks so that the election can be validated."
| _ -> failwith "impossible step"
in
set_step ((step + 1) / 2);
set_explain explain;
set_element_display "compute_form" "block";
document##getElementById (Js.string "compute_button") >>= fun e ->
e##.onclick := Dom_html.handler (fun _ -> wrap_for_handler (proceed step));
return_unit
| _ ->
alert "Unexpected state!";
return_unit
let () =
Dom_html.window##.onload := Dom_html.handler fill_interactivity;
Dom_html.window##.onload := Dom_html.handler (fun _ -> wrap_for_handler (main ()))
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