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

Ocsipersist_ballotbox: check ballots

parent 9097cf39
open Util
open Serializable_t
module MakeBallotBox (G : Signatures.GROUP)
(U : sig val uuid : Uuidm.t end) = struct
module MakeLwtRandom (G : Signatures.GROUP) = struct
type 'a t = 'a Lwt.t
let return = Lwt.return
let bind = Lwt.bind
let fail = Lwt.fail
let suffix = "_" ^ String.map (function
| '-' -> '_'
| c -> c
) (Uuidm.to_string U.uuid)
let ballot_table = Ocsipersist.open_table ("ballots" ^ suffix)
let record_table = Ocsipersist.open_table ("records" ^ suffix)
let prng = Lwt_preemptive.detach (fun () ->
Cryptokit.Random.(pseudo_rng (string secure_rng 16))
) ()
......@@ -26,12 +18,42 @@ module MakeBallotBox (G : Signatures.GROUP)
let r = Cryptokit.Random.string prng size in
return Z.(of_bits r mod q)
end
exception Serialization of exn
exception ProofCheck
module type LWT_ELECTION = Signatures.ELECTION
with type elt = Z.t
and type 'a m = 'a Lwt.t
module MakeBallotBox (E : LWT_ELECTION) = struct
let suffix = "_" ^ String.map (function
| '-' -> '_'
| c -> c
) (Uuidm.to_string E.election_params.e_uuid)
let ballot_table = Ocsipersist.open_table ("ballots" ^ suffix)
let record_table = Ocsipersist.open_table ("records" ^ suffix)
type ballot = string
type record = string * Serializable_builtin_t.datetime
let cast b (user, date) =
Ocsipersist.add ballot_table (Common.hashB b) b >>
Ocsipersist.add record_table user date
let cast rawballot (user, date) =
lwt ballot =
try Lwt.return (
Serializable_j.ballot_of_string
Serializable_builtin_j.read_number rawballot
) with e -> Lwt.fail (Serialization e)
in
if E.check_ballot ballot then (
Ocsipersist.add ballot_table (Common.hashB rawballot) rawballot >>
Ocsipersist.add record_table user date
) else (
Lwt.fail ProofCheck
)
let fold_ballots f x =
Ocsipersist.fold_step (fun k v x -> f v x) ballot_table x
......
(** Ocsipersist-based ballot box *)
module MakeBallotBox (G : Signatures.GROUP)
(U : sig val uuid : Uuidm.t end) : sig
module MakeLwtRandom (G : Signatures.GROUP) : sig
(** {2 Monadic definitions} *)
......@@ -12,11 +11,22 @@ module MakeBallotBox (G : Signatures.GROUP)
val random : Z.t -> Z.t t
(** [random q] returns a random number modulo [q]. It uses a secure
random number generator initialized by a 128-bit seed. *)
end
(** Lwt-compatible random number generation. *)
exception Serialization of exn
exception ProofCheck
module type LWT_ELECTION = Signatures.ELECTION
with type elt = Z.t
and type 'a m = 'a Lwt.t
module MakeBallotBox (E : LWT_ELECTION) : sig
(** {2 Ballot box management} *)
include Signatures.BALLOT_BOX
with type 'a m := 'a t
with type 'a m := 'a Lwt.t
and type ballot = string
and type record = string * Serializable_builtin_t.datetime
end
......
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