Commit 8fa8209d authored by Stephane Glondu's avatar Stephane Glondu

Add computation of encrypted tally

parent d3791979
......@@ -124,9 +124,11 @@ type 'a partial_decryption = {
type plaintext = int list <ocaml repr="array"> list <ocaml repr="array">
type 'a encrypted_tally = 'a ciphertext list <ocaml repr="array"> list <ocaml repr="array">
type 'a result = {
num_tallied : int;
encrypted_tally : 'a ciphertext list <ocaml repr="array"> list <ocaml repr="array">;
encrypted_tally : 'a encrypted_tally;
partial_decryptions : 'a partial_decryption list <ocaml repr="array">;
result : plaintext;
}
......@@ -182,6 +182,7 @@ type election_file =
| ESCreds
| ESBallots
| ESRecords
| ESETally
let election_file_of_string = function
| "election.json" -> ESRaw
......@@ -189,6 +190,7 @@ let election_file_of_string = function
| "public_creds.txt" -> ESCreds
| "ballots.jsons" -> ESBallots
| "records" -> ESRecords
| "encrypted_tally.json" -> ESETally
| x -> invalid_arg ("election_dir_item: " ^ x)
let string_of_election_file = function
......@@ -197,6 +199,7 @@ let string_of_election_file = function
| ESCreds -> "public_creds.txt"
| ESBallots -> "ballots.jsons"
| ESRecords -> "records"
| ESETally -> "encrypted_tally.json"
let election_file = Eliom_parameter.user_type
~of_string:election_file_of_string
......
......@@ -76,6 +76,7 @@ type election_file =
| ESCreds
| ESBallots
| ESRecords
| ESETally
val election_file_of_string : string -> election_file
val string_of_election_file : election_file -> string
......
......@@ -238,6 +238,23 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
do_write_creds ()
)
let compute_encrypted_tally () =
lwt num_tallied, tally =
Ocsipersist.fold_step
(fun _ rawballot (n, accu) ->
let ballot = ballot_of_string G.read rawballot in
let ciphertext = E.extract_ciphertext ballot in
return (n + 1, E.combine_ciphertexts accu ciphertext))
Ballots.table (0, E.neutral_ciphertext election)
in
let tally = string_of_encrypted_tally G.write tally in
Lwt_mutex.with_lock mutex (fun () ->
do_write ESETally (fun oc ->
Lwt_io.write oc tally
)
) >>
return (num_tallied, sha256_b64 tally)
end
end
......
......@@ -22,6 +22,12 @@
open Lwt
open Common
type election_state =
[ `Open
| `Closed
| `EncryptedTally of int * string
]
let election_states = Ocsipersist.open_table "election_states"
let get_election_state x =
......
......@@ -19,8 +19,13 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
val get_election_state : string -> [ `Open | `Closed ] Lwt.t
val set_election_state : string -> [ `Open | `Closed ] -> unit Lwt.t
type election_state =
[ `Open
| `Closed
| `EncryptedTally of int * string
]
val get_election_state : string -> election_state Lwt.t
val set_election_state : string -> election_state -> unit Lwt.t
val get_main_election : unit -> string option Lwt.t
val set_main_election : string -> unit Lwt.t
......
......@@ -70,6 +70,8 @@ let election_pretty_ballots = service ~path:["elections"] ~get_params:(suffix_pr
let election_pretty_ballot = service ~path:["elections"] ~get_params:(suffix_prod (uuid "uuid" ** suffix_const "ballot") (string "hash")) ()
let election_dir = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** election_file "file")) ()
let election_compute_encrypted_tally = post_coservice ~csrf_safe:true ~fallback:election_admin ~post_params:unit ()
let scope = Eliom_common.default_session_scope
let cont : (unit -> service_handler) Eliom_reference.eref =
......
......@@ -97,6 +97,10 @@ module type WEB_BALLOT_BOX = sig
val inject_cred : string -> unit Lwt.t
val update_files : unit -> unit Lwt.t
val update_cred : old:string -> new_:string -> unit Lwt.t
val compute_encrypted_tally : unit -> (int * string) Lwt.t
(** Computes and writes to disk the encrypted tally. Returns the
number of ballots and the hash of the encrypted tally. *)
end
module type WEB_PARAMS = sig
......
......@@ -745,12 +745,19 @@ let () =
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
match_lwt Web_site_auth.get_user () with
| Some u when W.metadata.e_owner = Some u ->
let state = if state then `Open else `Closed in
Web_persist.set_election_state uuid_s state >>
Redirection.send (preapply election_admin (uuid, ()))
| _ -> forbidden ())
lwt () =
match_lwt Web_site_auth.get_user () with
| Some u when W.metadata.e_owner = Some u -> return ()
| _ -> forbidden ()
in
lwt () =
match_lwt Web_persist.get_election_state uuid_s with
| `Open | `Closed -> return ()
| _ -> forbidden ()
in
let state = if state then `Open else `Closed in
Web_persist.set_election_state uuid_s state >>
Redirection.send (preapply election_admin (uuid, ())))
let () =
Any.register
......@@ -970,7 +977,7 @@ let () =
) else forbidden ())
let content_type_of_file = function
| ESRaw | ESKeys | ESBallots -> "application/json"
| ESRaw | ESKeys | ESBallots | ESETally -> "application/json"
| ESCreds | ESRecords -> "text/plain"
let handle_pseudo_file w u f site_user =
......@@ -1001,3 +1008,24 @@ let () =
in
Eliom_reference.set Web_services.cont cont >>
handle_pseudo_file w () f site_user)
let () =
Any.register
~service:election_compute_encrypted_tally
(fun (uuid, ()) () ->
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
lwt () =
match_lwt Web_site_auth.get_user () with
| Some u when W.metadata.e_owner = Some u -> return ()
| _ -> forbidden ()
in
lwt () =
match_lwt Web_persist.get_election_state uuid_s with
| `Closed -> return ()
| _ -> forbidden ()
in
lwt x = W.B.compute_encrypted_tally () in
Web_persist.set_election_state uuid_s (`EncryptedTally x) >>
Redirection.send (preapply election_admin (uuid, ())))
......@@ -577,12 +577,26 @@ let election_home w state () =
]
in
let state =
if state = `Closed then
match state with
| `Closed ->
[
pcdata " ";
b [pcdata "This election is currently closed."];
]
else []
| `Open -> []
| `EncryptedTally (_, hash) ->
[
pcdata " ";
b [pcdata "The election is closed and being tallied."];
pcdata " The ";
a
~service:election_dir
[pcdata "encrypted tally"]
(W.election.e_params.e_uuid, ESETally);
pcdata " hash is ";
b [pcdata hash];
pcdata ".";
]
in
let ballots_link =
p ~a:[a_style "text-align:center;"] [
......@@ -653,8 +667,7 @@ let election_admin w ~is_featured state auth () =
string_input ~input_type:`Submit ~value:"Apply" ();
]) (W.election.e_params.e_uuid, ())
in
let state_form =
let checked = state = `Open in
let state_form checked =
post_form
~service:election_set_state
(fun name ->
......@@ -664,6 +677,36 @@ let election_admin w ~is_featured state auth () =
string_input ~input_type:`Submit ~value:"Apply" ();
]) (W.election.e_params.e_uuid, ())
in
let state_div =
match state with
| `Open ->
div [
state_form true;
]
| `Closed ->
div [
state_form false;
post_form
~service:election_compute_encrypted_tally
(fun () ->
[string_input
~input_type:`Submit
~value:"Compute encrypted tally"
()
]) (W.election.e_params.e_uuid, ());
]
| `EncryptedTally (_, hash) ->
div [
pcdata "The ";
a
~service:election_dir
[pcdata "encrypted tally"]
(W.election.e_params.e_uuid, ESETally);
pcdata " has been computed. Its hash is ";
b [pcdata hash];
pcdata ".";
]
in
let uuid = W.election.e_params.e_uuid in
let content = [
div [
......@@ -676,7 +719,7 @@ let election_admin w ~is_featured state auth () =
a ~service:election_dir [pcdata "Voting records"] (uuid, ESRecords);
];
div [feature_form];
div [state_form];
div [state_div];
] in
lwt login_box = site_login_box auth () in
base ~title ~login_box ~content ()
......
......@@ -35,8 +35,8 @@ val election_setup_questions : Uuidm.t -> Web_common.setup_election -> (module A
val election_setup_credentials : string -> string -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_trustee : string -> string -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_home : (module WEB_ELECTION) -> [ `Open | `Closed ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_admin : (module WEB_ELECTION) -> is_featured:bool -> [ `Open | `Closed ] -> (module AUTH_SERVICES) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_home : (module WEB_ELECTION) -> Web_persist.election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_admin : (module WEB_ELECTION) -> is_featured:bool -> Web_persist.election_state -> (module AUTH_SERVICES) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val update_credential : (module WEB_ELECTION) -> (module AUTH_SERVICES) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_raw : (module WEB_ELECTION) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_confirmation : (module WEB_ELECTION) -> can_vote:bool -> string -> 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