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

Add optional metadata to store voting period

parent d9b33502
......@@ -4,6 +4,7 @@
type number <ocaml predef from="Serializable_builtin"> = abstract
type uuid <ocaml predef from="Serializable_builtin"> = abstract
type datetime <ocaml predef from="Serializable_builtin"> = abstract
(** {2 Basic cryptographic datastructures} *)
......@@ -89,3 +90,8 @@ type randomness = {
randomness : string;
}
<doc text="Randomness generated by the server sent to the client.">
type metadata = {
voting_starts_at : datetime;
voting_ends_at : datetime;
} <ocaml field_prefix="e_">
......@@ -96,7 +96,10 @@ module type ELECTION_PARAMS = sig
here, or at least monadify. *)
val params : G.t Serializable_t.election
(** Other parameters. *)
(** Parameters of the election. *)
val metadata : Serializable_t.metadata option
(** Other optional metadata. *)
val fingerprint : string
(** The election fingerprint. *)
......
......@@ -74,17 +74,29 @@ lwt election_table =
Election.finite_field ~p ~q ~g :
Signatures.GROUP with type t = Z.t
) in
lwt metadata =
let fn = path/"metadata.json" in
lwt b = file_exists fn in
if b then (
Lwt_io.chars_of_file fn |>
Lwt_stream.to_string >>=
wrap1 Serializable_j.metadata_of_string >>=
(fun x -> return (Some x))
) else return None
in
let module P = struct
module G = G
let public_keys = lazy (assert false)
let params = { election with e_public_key = y }
let fingerprint = fingerprint
let metadata = metadata
end in
let module X : Web_common.WEB_ELECTION = struct
module G = G
module M = Web_common.MakeLwtRandom(G)
module P = P
module E = Election.MakeElection(P)(M)
module B = Web_common.MakeBallotBox(E)
module B = Web_common.MakeBallotBox(P)(E)
let data = election_data
end in
let uuid = election.e_uuid in
......@@ -289,8 +301,7 @@ let () = Eliom_registration.Html5.register
(if_eligible can_read
(fun uuid election user () ->
Eliom_reference.set Services.saved_service (Services.Election uuid) >>
let module X = (val election : Web_common.WEB_ELECTION) in
Templates.election_view ~election:X.data ~user
Templates.election_view ~election ~user
)
)
......
......@@ -147,6 +147,8 @@ let dummy_login ~service =
base ~title:"Login" ~content
let election_view ~election ~user =
let module X = (val election : Web_common.WEB_ELECTION) in
let election = X.data in
let service = Services.(preapply_uuid election_raw election) in
lwt permissions =
let open Web_common in
......@@ -168,6 +170,20 @@ let election_view ~election ~user =
pcdata " vote in this election.";
]
in
let voting_period = match X.P.metadata with
| Some m ->
[
pcdata "This election starts at ";
pcdata (Serializable_builtin_j.string_of_datetime m.e_voting_starts_at);
pcdata " and ends at ";
pcdata (Serializable_builtin_j.string_of_datetime m.e_voting_starts_at);
pcdata ".";
]
| None ->
[
pcdata "This election starts and ends at the administrator's discretion."
]
in
let audit_info = div [
h2 [pcdata "Audit Info"];
div [
......@@ -193,6 +209,7 @@ let election_view ~election ~user =
let content = [
h1 [ pcdata election.Web_common.election.e_name ];
p [pcdata election.Web_common.election.e_description];
p voting_period;
div [
div [
a ~service:(Services.(preapply_uuid election_vote election)) [
......
open Lwt
open Util
open Serializable_builtin_t
open Serializable_t
type user_type = Dummy | CAS
......@@ -69,6 +70,7 @@ end
exception Serialization of exn
exception ProofCheck
exception ElectionClosed
module type LWT_ELECTION = Signatures.ELECTION
with type elt = Z.t
......@@ -78,10 +80,12 @@ module type WEB_BBOX = sig
include Signatures.BALLOT_BOX
with type 'a m := 'a Lwt.t
and type ballot = string
and type record = string * Serializable_builtin_t.datetime
and type record = string * datetime
end
module MakeBallotBox (E : LWT_ELECTION) = struct
module MakeBallotBox (P : Signatures.ELECTION_PARAMS) (E : LWT_ELECTION) = struct
(* TODO: enforce E is derived from P *)
let suffix = "_" ^ String.map (function
| '-' -> '_'
......@@ -95,6 +99,15 @@ module MakeBallotBox (E : LWT_ELECTION) = struct
type record = string * Serializable_builtin_t.datetime
let cast rawballot (user, date) =
let voting_open = match P.metadata with
| Some m ->
let date = fst date in
let open CalendarLib.Fcalendar.Precise in
compare (fst m.e_voting_starts_at) date <= 0 &&
compare date (fst m.e_voting_ends_at) < 0
| None -> true
in
if not voting_open then fail ElectionClosed else return () >>
lwt ballot =
try Lwt.return (
Serializable_j.ballot_of_string
......@@ -120,6 +133,7 @@ end
module type WEB_ELECTION = sig
module G : Signatures.GROUP
module P : Signatures.ELECTION_PARAMS
module E : LWT_ELECTION
module B : WEB_BBOX
val data : election_data
......
open Serializable_builtin_t
open Serializable_t
type user_type = Dummy | CAS
......@@ -40,6 +41,7 @@ end
exception Serialization of exn
exception ProofCheck
exception ElectionClosed
module type LWT_ELECTION = Signatures.ELECTION
with type elt = Z.t
......@@ -49,13 +51,14 @@ module type WEB_BBOX = sig
include Signatures.BALLOT_BOX
with type 'a m := 'a Lwt.t
and type ballot = string
and type record = string * Serializable_builtin_t.datetime
and type record = string * datetime
end
module MakeBallotBox (E : LWT_ELECTION) : WEB_BBOX
module MakeBallotBox (P : Signatures.ELECTION_PARAMS) (E : LWT_ELECTION) : WEB_BBOX
module type WEB_ELECTION = sig
module G : Signatures.GROUP
module P : Signatures.ELECTION_PARAMS
module E : LWT_ELECTION
module B : WEB_BBOX
val data : election_data
......
......@@ -107,6 +107,7 @@ let check_legacy e =
module G =
(val Election.finite_field ~g ~p ~q : Signatures.GROUP with type t = Z.t)
let params = Serializable_compat.election e.election
let metadata = None
let fingerprint = e.fingerprint
let public_keys = Lazy.lazy_from_val (
e.trustee_public_keys |>
......@@ -172,6 +173,7 @@ let verbose_verify_election_test_data e =
module G =
(val Election.finite_field ~g ~p ~q : Signatures.GROUP with type t = Z.t)
let params = Serializable_compat.election e.election
let metadata = None
let fingerprint = e.fingerprint
let public_keys = Lazy.lazy_from_val (
e.trustee_public_keys |>
......@@ -274,6 +276,7 @@ module P = struct
module G =
(val Election.finite_field ~g ~p ~q : Signatures.GROUP with type t = Z.t)
let params = Serializable_compat.election e.election
let metadata = None
let fingerprint = e.fingerprint
let public_keys = Lazy.lazy_from_val (
e.trustee_public_keys |>
......
......@@ -67,9 +67,19 @@ let election = {
e_short_name = "test";
};;
let metadata =
let open CalendarLib.Fcalendar.Precise in
let now = now () in
{
e_voting_starts_at = add now Period.(day 1), None;
e_voting_ends_at = add now Period.(day 8), None;
}
;;
module P = struct
module G = G
let params = election
let metadata = Some metadata
let public_keys = Lazy.lazy_from_val (
public_keys |> Array.map (fun x -> x.trustee_public_key)
)
......@@ -151,6 +161,7 @@ let save_to_disk () =
let open Serializable_j in
let number = Serializable_builtin_j.write_number in
save_to (dir/"election.json") (write_election write_ff_pubkey) election;
save_to (dir/"metadata.json") write_metadata metadata;
list_save_to (dir/"private_keys.jsons") number private_keys;
list_save_to (dir/"public_keys.jsons") (write_trustee_public_key number) public_keys;
list_save_to (dir/"ballots.jsons") (write_ballot number) ballots;
......
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