Commit 789b20c1 authored by Stephane Glondu's avatar Stephane Glondu

Changes in metadata handling

 - metadata is specific to web, move it there
 - create Web_serializable, and also move randomness there
 - metadata is not optional (but its components can be)
 - rename user_type into user_domain
 - serializable version of ACLs
parent de36fb96
......@@ -163,19 +163,12 @@ module RunTool (G : Election.FF_GROUP) (P : PARAMS) = struct
(* Finish setting up the election *)
let metadata =
match (load_from_file Serializable_j.metadata_of_string "metadata.json") with
| Some [m] -> Some m
| Some _ -> failwith "invalid metadata.json"
| None -> None
let pks = match public_keys with
| Some pks -> pks
| None -> failwith "missing public keys"
let e = {
e_params = { params with e_public_key = P.y };
e_meta = metadata;
e_pks = Some pks;
e_fingerprint = election_fingerprint;
}
......
......@@ -132,16 +132,3 @@ type 'a result = {
partial_decryptions : 'a partial_decryption list <ocaml repr="array">;
result : plaintext;
}
(** {1 Other datastructures} *)
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;
?voters_list : string list option;
} <ocaml field_prefix="e_">
......@@ -110,9 +110,6 @@ type 'a election = {
e_params : 'a Serializable_t.params;
(** Parameters of the election. *)
e_meta : Serializable_t.metadata option;
(** Other optional, serializable, metadata. *)
e_pks : 'a array option;
(** Trustee public keys. *)
......
......@@ -21,11 +21,13 @@
open Lwt
open Util
open Serializable_t
open Web_serializable_t
open Web_signatures
open Web_common
let string_of_user {user_type; user_name} =
user_type ^ ":" ^ user_name
let string_of_user {user_domain; user_name} =
user_domain ^ ":" ^ user_name
type instantiator = string -> (module AUTH_SERVICE) -> unit
......@@ -49,12 +51,12 @@ module Make (X : EMPTY) = struct
~scope:Eliom_common.default_session_scope
None
let on_success user_admin user_type ~user_name ~user_logout =
let user_user = {user_type; user_name} in
let on_success user_admin user_domain ~user_name ~user_logout =
let user_user = {user_domain; user_name} in
let logged_user = {user_admin; user_user; user_logout} in
security_log (fun () ->
Printf.sprintf "%s successfully logged in%s using %s"
user_name (if user_admin then " (as admin)" else "") user_type
user_name (if user_admin then " (as admin)" else "") user_domain
) >>
Eliom_reference.set user (Some logged_user)
......
......@@ -19,6 +19,8 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Serializable_t
open Web_serializable_t
open Web_signatures
val string_of_user : user -> string
......
......@@ -22,6 +22,7 @@
open Signatures
open Util
open Serializable_t
open Web_serializable_j
open Lwt
open Web_common
open Web_signatures
......@@ -36,6 +37,11 @@ module E = Election.MakeElection(G)(M)
module EMap = Map.Make(Uuidm)
module AclSet = Set.Make(struct
type t = Web_serializable_t.acl
let compare = compare
end)
let ( / ) = Filename.concat
let file_exists x =
......@@ -151,9 +157,8 @@ lwt election_table =
if b then (
Lwt_io.chars_of_file fname |>
Lwt_stream.to_string >>=
wrap1 Serializable_j.metadata_of_string >>=
(fun x -> return (Some x))
) else return None
wrap1 metadata_of_string
) else return empty_metadata
in
let public_creds_fname = path/"public_creds.txt" in
lwt public_creds =
......@@ -162,17 +167,19 @@ lwt election_table =
return (SSet.add c accu)
)
in
let can_vote = match metadata with
let can_vote = match metadata.e_voters with
| None -> Any
| Some m -> match m.e_voters_list with
| None -> Any
| Some voters ->
let set = List.fold_left (fun accu u ->
SSet.add u accu
) SSet.empty voters in
Restricted (fun u ->
return (SSet.mem (Auth_common.string_of_user u) set)
| Some acls ->
let set = List.fold_left (fun accu u ->
AclSet.add u accu
) AclSet.empty acls in
Restricted (fun u ->
return (
AclSet.mem `Any set ||
AclSet.mem (`Domain u.user_domain) set ||
AclSet.mem (`User u) set
)
)
in
let election_web = Web_election.({
params_fname;
......@@ -323,7 +330,7 @@ module SSite = struct
(fun () () ->
lwt r = do_get_randomness () in
Cryptokit.(transform_string (Base64.encode_compact ()) r) |>
(fun x -> Serializable_j.string_of_randomness { randomness=x }) |>
(fun x -> string_of_randomness { randomness=x }) |>
(fun x -> return (x, "application/json"))
)
......
Util
Serializable_builtin_j
Serializable_j
Web_serializable_j
Web_common
Auth_common
Auth_dummy
......
......@@ -206,18 +206,32 @@ module Make (S : Web_signatures.ALL_SERVICES) = struct
pcdata " vote in this election.";
]
in
let voting_period = match election.election.e_meta with
| Some m ->
let voting_period =
let m = election.metadata in
match m.e_voting_starts_at, m.e_voting_ends_at with
| None, None ->
[
pcdata "This election starts and ends at the administrator's discretion."
]
| Some s, None ->
[
pcdata "This election starts on ";
em [pcdata (format_date m.e_voting_starts_at)];
pcdata " and ends on ";
em [pcdata (format_date m.e_voting_ends_at)];
em [pcdata (format_date s)];
pcdata " and ends at the administrator's discretion.";
]
| None, Some s ->
[
pcdata "This election starts at the administrator's discretion and ends on ";
em [pcdata (format_date s)];
pcdata ".";
]
| None ->
| Some s, Some e ->
[
pcdata "This election starts and ends at the administrator's discretion."
pcdata "This election starts on ";
em [pcdata (format_date s)];
pcdata " and ends on ";
em [pcdata (format_date e)];
pcdata ".";
]
in
let audit_info = div [
......
......@@ -24,6 +24,7 @@ open Lwt
open Util
open Serializable_builtin_t
open Serializable_t
open Web_serializable_t
let enforce_single_element s =
let open Lwt_stream in
......@@ -145,3 +146,11 @@ let set_rewrite_prefix ~src ~dst =
dst ^ String.sub x nsrc (n-nsrc)
else x
in rewrite_fun := f
let empty_metadata = {
e_voting_starts_at = None;
e_voting_ends_at = None;
e_readers = None;
e_voters = None;
e_owner = None;
}
......@@ -21,6 +21,7 @@
open Serializable_builtin_t
open Serializable_t
open Web_serializable_t
val make_rng : unit -> Cryptokit.Random.rng Lwt.t
(** Create a pseudo random number generator initialized by a 128-bit
......@@ -64,3 +65,5 @@ val forbidden : unit -> 'a Lwt.t
val rewrite_prefix : string -> string
val set_rewrite_prefix : src:string -> dst:string -> unit
val empty_metadata : metadata
......@@ -25,9 +25,10 @@ open Lwt
open Util
open Serializable_builtin_t
open Serializable_t
open Web_serializable_t
open Web_common
let make_web_election raw_election e_meta election_web =
let make_web_election raw_election metadata election_web =
let e_fingerprint = sha256_b64 raw_election in
let wrapped_params = Serializable_j.params_of_string
......@@ -36,7 +37,7 @@ let make_web_election raw_election e_meta election_web =
let {ffpk_g = g; ffpk_p = p; ffpk_q = q; ffpk_y = y} = wrapped_params.e_public_key in
let group = {g; p; q} in
let e_params = { wrapped_params with e_public_key = y } in
let election = {e_params; e_meta; e_pks = None; e_fingerprint} in
let election = {e_params; e_pks = None; e_fingerprint} in
let module X : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t = struct
type elt = Z.t
......@@ -96,13 +97,15 @@ let make_web_election raw_election e_meta election_web =
)
let do_cast rawballot (user, date) =
let voting_open = match election.e_meta with
| Some m ->
let date = fst date in
let voting_open =
let compare a b =
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
match a, b with
| Some a, Some b -> compare (fst a) (fst b)
| _, _ -> -1
in
compare metadata.e_voting_starts_at (Some date) <= 0 &&
compare (Some date) metadata.e_voting_ends_at < 0
in
if not voting_open then fail ElectionClosed else return () >>
if String.contains rawballot '\n' then (
......@@ -200,5 +203,6 @@ let make_web_election raw_election e_meta election_web =
{
modules = (module X : WEB_BALLOT_BOX_BUNDLE with type elt = Z.t);
election;
metadata;
election_web;
}
......@@ -21,10 +21,11 @@
open Serializable_builtin_t
open Serializable_t
open Web_serializable_t
open Web_signatures
val make_web_election :
string ->
metadata option ->
metadata ->
election_web ->
Z.t web_election
(**************************************************************************)
(* BELENIOS *)
(* *)
(* Copyright © 2012-2014 Inria *)
(* *)
(* This program is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Affero General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version, with the additional *)
(* exemption that compiling, linking, and/or using OpenSSL is allowed. *)
(* *)
(* This program is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
(* Affero General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU Affero General Public *)
(* License along with this program. If not, see *)
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
<doc text="Web-specific serializable datatypes">
(** {1 Predefined types} *)
type datetime <ocaml predef from="Serializable_builtin"> = abstract
(** {1 Web-specific types} *)
type randomness = {
randomness : string;
}
<doc text="Randomness generated by the server sent to the client.">
type user = {
domain : string;
name : string;
} <ocaml field_prefix="user_">
type acl =
[ Any
| Domain of string
| User of user
]
type metadata = {
?voting_starts_at : datetime option;
?voting_ends_at : datetime option;
?readers : acl list option;
?voters : acl list option;
?owner: user option;
} <ocaml field_prefix="e_">
......@@ -20,6 +20,8 @@
(**************************************************************************)
open Serializable_builtin_t
open Serializable_t
open Web_serializable_t
open Signatures
module type EMPTY = sig end
......@@ -194,11 +196,6 @@ module type CONT_SERVICE = sig
Eliom_service.service Lwt.t
end
type user = {
user_type : string;
user_name : string;
}
type logged_user = {
user_admin : bool;
user_user : user;
......@@ -281,6 +278,7 @@ end
type 'a web_election = {
modules : (module WEB_BALLOT_BOX_BUNDLE with type elt = 'a);
election : 'a election;
metadata : metadata;
election_web : election_web;
}
......
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