Commit f140b130 authored by Stephane Glondu's avatar Stephane Glondu

Threshold: election finalization + running

parent 5dce1128
......@@ -127,6 +127,7 @@ let set_rewrite_prefix ~src ~dst =
type election_file =
| ESRaw
| ESKeys
| ESTParams
| ESCreds
| ESBallots
| ESVoters
......@@ -137,6 +138,7 @@ type election_file =
let election_file_of_string = function
| "election.json" -> ESRaw
| "public_keys.jsons" -> ESKeys
| "threshold.json" -> ESTParams
| "public_creds.txt" -> ESCreds
| "ballots.jsons" -> ESBallots
| "records" -> ESRecords
......@@ -148,6 +150,7 @@ let election_file_of_string = function
let string_of_election_file = function
| ESRaw -> "election.json"
| ESKeys -> "public_keys.jsons"
| ESTParams -> "threshold.json"
| ESCreds -> "public_creds.txt"
| ESBallots -> "ballots.jsons"
| ESRecords -> "records"
......
......@@ -61,6 +61,7 @@ val set_rewrite_prefix : src:string -> dst:string -> unit
type election_file =
| ESRaw
| ESKeys
| ESTParams
| ESCreds
| ESBallots
| ESVoters
......
......@@ -153,6 +153,13 @@ let get_public_keys uuid =
return @@ Some lines
with _ -> return_none
let get_threshold uuid =
try%lwt
Lwt_io.chars_of_file (!spool_dir / uuid / "threshold.json") |>
Lwt_stream.to_string >>= fun x ->
return (Some x)
with _ -> return_none
module Ballots = Map.Make (String)
module BallotsCacheTypes = struct
......
......@@ -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_passwords : string -> (string * string) SMap.t option Lwt.t
val get_public_keys : string -> string list option Lwt.t
val get_threshold : string -> string option Lwt.t
val get_ballot_hashes : uuid:string -> string list Lwt.t
val get_ballot_by_hash : uuid:string -> hash:string -> string option Lwt.t
......@@ -107,24 +107,49 @@ let finalize_election uuid se =
(* trustees *)
let group = Group.of_string se.se_group in
let module G = (val group : GROUP) in
let module KG = Trustees.MakeSimple (G) (LwtRandom) in
let%lwt trustees, public_keys, private_key =
match se.se_public_keys with
| [] ->
let%lwt private_key = KG.generate () in
let%lwt public_key = KG.prove private_key in
return (None, [public_key], Some private_key)
| _ :: _ ->
return (
Some (List.map (fun {st_id; _} -> st_id) se.se_public_keys),
(List.map
(fun {st_public_key; _} ->
if st_public_key = "" then failwith "some public keys are missing";
trustee_public_key_of_string G.read st_public_key
) se.se_public_keys),
None)
let%lwt y, trustees, pk_or_tp, private_keys =
match se.se_threshold_trustees with
| None ->
let module KG = Trustees.MakeSimple (G) (LwtRandom) in
let%lwt trustees, public_keys, private_key =
match se.se_public_keys with
| [] ->
let%lwt private_key = KG.generate () in
let%lwt public_key = KG.prove private_key in
return (None, [public_key], `KEY private_key)
| _ :: _ ->
return (
Some (List.map (fun {st_id; _} -> st_id) se.se_public_keys),
(List.map
(fun {st_public_key; _} ->
if st_public_key = "" then failwith "some public keys are missing";
trustee_public_key_of_string G.read st_public_key
) se.se_public_keys),
`None)
in
let y = KG.combine (Array.of_list public_keys) in
return (y, trustees, `PK public_keys, private_key)
| Some ts ->
match se.se_threshold_parameters with
| None -> failwith "key establishment not finished"
| Some tp ->
let tp = threshold_parameters_of_string G.read tp in
let module P = Trustees.MakePKI (G) (LwtRandom) in
let module C = Trustees.MakeChannels (G) (LwtRandom) (P) in
let module K = Trustees.MakePedersen (G) (LwtRandom) (P) (C) in
let trustees = List.map (fun {stt_id; _} -> stt_id) ts in
let private_keys =
List.map (fun {stt_voutput; _} ->
match stt_voutput with
| Some v ->
let voutput = voutput_of_string G.read v in
voutput.vo_private_key
| None -> failwith "inconsistent state"
) ts
in
let y = K.combine tp in
return (y, Some trustees, `TP tp, `KEYS private_keys)
in
let y = KG.combine (Array.of_list public_keys) in
(* election parameters *)
let metadata = { se.se_metadata with e_trustees = trustees } in
let template = se.se_questions in
......@@ -149,7 +174,10 @@ let finalize_election uuid se =
Lwt_io.write oc "\n") xs)
in
Lwt_unix.mkdir dir 0o700 >>
create_file "public_keys.jsons" (string_of_trustee_public_key G.write) public_keys >>
(match pk_or_tp with
| `PK pk -> create_file "public_keys.jsons" (string_of_trustee_public_key G.write) pk
| `TP tp -> create_file "threshold.json" (string_of_threshold_parameters G.write) [tp]
) >>
create_file "voters.txt" (fun x -> x.sv_id) se.se_voters >>
create_file "metadata.json" string_of_metadata [metadata] >>
create_file "election.json" (fun x -> x) [raw_election] >>
......@@ -176,11 +204,12 @@ let finalize_election uuid se =
W.B.update_files () >>
Lwt_unix.unlink fname
in
(* create file with private key, if any *)
(* create file with private keys, if any *)
let%lwt () =
match private_key with
| None -> return_unit
| Some x -> create_file "private_key.json" string_of_number [x]
match private_keys with
| `None -> return_unit
| `KEY x -> create_file "private_key.json" string_of_number [x]
| `KEYS x -> create_file "private_keys.jsons" (fun x -> x) x
in
(* clean up setup database *)
Ocsipersist.remove election_credtokens se.se_public_creds >>
......@@ -188,6 +217,13 @@ let finalize_election uuid se =
(fun {st_token; _} ->
Ocsipersist.remove election_pktokens st_token)
se.se_public_keys >>
(match se.se_threshold_trustees with
| None -> return_unit
| Some ts ->
Lwt_list.iter_s
(fun x -> Ocsipersist.remove election_tpktokens x.stt_token)
ts
) >>
Ocsipersist.remove election_stable uuid_s >>
(* inject passwords *)
(match metadata.e_auth_config with
......@@ -1442,14 +1478,14 @@ let () =
let content_type_of_file = function
| ESRaw -> "application/json; charset=utf-8"
| ESKeys | ESBallots | ESETally | ESResult -> "application/json"
| ESKeys | ESTParams | ESBallots | ESETally | ESResult -> "application/json"
| ESCreds | ESRecords | ESVoters -> "text/plain"
let handle_pseudo_file uuid_s w f site_user =
let module W = (val w : ELECTION_DATA) in
let confidential =
match f with
| ESRaw | ESKeys | ESBallots | ESETally | ESResult | ESCreds -> false
| ESRaw | ESKeys | ESTParams | ESBallots | ESETally | ESResult | ESCreds -> false
| ESRecords | ESVoters -> true
in
let%lwt () =
......
......@@ -584,6 +584,27 @@ let election_setup_trustees uuid se () =
) ts
)
in
let import_link = div [
a ~service:Web_services.election_setup_import_trustees
[pcdata "Import trustees from another election"] uuid
]
in
let div_trustees =
if se.se_threshold_trustees = None then
div [
trustees;
(if se.se_public_keys <> [] then
div [
pcdata "There is one link per trustee. Send each trustee her link.";
br ();
br ();
]
else pcdata "");
form_trustees_add;
import_link;
]
else pcdata ""
in
let div_content =
div [
div [pcdata "If you do not wish the server to store any keys, you may nominate trustees. In that case, each trustee will create her own secret key. Be careful, once the election is over, you will need the contribution of each trustee to compute the result!"];
......@@ -593,29 +614,15 @@ let election_setup_trustees uuid se () =
pcdata " of trustees is needed to perform the decryption.";
];
br ();
trustees;
(if se.se_public_keys <> [] then
div [
pcdata "There is one link per trustee. Send each trustee her link.";
br ();
br ();
]
else pcdata "");
form_trustees_add;
div_trustees;
]
in
let import_link = div [
a ~service:Web_services.election_setup_import_trustees
[pcdata "Import trustees from another election"] uuid
]
in
let back_link = div [
a ~service:Web_services.election_setup
[pcdata "Go back to election setup"] uuid;
] in
let content = [
div_content;
import_link;
back_link;
] in
let%lwt login_box = site_login_box () in
......@@ -1191,9 +1198,13 @@ let election_setup_confirm uuid se () =
match se.se_public_keys with
| [] -> ready, "OK"
| _ :: _ ->
if List.for_all (fun {st_public_key; _} ->
st_public_key <> ""
) se.se_public_keys then ready, "OK" else false, "Missing"
match se.se_threshold_trustees with
| None -> if List.for_all (fun {st_public_key; _} ->
st_public_key <> ""
) se.se_public_keys then ready, "OK" else false, "Missing"
| Some _ ->
if se.se_threshold_parameters <> None then ready, "OK"
else false, "Missing"
in
let div_trustee_warning =
match se.se_public_keys with
......@@ -1283,6 +1294,18 @@ let audit_footer w =
let%lwt language = Eliom_reference.get Web_state.language in
let module L = (val Web_i18n.get_lang language) in
let module W = (val w : ELECTION_DATA) in
let uuid_s = Uuidm.to_string W.election.e_params.e_uuid in
let%lwt pk_or_tp =
match%lwt Web_persist.get_threshold uuid_s with
| None ->
return (a ~service:(file w ESKeys) [
pcdata L.trustee_public_keys
] ())
| Some _ ->
return (a ~service:(file w ESTParams) [
pcdata "threshold parameters"
] ())
in
return @@ div ~a:[a_style "line-height:1.5em;"] [
div [
div [
......@@ -1295,9 +1318,7 @@ let audit_footer w =
pcdata L.parameters
] ();
pcdata ", ";
a ~service:(file w ESKeys) [
pcdata L.trustee_public_keys
] ();
pk_or_tp;
pcdata ", ";
a ~service:(file w ESCreds) [
pcdata L.public_credentials
......
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