Commit 7a17b8c7 authored by Stephane Glondu's avatar Stephane Glondu

Threshold: server-side tally

parent f140b130
...@@ -153,6 +153,13 @@ let get_public_keys uuid = ...@@ -153,6 +153,13 @@ let get_public_keys uuid =
return @@ Some lines return @@ Some lines
with _ -> return_none with _ -> return_none
let get_private_keys uuid =
try%lwt
let lines = Lwt_io.lines_of_file (!spool_dir / uuid / "private_keys.jsons") in
let%lwt lines = Lwt_stream.to_list lines in
return @@ Some lines
with _ -> return_none
let get_threshold uuid = let get_threshold uuid =
try%lwt try%lwt
Lwt_io.chars_of_file (!spool_dir / uuid / "threshold.json") |> Lwt_io.chars_of_file (!spool_dir / uuid / "threshold.json") |>
......
...@@ -51,6 +51,7 @@ val get_elections_by_owner : user -> string list Lwt.t ...@@ -51,6 +51,7 @@ val get_elections_by_owner : user -> string list Lwt.t
val get_voters : string -> string list option Lwt.t val get_voters : string -> string list option Lwt.t
val get_passwords : string -> (string * string) SMap.t option Lwt.t val get_passwords : string -> (string * string) SMap.t option Lwt.t
val get_public_keys : string -> string list option Lwt.t val get_public_keys : string -> string list option Lwt.t
val get_private_keys : string -> string list option Lwt.t
val get_threshold : string -> string option Lwt.t val get_threshold : string -> string option Lwt.t
val get_ballot_hashes : uuid:string -> string list Lwt.t val get_ballot_hashes : uuid:string -> string list Lwt.t
......
...@@ -95,7 +95,7 @@ let election_pretty_records = service ~path:["elections"] ~get_params:(suffix (u ...@@ -95,7 +95,7 @@ let election_pretty_records = service ~path:["elections"] ~get_params:(suffix (u
let election_missing_voters = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "missing")) () let election_missing_voters = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "missing")) ()
let election_compute_encrypted_tally = post_coservice ~csrf_safe:true ~fallback:election_admin ~post_params:unit () let election_compute_encrypted_tally = post_coservice ~csrf_safe:true ~fallback:election_admin ~post_params:unit ()
let election_tally_trustees = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "trustees" ** int "trustee_id")) () let election_tally_trustees = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "trustees" ** string "token")) ()
let election_tally_trustees_post = post_service ~fallback:election_tally_trustees ~post_params:(string "partial_decryption") () let election_tally_trustees_post = post_service ~fallback:election_tally_trustees ~post_params:(string "partial_decryption") ()
let election_tally_release = post_service ~fallback:election_admin ~post_params:unit () let election_tally_release = post_service ~fallback:election_admin ~post_params:unit ()
......
This diff is collapsed.
...@@ -1493,7 +1493,7 @@ Thank you again for your help, ...@@ -1493,7 +1493,7 @@ Thank you again for your help,
-- \nThe election administrator." -- \nThe election administrator."
let election_admin w metadata state () = let election_admin w metadata state get_tokens_decrypt () =
let module W = (val w : ELECTION_DATA) in let module W = (val w : ELECTION_DATA) in
let title = W.election.e_params.e_name ^ " — Administration" in let title = W.election.e_params.e_name ^ " — Administration" in
let uuid_s = Uuidm.to_string W.election.e_params.e_uuid in let uuid_s = Uuidm.to_string W.election.e_params.e_uuid in
...@@ -1536,6 +1536,17 @@ let election_admin w metadata state () = ...@@ -1536,6 +1536,17 @@ let election_admin w metadata state () =
] ]
| `EncryptedTally (npks, _, hash) -> | `EncryptedTally (npks, _, hash) ->
let%lwt pds = Web_persist.get_partial_decryptions uuid_s in let%lwt pds = Web_persist.get_partial_decryptions uuid_s in
let%lwt tp = Web_persist.get_threshold uuid_s in
let tp =
match tp with
| None -> None
| Some tp -> Some (threshold_parameters_of_string W.G.read tp)
in
let threshold_or_not =
match tp with
| None -> pcdata ""
| Some tp -> pcdata (Printf.sprintf " At least %d trustees must act." tp.t_threshold)
in
let trustees = let trustees =
let rec loop i ts = let rec loop i ts =
if i <= npks then if i <= npks then
...@@ -1548,11 +1559,18 @@ let election_admin w metadata state () = ...@@ -1548,11 +1559,18 @@ let election_admin w metadata state () =
| None -> loop 1 [] | None -> loop 1 []
| Some ts -> loop 1 ts | Some ts -> loop 1 ts
in in
let rec seq i j = if i >= j then [] else i :: (seq (i+1) j) in
let%lwt trustee_tokens =
match tp with
| None -> return (List.map string_of_int (seq 1 (npks+1)))
| Some _ -> get_tokens_decrypt ()
in
let trustees = List.combine trustees trustee_tokens in
let trustees = let trustees =
List.map List.map
(fun (name, trustee_id) -> (fun ((name, trustee_id), token) ->
let service = election_tally_trustees in let service = election_tally_trustees in
let x = (W.election.e_params.e_uuid, ((), trustee_id)) in let x = (W.election.e_params.e_uuid, ((), token)) in
let uri = rewrite_prefix @@ Eliom_uri.make_string_uri let uri = rewrite_prefix @@ Eliom_uri.make_string_uri
~absolute:true ~service x ~absolute:true ~service x
in in
...@@ -1598,7 +1616,7 @@ let election_admin w metadata state () = ...@@ -1598,7 +1616,7 @@ let election_admin w metadata state () =
pcdata "."; pcdata ".";
]; ];
div [ div [
div [pcdata "We are now waiting for trustees..."]; div [pcdata "We are now waiting for trustees..."; threshold_or_not];
table table
(tr [ (tr [
th [pcdata "Trustee"]; th [pcdata "Trustee"];
...@@ -1985,12 +2003,17 @@ let pretty_records w records () = ...@@ -1985,12 +2003,17 @@ let pretty_records w records () =
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 tally_trustees w trustee_id () = let tally_trustees w trustee_id token () =
let module W = (val w : ELECTION_DATA) in let module W = (val w : ELECTION_DATA) in
let params = W.election.e_params in let params = W.election.e_params in
let title = let title =
params.e_name ^ " — Partial decryption #" ^ string_of_int trustee_id params.e_name ^ " — Partial decryption #" ^ string_of_int trustee_id
in in
let%lwt encrypted_private_key =
match%lwt Web_persist.get_private_keys (Uuidm.to_string params.e_uuid) with
| None -> return_none
| Some keys -> return (Some (List.nth keys (trustee_id-1)))
in
let content = [ let content = [
p [pcdata "It is now time to compute your partial decryption factors."]; p [pcdata "It is now time to compute your partial decryption factors."];
p [ p [
...@@ -1998,6 +2021,14 @@ let tally_trustees w trustee_id () = ...@@ -1998,6 +2021,14 @@ let tally_trustees w trustee_id () =
b [span ~a:[a_id "hash"] []]; b [span ~a:[a_id "hash"] []];
pcdata "." pcdata "."
]; ];
(
match encrypted_private_key with
| None -> pcdata ""
| Some epk ->
div ~a:[a_style "display:none;"] [
unsafe_textarea "encrypted_private_key" epk
];
);
div ~a:[a_id "input_private_key"] [ div ~a:[a_id "input_private_key"] [
p [pcdata "Please enter your private key:"]; p [pcdata "Please enter your private key:"];
input input
...@@ -2022,7 +2053,7 @@ let tally_trustees w trustee_id () = ...@@ -2022,7 +2053,7 @@ let tally_trustees w trustee_id () =
]; ];
div [string_input ~input_type:`Submit ~value:"Submit" ()]; div [string_input ~input_type:`Submit ~value:"Submit" ()];
] ]
) (params.e_uuid, ((), trustee_id)); ) (params.e_uuid, ((), token));
]; ];
div [ div [
script ~a:[a_src (uri_of_string (fun () -> "../../../static/sjcl.js"))] (pcdata ""); script ~a:[a_src (uri_of_string (fun () -> "../../../static/sjcl.js"))] (pcdata "");
......
...@@ -51,7 +51,7 @@ val election_setup_import_trustees : Uuidm.t -> setup_election -> (module ELECTI ...@@ -51,7 +51,7 @@ val election_setup_import_trustees : Uuidm.t -> setup_election -> (module ELECTI
val election_setup_confirm : Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val election_setup_confirm : Uuidm.t -> setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_home : (module ELECTION_DATA) -> Web_persist.election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val election_home : (module ELECTION_DATA) -> Web_persist.election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_admin : (module ELECTION_DATA) -> Web_serializable_j.metadata -> Web_persist.election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val election_admin : (module ELECTION_DATA) -> Web_serializable_j.metadata -> Web_persist.election_state -> (unit -> string list Lwt.t) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val update_credential : (module ELECTION_DATA) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val update_credential : (module ELECTION_DATA) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val regenpwd : Uuidm.t -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val regenpwd : Uuidm.t -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_raw : (module ELECTION_DATA) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val cast_raw : (module ELECTION_DATA) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
...@@ -60,7 +60,7 @@ val cast_confirmed : (module ELECTION_DATA) -> result:[< `Error of Web_common.er ...@@ -60,7 +60,7 @@ val cast_confirmed : (module ELECTION_DATA) -> result:[< `Error of Web_common.er
val pretty_ballots : (module ELECTION_DATA) -> string list -> Yojson.Safe.json result option -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val pretty_ballots : (module ELECTION_DATA) -> string list -> Yojson.Safe.json result option -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val pretty_records : (module ELECTION_DATA) -> (string * string) list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val pretty_records : (module ELECTION_DATA) -> (string * string) list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val tally_trustees : (module ELECTION_DATA) -> int -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t val tally_trustees : (module ELECTION_DATA) -> int -> string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val already_logged_in : val already_logged_in :
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
......
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