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