Commit 757b84ee authored by Stephane Glondu's avatar Stephane Glondu

Implement web client-side shuffling

parent 233ad301
......@@ -9,3 +9,4 @@ src/static/tool_js_ttkeygen.js
src/static/tool_js_credgen.js
src/static/tool_js_questions.js
src/static/tool_js_pd.js
src/static/tool_js_shuffle.js
......@@ -139,6 +139,7 @@ let () = dispatch & function
copy_rule "tool_js_credgen.js" "src/tool/tool_js_credgen.js" "src/static/tool_js_credgen.js";
copy_rule "tool_js_questions.js" "src/tool/tool_js_questions.js" "src/static/tool_js_questions.js";
copy_rule "tool_js_pd.js" "src/tool/tool_js_pd.js" "src/static/tool_js_pd.js";
copy_rule "tool_js_shuffle.js" "src/tool/tool_js_shuffle.js" "src/static/tool_js_shuffle.js";
List.iter
copy_static
......
......@@ -27,22 +27,6 @@ open Signatures
open Common
open Tool_js_common
let prng = lazy (pseudo_rng (random_string secure_rng 16))
module LwtJsRandom = struct
type 'a t = unit -> 'a Lwt.t
let return x () = Lwt.return x
let bind x f () = Lwt.bind (x ()) (fun y -> f y ())
let fail x () = Lwt.fail x
let random q =
let size = Z.bit_length q / 8 + 1 in
fun () ->
let%lwt () = Lwt_js.yield () in
let r = random_string (Lazy.force prng) size in
Lwt.return Z.(of_bits r mod q)
end
let encryptBallot params cred plaintext () =
let module P = (val params : ELECTION_DATA) in
let module G = P.G in
......
......@@ -20,6 +20,7 @@
(**************************************************************************)
open Js_of_ocaml
open Platform
open Common
let document = Dom_html.document
......@@ -97,3 +98,25 @@ let run_handler handler () =
let msg = "Unexpected error: " ^ Printexc.to_string e in
alert msg
); Js._false
let get_params () =
let x = Js.to_string Dom_html.window##.location##.search in
let n = String.length x in
if n < 1 || x.[0] <> '?' then []
else Url.decode_arguments (String.sub x 1 (n-1))
module LwtJsRandom : Signatures.RANDOM with type 'a t = unit -> 'a Lwt.t = struct
type 'a t = unit -> 'a Lwt.t
let return x () = Lwt.return x
let bind x f () = Lwt.bind (x ()) (fun y -> f y ())
let fail x () = Lwt.fail x
let prng = lazy (pseudo_rng (random_string secure_rng 16))
let random q =
let size = Z.bit_length q / 8 + 1 in
fun () ->
let%lwt () = Lwt_js.yield () in
let r = random_string (Lazy.force prng) size in
Lwt.return Z.(of_bits r mod q)
end
......@@ -120,14 +120,6 @@ let load_private_key_file _ =
reader##readAsText (file);
return_unit
let get_uuid x =
let n = String.length x in
if n < 1 || x.[0] <> '?' then
None
else
let args = Url.decode_arguments (String.sub x 1 (n-1)) in
List.assoc_opt "uuid" args
let main _ =
let () =
document##getElementById (Js.string "compute") >>== fun e ->
......@@ -140,7 +132,7 @@ let main _ =
e##.onchange := Dom_html.handler (wrap load_private_key_file)
in
let () =
match get_uuid (Js.to_string Dom_html.window##.location##.search) with
match List.assoc_opt "uuid" (get_params ()) with
| None -> ()
| Some uuid ->
Lwt.async (fun () ->
......
(**************************************************************************)
(* BELENIOS *)
(* *)
(* Copyright © 2012-2019 Inria *)
(* *)
(* This program is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Affero General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version, with the additional *)
(* exemption that compiling, linking, and/or using OpenSSL is allowed. *)
(* *)
(* This program is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
(* Affero General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU Affero General Public *)
(* License along with this program. If not, see *)
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Serializable_j
open Common
open Tool_js_common
let shuffle election ciphertexts =
let election = Election.(get_group (of_string election)) in
let module W = (val election) in
let module E = Election.Make (W) (LwtJsRandom) in
let ciphertexts = nh_ciphertexts_of_string E.G.read ciphertexts in
let%lwt shuffle_ciphertexts, shuffle_proofs = E.shuffle_ciphertexts ciphertexts () in
Lwt.return (string_of_shuffle E.G.write {shuffle_ciphertexts; shuffle_proofs})
let () =
Lwt.async (fun () ->
let%lwt _ = Lwt_js_events.onload () in
let uuid = List.assoc "uuid" (get_params ()) in
let open Lwt_xmlHttpRequest in
let%lwt election = get ("../elections/" ^ uuid ^ "/election.json") in
let%lwt ciphertexts = get ("../election/nh-ciphertexts?uuid=" ^ uuid) in
let%lwt shuffle = shuffle election.content ciphertexts.content in
set_textarea "shuffle" shuffle;
set_element_display "wait_div" "none";
set_element_display "submit_form" "block";
Lwt.return_unit
)
......@@ -2568,7 +2568,12 @@ let shuffle election token =
let title = params.e_name ^ " — Shuffle" in
let content = [
div [pcdata "It is now time to shuffle encrypted ballots."];
div ~a:[a_id "wait_div"] [
pcdata "Please wait... ";
img ~src:(static "encrypting.gif") ~alt:"Loading..." ();
];
post_form ~service:election_shuffle_post
~a:[a_id "submit_form"; a_style "display:none;"]
(fun nshuffle ->
[
div [
......@@ -2580,6 +2585,13 @@ let shuffle election token =
];
]
) (uuid, token);
div [
script ~a:[a_src (static "sjcl.js")] (pcdata "");
script ~a:[a_src (static "jsbn.js")] (pcdata "");
script ~a:[a_src (static "jsbn2.js")] (pcdata "");
script ~a:[a_src (static "random.js")] (pcdata "");
script ~a:[a_src (static "tool_js_shuffle.js")] (pcdata "");
];
]
in
base ~title ~content ~uuid ()
......
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