Une MAJ de sécurité est nécessaire sur notre version actuelle. Elle sera effectuée lundi 02/08 entre 12h30 et 13h. L'interruption de service devrait durer quelques minutes (probablement moins de 5 minutes).

Commit d8467999 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Rename BALLOT_BOX into MONADIC_MAP_RO

It is used for ballots as well as records...
parent 02259d1f
...@@ -218,7 +218,7 @@ module RunTool (G : Election.FF_GROUP) (P : PARAMS) = struct ...@@ -218,7 +218,7 @@ module RunTool (G : Election.FF_GROUP) (P : PARAMS) = struct
match ballots with match ballots with
| None -> failwith "ballots.jsons is missing" | None -> failwith "ballots.jsons is missing"
| Some _ -> | Some _ ->
M.fold_ballots (fun () b t -> M.fold (fun () b t ->
M.return (E.combine_ciphertexts (E.extract_ciphertext b) t) M.return (E.combine_ciphertexts (E.extract_ciphertext b) t)
) (E.neutral_ciphertext e) () ) (E.neutral_ciphertext e) ()
) )
...@@ -292,7 +292,7 @@ module RunTool (G : Election.FF_GROUP) (P : PARAMS) = struct ...@@ -292,7 +292,7 @@ module RunTool (G : Election.FF_GROUP) (P : PARAMS) = struct
| Some factors -> | Some factors ->
let tally = Lazy.force encrypted_tally in let tally = Lazy.force encrypted_tally in
assert (Array.forall2 (E.check_factor tally) pks factors); assert (Array.forall2 (E.check_factor tally) pks factors);
let result = E.combine_factors (M.turnout ()) tally factors in let result = E.combine_factors (M.cardinal ()) tally factors in
assert (E.check_result e result); assert (E.check_result e result);
if do_finalize then ( if do_finalize then (
save_to "result.json" ( save_to "result.json" (
......
...@@ -109,10 +109,10 @@ module MakeSimpleMonad (G : GROUP) = struct ...@@ -109,10 +109,10 @@ module MakeSimpleMonad (G : GROUP) = struct
let r = Cryptokit.Random.string (Lazy.force prng) size in let r = Cryptokit.Random.string (Lazy.force prng) size in
Z.(of_bits r mod q) Z.(of_bits r mod q)
type ballot = G.t Serializable_t.ballot type elt = G.t Serializable_t.ballot
let cast x () = ballots := x :: !ballots let cast x () = ballots := x :: !ballots
let fold_ballots f x () = List.fold_left (fun accu b -> f () b accu ()) x !ballots let fold f x () = List.fold_left (fun accu b -> f () b accu ()) x !ballots
let turnout () = List.length !ballots let cardinal () = List.length !ballots
end end
(** Distributed key generation *) (** Distributed key generation *)
......
...@@ -57,12 +57,12 @@ module MakeSimpleMonad (G : GROUP) : sig ...@@ -57,12 +57,12 @@ module MakeSimpleMonad (G : GROUP) : sig
(** {2 Ballot box management} *) (** {2 Ballot box management} *)
include Signatures.BALLOT_BOX include Signatures.MONADIC_MAP_RO
with type 'a m := 'a t with type 'a m := 'a t
and type ballot = G.t Serializable_t.ballot and type elt = G.t Serializable_t.ballot
and type receipt := unit and type key := unit
val cast : ballot -> unit t val cast : elt -> unit t
end end
(** Simple election monad that keeps all ballots in memory. *) (** Simple election monad that keeps all ballots in memory. *)
......
...@@ -86,27 +86,23 @@ module type RANDOM = sig ...@@ -86,27 +86,23 @@ module type RANDOM = sig
(** [random q] returns a random number modulo [q]. *) (** [random q] returns a random number modulo [q]. *)
end end
(** Ballot box. *) (** Read operations of a monadic map. *)
module type BALLOT_BOX = sig module type MONADIC_MAP_RO = sig
type 'a m type 'a m
(** The type of monadic values. *) (** The type of monadic values. *)
(** {2 Election-specific operations} *) type elt
(** The type of map values. *)
type ballot
(** The type of ballots. The monad is supposed to keep track of all
cast ballots (e.g. in a database). *)
type receipt type key
(** The type of receipts. This is something the voter gets after (** The type of map keys. *)
casting a ballot to check his vote later. *)
val fold_ballots : (receipt -> ballot -> 'a -> 'a m) -> 'a -> 'a m val fold : (key -> elt -> 'a -> 'a m) -> 'a -> 'a m
(** [fold_ballots f a] computes [(f rN bN ... (f r2 b2 (f r1 b1 a))...)], (** [fold f a] computes [(f kN vN ... (f k2 v2 (f k1 v1 a))...)],
where [r1,b1 ... rN,bN] are all cast ballots. *) where [k1/v1 ... kN/vN] are all key/value pairs. *)
val turnout : int m val cardinal : int m
(** Number of cast ballots. *) (** Return the number of bindings. *)
end end
(** Parameters for an election. *) (** Parameters for an election. *)
...@@ -231,6 +227,10 @@ module type ELECTION_BUNDLE = sig ...@@ -231,6 +227,10 @@ module type ELECTION_BUNDLE = sig
end end
module type BALLOT_BOX_BUNDLE = sig module type BALLOT_BOX_BUNDLE = sig
type receipt
type ballot
include ELECTION_BUNDLE include ELECTION_BUNDLE
include BALLOT_BOX with type 'a m = 'a E.m include MONADIC_MAP_RO with type 'a m = 'a E.m
and type elt := ballot
and type key := receipt
end end
...@@ -539,7 +539,7 @@ let f_ballots uuid election user () = ...@@ -539,7 +539,7 @@ let f_ballots uuid election user () =
let open Web_common in let open Web_common in
let module X = (val election.modules : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t) in let module X = (val election.modules : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t) in
(* TODO: streaming *) (* TODO: streaming *)
lwt ballots = X.B.Ballots.fold_ballots (fun _ x xs -> lwt ballots = X.B.Ballots.fold (fun _ x xs ->
return ((x^"\n")::xs) return ((x^"\n")::xs)
) [] in ) [] in
let s = List.map (fun b () -> let s = List.map (fun b () ->
...@@ -552,7 +552,7 @@ let f_records uuid election user () = ...@@ -552,7 +552,7 @@ let f_records uuid election user () =
let open Web_common in let open Web_common in
let module X = (val election.modules : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t) in let module X = (val election.modules : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t) in
(* TODO: streaming *) (* TODO: streaming *)
lwt ballots = X.B.Records.fold_ballots (fun u (d, _) xs -> lwt ballots = X.B.Records.fold (fun u (d, _) xs ->
let x = Printf.sprintf "%s %S\n" let x = Printf.sprintf "%s %S\n"
(Serializable_builtin_j.string_of_datetime d) u (Serializable_builtin_j.string_of_datetime d) u
in return (x::xs) in return (x::xs)
......
...@@ -158,14 +158,14 @@ let security_log s = ...@@ -158,14 +158,14 @@ let security_log s =
) ic ) ic
module type WEB_BALLOT_BOX = sig module type WEB_BALLOT_BOX = sig
module Ballots : Signatures.BALLOT_BOX module Ballots : Signatures.MONADIC_MAP_RO
with type 'a m = 'a Lwt.t with type 'a m = 'a Lwt.t
and type ballot = string and type elt = string
and type receipt = string and type key = string
module Records : Signatures.BALLOT_BOX module Records : Signatures.MONADIC_MAP_RO
with type 'a m = 'a Lwt.t with type 'a m = 'a Lwt.t
and type ballot = Serializable_builtin_t.datetime * string and type elt = Serializable_builtin_t.datetime * string
and type receipt = string and type key = string
val cast : string -> string * datetime -> string Lwt.t val cast : string -> string * datetime -> string Lwt.t
val inject_creds : SSet.t -> unit Lwt.t val inject_creds : SSet.t -> unit Lwt.t
...@@ -214,20 +214,20 @@ let make_web_election raw_election e_meta election_web = ...@@ -214,20 +214,20 @@ let make_web_election raw_election e_meta election_web =
module Ballots = struct module Ballots = struct
type 'a m = 'a Lwt.t type 'a m = 'a Lwt.t
type ballot = string type elt = string
type receipt = string type key = string
let table = Ocsipersist.open_table ("ballots" ^ suffix) let table = Ocsipersist.open_table ("ballots" ^ suffix)
let turnout = Ocsipersist.length table let cardinal = Ocsipersist.length table
let fold_ballots f x = Ocsipersist.fold_step f table x let fold f x = Ocsipersist.fold_step f table x
end end
module Records = struct module Records = struct
type 'a m = 'a Lwt.t type 'a m = 'a Lwt.t
type ballot = Serializable_builtin_t.datetime * string type elt = Serializable_builtin_t.datetime * string
type receipt = string type key = string
let table = Ocsipersist.open_table ("records" ^ suffix) let table = Ocsipersist.open_table ("records" ^ suffix)
let turnout = Ocsipersist.length table let cardinal = Ocsipersist.length table
let fold_ballots f x = Ocsipersist.fold_step f table x let fold f x = Ocsipersist.fold_step f table x
end end
let cred_table = Ocsipersist.open_table ("creds" ^ suffix) let cred_table = Ocsipersist.open_table ("creds" ^ suffix)
......
...@@ -76,14 +76,14 @@ exception Error of error ...@@ -76,14 +76,14 @@ exception Error of error
val explain_error : error -> string val explain_error : error -> string
module type WEB_BALLOT_BOX = sig module type WEB_BALLOT_BOX = sig
module Ballots : Signatures.BALLOT_BOX module Ballots : Signatures.MONADIC_MAP_RO
with type 'a m = 'a Lwt.t with type 'a m = 'a Lwt.t
and type ballot = string and type elt = string
and type receipt = string and type key = string
module Records : Signatures.BALLOT_BOX module Records : Signatures.MONADIC_MAP_RO
with type 'a m = 'a Lwt.t with type 'a m = 'a Lwt.t
and type ballot = Serializable_builtin_t.datetime * string and type elt = Serializable_builtin_t.datetime * string
and type receipt = string and type key = string
val cast : string -> string * datetime -> string Lwt.t val cast : string -> string * datetime -> string Lwt.t
val inject_creds : SSet.t -> unit Lwt.t val inject_creds : SSet.t -> unit 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