Commit 3689ea16 authored by Stephane Glondu's avatar Stephane Glondu

Web_election.Make now returns WEB_BALLOT_BOX

parent c2857da9
...@@ -55,14 +55,15 @@ let question_length q = ...@@ -55,14 +55,15 @@ let question_length q =
(** Homomorphic elections *) (** Homomorphic elections *)
module Make (W : ELECTION_DATA) (M : RANDOM) = struct module Make (W : ELECTION_DATA) (M : RANDOM) = struct
open W
open G
type 'a m = 'a M.t type 'a m = 'a M.t
open M open M
let ( >>= ) = bind let ( >>= ) = bind
type elt = G.t type elt = W.G.t
module G = W.G
open G
let election = W.election
type private_key = Z.t type private_key = Z.t
type public_key = elt type public_key = elt
......
...@@ -141,6 +141,9 @@ module type ELECTION = sig ...@@ -141,6 +141,9 @@ module type ELECTION = sig
type elt type elt
module G : GROUP with type t = elt
val election : elt election
type private_key = Z.t type private_key = Z.t
type public_key = elt type public_key = elt
......
...@@ -31,14 +31,11 @@ open Web_common ...@@ -31,14 +31,11 @@ open Web_common
let ( / ) = Filename.concat let ( / ) = Filename.concat
module Make (D : ELECTION_DATA) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELECTION = struct module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX = struct
let uuid = D.election.e_params.e_uuid let uuid = E.election.e_params.e_uuid
module G = D.G module G = E.G
module E = Election.Make (D) (M)
module B : WEB_BALLOT_BOX = struct
let uuid_u = underscorize uuid let uuid_u = underscorize uuid
let ballots_table = Ocsipersist.open_table ("ballots_" ^ uuid_u) let ballots_table = Ocsipersist.open_table ("ballots_" ^ uuid_u)
...@@ -53,8 +50,8 @@ module Make (D : ELECTION_DATA) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELE ...@@ -53,8 +50,8 @@ module Make (D : ELECTION_DATA) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELE
Ocsipersist.add cred_table cred None Ocsipersist.add cred_table cred None
let send_confirmation_email user email hash = let send_confirmation_email user email hash =
let title = D.election.e_params.e_name in let title = E.election.e_params.e_name in
let x = (D.election.e_params.e_uuid, ()) in let x = (E.election.e_params.e_uuid, ()) in
let url1 = Eliom_uri.make_string_uri ~absolute:true let url1 = Eliom_uri.make_string_uri ~absolute:true
~service:Web_services.election_pretty_ballots x |> rewrite_prefix ~service:Web_services.election_pretty_ballots x |> rewrite_prefix
in in
...@@ -222,6 +219,4 @@ module Make (D : ELECTION_DATA) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELE ...@@ -222,6 +219,4 @@ module Make (D : ELECTION_DATA) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELE
) >> ) >>
return (num_tallied, sha256_b64 tally, tally) return (num_tallied, sha256_b64 tally, tally)
end
end end
...@@ -22,4 +22,4 @@ ...@@ -22,4 +22,4 @@
open Signatures open Signatures
open Web_signatures open Web_signatures
module Make (D : ELECTION_DATA) (M : RANDOM with type 'a t = 'a Lwt.t) : WEB_ELECTION module Make (E : ELECTION with type 'a m = 'a Lwt.t) : WEB_BALLOT_BOX
...@@ -19,7 +19,6 @@ ...@@ -19,7 +19,6 @@
(* <http://www.gnu.org/licenses/>. *) (* <http://www.gnu.org/licenses/>. *)
(**************************************************************************) (**************************************************************************)
open Signatures
open Web_serializable_t open Web_serializable_t
module type AUTH_SERVICES = sig module type AUTH_SERVICES = sig
...@@ -67,9 +66,3 @@ module type WEB_BALLOT_BOX = sig ...@@ -67,9 +66,3 @@ module type WEB_BALLOT_BOX = sig
(** Computes and writes to disk the encrypted tally. Returns the (** Computes and writes to disk the encrypted tally. Returns the
number of ballots and the hash of the encrypted tally. *) number of ballots and the hash of the encrypted tally. *)
end end
module type WEB_ELECTION = sig
module G : GROUP
module E : ELECTION with type elt = G.t and type 'a m = 'a Lwt.t
module B : WEB_BALLOT_BOX
end
...@@ -186,8 +186,10 @@ let finalize_election uuid se = ...@@ -186,8 +186,10 @@ let finalize_election uuid se =
create_file "metadata.json" string_of_metadata [metadata] >> create_file "metadata.json" string_of_metadata [metadata] >>
create_file "election.json" (fun x -> x) [raw_election] >> create_file "election.json" (fun x -> x) [raw_election] >>
(* construct Web_election instance *) (* construct Web_election instance *)
let election = Election.(get_group (of_string raw_election)) in let election = Election.of_string raw_election in
let module W = Web_election.Make ((val election)) (LwtRandom) in let module W = (val Election.get_group election) in
let module E = Election.Make (W) (LwtRandom) in
let module B = Web_election.Make (E) in
(* set up authentication *) (* set up authentication *)
let%lwt () = let%lwt () =
match metadata.e_auth_config with match metadata.e_auth_config with
...@@ -204,8 +206,8 @@ let finalize_election uuid se = ...@@ -204,8 +206,8 @@ let finalize_election uuid se =
let%lwt () = let%lwt () =
let fname = !spool_dir / uuid_s ^ ".public_creds.txt" in let fname = !spool_dir / uuid_s ^ ".public_creds.txt" in
Lwt_io.lines_of_file fname |> Lwt_io.lines_of_file fname |>
Lwt_stream.iter_s W.B.inject_cred >> Lwt_stream.iter_s B.inject_cred >>
W.B.update_files () >> B.update_files () >>
Lwt_unix.unlink fname Lwt_unix.unlink fname
in in
(* create file with private keys, if any *) (* create file with private keys, if any *)
...@@ -1172,10 +1174,11 @@ let () = ...@@ -1172,10 +1174,11 @@ let () =
let%lwt election = find_election uuid in let%lwt election = find_election uuid in
let%lwt metadata = Web_persist.get_election_metadata uuid in let%lwt metadata = Web_persist.get_election_metadata uuid in
let module W = (val Election.get_group election) in let module W = (val Election.get_group election) in
let module WE = Web_election.Make (W) (LwtRandom) in let module E = Election.Make (W) (LwtRandom) in
let module B = Web_election.Make (E) in
if metadata.e_owner = Some u then ( if metadata.e_owner = Some u then (
try%lwt try%lwt
WE.B.update_cred ~old ~new_ >> B.update_cred ~old ~new_ >>
String.send ("OK", "text/plain") String.send ("OK", "text/plain")
with Error e -> with Error e ->
String.send ("Error: " ^ explain_error e, "text/plain") String.send ("Error: " ^ explain_error e, "text/plain")
...@@ -1223,7 +1226,8 @@ let () = ...@@ -1223,7 +1226,8 @@ let () =
(fun (uuid, ()) () -> (fun (uuid, ()) () ->
let%lwt election = find_election uuid in let%lwt election = find_election uuid in
let module W = (val Election.get_group election) in let module W = (val Election.get_group election) in
let module WE = Web_election.Make (W) (LwtRandom) in let module E = Election.Make (W) (LwtRandom) in
let module B = Web_election.Make (E) in
match%lwt Eliom_reference.get Web_state.ballot with match%lwt Eliom_reference.get Web_state.ballot with
| Some the_ballot -> | Some the_ballot ->
begin begin
...@@ -1233,7 +1237,7 @@ let () = ...@@ -1233,7 +1237,7 @@ let () =
let record = u, now () in let record = u, now () in
let%lwt result = let%lwt result =
try%lwt try%lwt
let%lwt hash = WE.B.cast the_ballot record in let%lwt hash = B.cast the_ballot record in
return (`Valid hash) return (`Valid hash)
with Error e -> return (`Error e) with Error e -> return (`Error e)
in in
...@@ -1505,18 +1509,19 @@ let () = ...@@ -1505,18 +1509,19 @@ let () =
let%lwt election = find_election uuid in let%lwt election = find_election uuid in
let%lwt metadata = Web_persist.get_election_metadata uuid in let%lwt metadata = Web_persist.get_election_metadata uuid in
let module W = (val Election.get_group election) in let module W = (val Election.get_group election) in
let module WE = Web_election.Make (W) (LwtRandom) in let module E = Election.Make (W) (LwtRandom) in
let module B = Web_election.Make (E) in
if metadata.e_owner = Some u then ( if metadata.e_owner = Some u then (
let%lwt () = let%lwt () =
match%lwt Web_persist.get_election_state uuid with match%lwt Web_persist.get_election_state uuid with
| `Closed -> return () | `Closed -> return ()
| _ -> forbidden () | _ -> forbidden ()
in in
let%lwt nb, hash, tally = WE.B.compute_encrypted_tally () in let%lwt nb, hash, tally = B.compute_encrypted_tally () in
let%lwt npks = let%lwt npks =
match%lwt Web_persist.get_threshold uuid with match%lwt Web_persist.get_threshold uuid with
| Some tp -> | Some tp ->
let tp = threshold_parameters_of_string WE.G.read tp in let tp = threshold_parameters_of_string W.G.read tp in
return (Array.length tp.t_verification_keys) return (Array.length tp.t_verification_keys)
| None -> | None ->
match%lwt Web_persist.get_public_keys uuid with match%lwt Web_persist.get_public_keys uuid with
...@@ -1533,9 +1538,9 @@ let () = ...@@ -1533,9 +1538,9 @@ let () =
| [sk] -> number_of_string sk | [sk] -> number_of_string sk
| _ -> failwith "several private keys are available" | _ -> failwith "several private keys are available"
in in
let tally = encrypted_tally_of_string WE.G.read tally in let tally = encrypted_tally_of_string W.G.read tally in
let%lwt pd = WE.E.compute_factor tally sk in let%lwt pd = E.compute_factor tally sk in
let pd = string_of_partial_decryption WE.G.write pd in let pd = string_of_partial_decryption W.G.write pd in
Web_persist.set_partial_decryptions uuid [1, pd] >> Web_persist.set_partial_decryptions uuid [1, pd] >>
handle_election_tally_release (uuid, ()) () handle_election_tally_release (uuid, ()) ()
) else redir_preapply election_admin (uuid, ()) () ) else redir_preapply election_admin (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