Commit e6a2e5bf authored by Stephane Glondu's avatar Stephane Glondu

Add ( >>== ), remove js_ignore and wrap_for_handler

parent 5b5a6a70
......@@ -60,15 +60,16 @@ let encryptBallot params cred plaintext () =
Lwt.return ()
let progress_step n =
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 () =
let old_ = Printf.sprintf "progress%d" (n-1) in
document##getElementById (Js.string old_) >>== fun old_ ->
old_##.style##.fontWeight := Js.string "normal"
in
let () =
let new_ = Printf.sprintf "progress%d" n in
document##getElementById (Js.string new_) >>== fun new_ ->
new_##.style##.fontWeight := Js.string "bold"
in ()
let rec createQuestionNode sk params question_div num_questions i prev (q, answers) next =
(* Create div element for the current question. [i] and [(q,
......@@ -192,37 +193,36 @@ 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";
js_ignore (
document##getElementById (Js.string "pretty_choices") >>= fun e ->
Array.iteri (fun i a ->
let q = all_questions.(i) in
let h = Dom_html.createH3 document in
let t = document##createTextNode (Js.string q.q_question) in
Dom.appendChild h t;
Dom.appendChild e h;
let ul = Dom_html.createUl document in
let checked = ref 0 in
Array.iteri (fun i a ->
if a > 0 then (
incr checked;
let li = Dom_html.createLi document 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
);
let () =
document##getElementById (Js.string "pretty_choices") >>== fun e ->
Array.iteri (fun i a ->
let q = all_questions.(i) in
let h = Dom_html.createH3 document in
let t = document##createTextNode (Js.string q.q_question) in
Dom.appendChild h t;
Dom.appendChild e h;
let ul = Dom_html.createUl document in
let checked = ref 0 in
Array.iteri (fun i a ->
if a > 0 then (
incr checked;
let li = Dom_html.createLi document 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
in
Lwt_js_events.async (encryptBallot params sk all_answers);
set_element_display "plaintext_div" "block";
progress_step 3;
......@@ -251,20 +251,17 @@ let rec createQuestionNode sk params question_div num_questions i prev (q, answe
div
let addQuestions sk params qs =
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
)
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
let createStartButton params intro_div qs =
let b = Dom_html.createButton document in
......@@ -309,13 +306,10 @@ 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;
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
)
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
let get_prefix str =
let n = String.length str in
......@@ -356,13 +350,14 @@ let load_params_handler _ =
Js._false
let onload_handler _ =
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 () =
document##getElementById (Js.string "load_url") >>== fun e ->
e##.onclick := Dom_html.handler load_url_handler
in
let () =
document##getElementById (Js.string "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 ->
......
......@@ -26,15 +26,11 @@ let document = Dom_html.document
let ( >>= ) = Js.Opt.bind
let js_ignore x =
Js.Opt.get x (fun () -> ())
let ( >>== ) = Js.Opt.iter
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)
......@@ -65,11 +61,8 @@ let get_input id =
| None -> Printf.ksprintf failwith "<input> %s is missing" id
let set_element_display id x =
js_ignore (
document##getElementById (Js.string id) >>= fun e ->
e##.style##.display := Js.string x;
return_unit
)
document##getElementById (Js.string id) >>== fun e ->
e##.style##.display := Js.string x
let set_download id mime fn x =
let x = (Js.string ("data:" ^ mime ^ ","))##concat (Js.encodeURI (Js.string x)) in
......@@ -87,12 +80,9 @@ let get_content x =
) (fun () -> x)
let set_content id x =
js_ignore (
document##getElementById (Js.string id) >>= fun e ->
let t = document##createTextNode (Js.string x) in
Dom.appendChild e t;
return_unit
)
document##getElementById (Js.string id) >>== fun e ->
let t = document##createTextNode (Js.string x) in
Dom.appendChild e t
let run_handler handler () =
(try handler ()
......
......@@ -62,18 +62,16 @@ let generate _ =
Js._false
let fill_interactivity _ =
Js.Opt.iter
(document##getElementById (Js.string "interactivity"))
(fun e ->
let x = Dom_html.createDiv document in
Dom.appendChild e x;
let b = Dom_html.createButton document in
let t = document##createTextNode (Js.string "Generate") in
b##.onclick := Dom_html.handler generate;
Dom.appendChild b t;
Dom.appendChild x b;
);
Js._false
let () =
document##getElementById (Js.string "interactivity") >>== fun e ->
let x = Dom_html.createDiv document in
Dom.appendChild e x;
let b = Dom_html.createButton document in
let t = document##createTextNode (Js.string "Generate") in
b##.onclick := Dom_html.handler generate;
Dom.appendChild b t;
Dom.appendChild x b
in Js._false
let () =
Dom_html.window##.onload := Dom_html.handler fill_interactivity;
......@@ -91,16 +91,15 @@ let compute_partial_decryption _ =
in
let factor = E.compute_factor encrypted_tally private_key in
set_textarea "pd" (string_of_partial_decryption P.G.write factor);
Js.some ()
return_unit
let compute_hash () =
let _ =
Js.Opt.option !encrypted_tally >>= fun e ->
let () =
Js.Opt.option !encrypted_tally >>== fun e ->
let hash = sha256_b64 e in
document##getElementById (Js.string "hash") >>= fun e ->
document##getElementById (Js.string "hash") >>== fun e ->
let t = document##createTextNode (Js.string hash) in
Dom.appendChild e t;
Js.null
Dom.appendChild e t
in Js._false
let load_private_key_file _ =
......@@ -111,16 +110,15 @@ let load_private_key_file _ =
let reader = new%js File.fileReader in
reader##.onload :=
Dom.handler (fun _ ->
let _ =
document##getElementById (Js.string "private_key") >>= fun e ->
Dom_html.CoerceTo.input e >>= fun e ->
File.CoerceTo.string (reader##.result) >>= fun text ->
e##.value := text;
Js.some ()
let () =
document##getElementById (Js.string "private_key") >>== fun e ->
Dom_html.CoerceTo.input e >>== fun e ->
File.CoerceTo.string (reader##.result) >>== fun text ->
e##.value := text
in Js._false
);
reader##readAsText (file);
Js.some ()
return_unit
let get_uuid x =
let n = String.length x in
......@@ -131,31 +129,29 @@ let get_uuid x =
List.assoc_opt "uuid" args
let main _ =
let _ =
document##getElementById (Js.string "compute") >>= fun e ->
Dom_html.CoerceTo.button e >>= fun e ->
e##.onclick := Dom_html.handler (wrap compute_partial_decryption);
Js.null
let () =
document##getElementById (Js.string "compute") >>== fun e ->
Dom_html.CoerceTo.button e >>== fun e ->
e##.onclick := Dom_html.handler (wrap compute_partial_decryption)
in
let _ =
document##getElementById (Js.string "private_key_file") >>= fun e ->
Dom_html.CoerceTo.input e >>= fun e ->
e##.onchange := Dom_html.handler (wrap load_private_key_file);
Js.null
let () =
document##getElementById (Js.string "private_key_file") >>== fun e ->
Dom_html.CoerceTo.input e >>== fun e ->
e##.onchange := Dom_html.handler (wrap load_private_key_file)
in
let _ =
let () =
match get_uuid (Js.to_string Dom_html.window##.location##.search) with
| None -> ()
| Some uuid ->
Lwt.async (fun () ->
let open Lwt_xmlHttpRequest in
let%lwt e = get ("../elections/" ^ uuid ^ "/encrypted_tally.json") in
encrypted_tally := Some (String.trim e.content);
let%lwt e = get ("../elections/" ^ uuid ^ "/election.json") in
election := Some e.content;
Lwt.return (compute_hash ()))
in
Js._false
Lwt.async (fun () ->
let open Lwt_xmlHttpRequest in
let%lwt e = get ("../elections/" ^ uuid ^ "/encrypted_tally.json") in
encrypted_tally := Some (String.trim e.content);
let%lwt e = get ("../elections/" ^ uuid ^ "/election.json") in
election := Some e.content;
Lwt.return (compute_hash ())
)
in Js._false
let () =
Dom_html.window##.onload := Dom_html.handler main
......@@ -23,7 +23,6 @@ open Js_of_ocaml
open Serializable_j
open Tool_js_common
let (>>=) = Js.Opt.bind
let return = Js.Opt.return
let handler f = Dom_html.handler (fun e -> ignore (f e); Js._false)
......
......@@ -37,16 +37,14 @@ let tkeygen _ =
Js._false
let fill_interactivity _ =
Js.Opt.iter
(document##getElementById (Js.string "interactivity"))
(fun e ->
let b = Dom_html.createButton document in
let t = document##createTextNode (Js.string "Generate a new keypair") in
b##.onclick := Dom_html.handler tkeygen;
Dom.appendChild b t;
Dom.appendChild e b;
);
Js._false
let () =
document##getElementById (Js.string "interactivity") >>== fun e ->
let b = Dom_html.createButton document in
let t = document##createTextNode (Js.string "Generate a new keypair") in
b##.onclick := Dom_html.handler tkeygen;
Dom.appendChild b t;
Dom.appendChild e b
in Js._false
let () =
Dom_html.window##.onload := Dom_html.handler fill_interactivity;
......@@ -26,24 +26,18 @@ open Common
open Tool_js_common
let set_step i =
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;
return_unit
)
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
let set_explain str =
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 (Dom_html.createBr document);
return_unit
)
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 (Dom_html.createBr document)
let gen_cert e _ =
let group = get_textarea "group" in
......@@ -61,8 +55,8 @@ let gen_cert e _ =
let proceed step =
let group = get_textarea "group" in
document##getElementById (Js.string "compute_private_key") >>= fun e ->
Dom_html.CoerceTo.input e >>= fun e ->
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
......@@ -73,33 +67,28 @@ let proceed step =
match step with
| 3 ->
let polynomial = T.step3 certs key threshold in
set_textarea "compute_data" (string_of_polynomial polynomial);
return_unit
set_textarea "compute_data" (string_of_polynomial polynomial)
| 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);
return_unit
set_textarea "compute_data" (string_of_voutput G.write voutput)
| _ ->
alert "Unexpected state!";
return_unit
alert "Unexpected state!"
let main () =
document##getElementById (Js.string "interactivity") >>= fun e ->
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
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;
return_unit
Dom.appendChild e t
| 6 | 7 ->
set_step 3;
set_element_display "data_form" "none";
......@@ -115,16 +104,14 @@ let main () =
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
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 = Dom_html.createButton document 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
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."
......@@ -134,12 +121,10 @@ let main () =
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
document##getElementById (Js.string "compute_button") >>== fun e ->
e##.onclick := Dom_html.handler (fun _ -> proceed step; Js._false)
| _ ->
alert "Unexpected state!";
return_unit
alert "Unexpected state!"
let () =
Dom_html.window##.onload := Dom_html.handler (fun _ -> wrap_for_handler (main ()))
Dom_html.window##.onload := Dom_html.handler (fun _ -> main (); Js._false)
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