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

Move type declarations from Web_election to Web_signatures

parent 1b56c42b
......@@ -163,14 +163,14 @@ lwt election_table =
)
in
let can_vote = match metadata with
| None -> Web_election.Any
| None -> Any
| Some m -> match m.e_voters_list with
| None -> Web_election.Any
| None -> Any
| Some voters ->
let set = List.fold_left (fun accu u ->
SSet.add u accu
) SSet.empty voters in
Web_election.Restricted (fun u ->
Restricted (fun u ->
return (SSet.mem (Auth_common.string_of_user u) set)
)
in
......@@ -220,11 +220,11 @@ let check_acl acl election user =
let if_eligible get_user acl f uuid x =
lwt election = get_election_by_uuid uuid in
lwt user = get_user () in
lwt b = check_acl acl election.Web_election.election_web user in
lwt b = check_acl acl election.election_web user in
if b then f uuid election user x else forbidden ()
let can_read x u = x.Web_election.can_read
let can_vote x u = x.Web_election.can_vote
let can_read x u = x.can_read
let can_vote x u = x.can_vote
module SAuth = Auth_common.Make (struct end)
......@@ -262,11 +262,7 @@ module SSite = struct
end
module Register
(S : ALL_SERVICES)
(T : TEMPLATES with type 'a election = 'a Web_election.web_election)
: EMPTY =
struct
module Register (S : ALL_SERVICES) (T : TEMPLATES) : EMPTY = struct
open Services
open Eliom_registration
......@@ -392,11 +388,7 @@ module SElection = struct
end
module Register
(S : ALL_SERVICES)
(T : TEMPLATES with type 'a election = 'a Web_election.web_election)
: EMPTY =
struct
module Register (S : ALL_SERVICES) (T : TEMPLATES) : EMPTY = struct
open Services
open Eliom_registration
......@@ -509,11 +501,7 @@ module SVoting = struct
end
module Register
(S : ALL_SERVICES)
(T : TEMPLATES with type 'a election = 'a Web_election.web_election)
: EMPTY =
struct
module Register (S : ALL_SERVICES) (T : TEMPLATES) : EMPTY = struct
open Services
open Eliom_registration
......@@ -624,7 +612,7 @@ module S = struct
end
module T = struct
type 'a election = 'a Web_election.web_election
type 'a election = 'a web_election
include Templates.Make (S)
end
......
......@@ -345,7 +345,7 @@ module Make (S : Web_signatures.ALL_SERVICES) = struct
base ~title:name ~content
let do_cast_ballot ~election ~result =
let params = election.Web_election.election.e_params in
let params = election.election.e_params in
let name = params.e_name in
let content = [
h1 [ pcdata name ];
......@@ -367,7 +367,7 @@ module Make (S : Web_signatures.ALL_SERVICES) = struct
base ~title:name ~content
let election_update_credential ~election =
let params = election.Web_election.election.e_params in
let params = election.election.e_params in
let form = post_form ~service:S.election_update_credential
(fun (old, new_) ->
[
......
......@@ -20,54 +20,13 @@
(**************************************************************************)
open Signatures
open Web_signatures
open Lwt
open Util
open Serializable_builtin_t
open Serializable_t
open Web_common
type acl =
| Any
| Restricted of (Web_signatures.user -> bool Lwt.t)
type election_web = {
params_fname : string;
public_keys_fname : string;
featured_p : bool;
can_read : acl;
can_vote : acl;
}
module type WEB_BALLOT_BOX = sig
module Ballots : Signatures.MONADIC_MAP_RO
with type 'a m = 'a Lwt.t
and type elt = string
and type key = string
module Records : Signatures.MONADIC_MAP_RO
with type 'a m = 'a Lwt.t
and type elt = Serializable_builtin_t.datetime * string
and type key = string
val cast : string -> string * datetime -> string Lwt.t
val inject_creds : SSet.t -> unit Lwt.t
val extract_creds : unit -> SSet.t Lwt.t
val update_cred : old:string -> new_:string -> unit Lwt.t
end
module type WEB_ELECTION_BUNDLE =
Signatures.ELECTION_BUNDLE with type 'a E.m = 'a Lwt.t
module type WEB_BALLOT_BOX_BUNDLE = sig
include WEB_ELECTION_BUNDLE
module B : WEB_BALLOT_BOX
end
type 'a web_election = {
modules : (module WEB_BALLOT_BOX_BUNDLE with type elt = 'a);
election : 'a Signatures.election;
election_web : election_web;
}
let make_web_election raw_election e_meta election_web =
let e_fingerprint = sha256_b64 raw_election in
......
......@@ -21,51 +21,10 @@
open Serializable_builtin_t
open Serializable_t
type acl =
| Any
| Restricted of (Web_signatures.user -> bool Lwt.t)
type election_web = {
params_fname : string;
public_keys_fname : string;
featured_p : bool;
can_read : acl;
can_vote : acl;
}
module type WEB_BALLOT_BOX = sig
module Ballots : Signatures.MONADIC_MAP_RO
with type 'a m = 'a Lwt.t
and type elt = string
and type key = string
module Records : Signatures.MONADIC_MAP_RO
with type 'a m = 'a Lwt.t
and type elt = Serializable_builtin_t.datetime * string
and type key = string
val cast : string -> string * datetime -> string Lwt.t
val inject_creds : Util.SSet.t -> unit Lwt.t
val extract_creds : unit -> Util.SSet.t Lwt.t
val update_cred : old:string -> new_:string -> unit Lwt.t
end
module type WEB_ELECTION_BUNDLE =
Signatures.ELECTION_BUNDLE with type 'a E.m = 'a Lwt.t
module type WEB_BALLOT_BOX_BUNDLE = sig
include WEB_ELECTION_BUNDLE
module B : WEB_BALLOT_BOX
end
type 'a web_election = private {
modules : (module WEB_BALLOT_BOX_BUNDLE with type elt = 'a);
election : 'a Signatures.election;
election_web : election_web;
}
open Web_signatures
val make_web_election :
string ->
Serializable_t.metadata option ->
metadata option ->
election_web ->
Z.t web_election
......@@ -19,6 +19,8 @@
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Serializable_builtin_t
module type EMPTY = sig end
module type SITE_SERVICES = sig
......@@ -215,6 +217,47 @@ module type AUTH_SERVICES = sig
end
type acl =
| Any
| Restricted of (user -> bool Lwt.t)
type election_web = {
params_fname : string;
public_keys_fname : string;
featured_p : bool;
can_read : acl;
can_vote : acl;
}
module type WEB_BALLOT_BOX = sig
module Ballots : Signatures.MONADIC_MAP_RO
with type 'a m = 'a Lwt.t
and type elt = string
and type key = string
module Records : Signatures.MONADIC_MAP_RO
with type 'a m = 'a Lwt.t
and type elt = Serializable_builtin_t.datetime * string
and type key = string
val cast : string -> string * datetime -> string Lwt.t
val inject_creds : Util.SSet.t -> unit Lwt.t
val extract_creds : unit -> Util.SSet.t Lwt.t
val update_cred : old:string -> new_:string -> unit Lwt.t
end
module type WEB_ELECTION_BUNDLE =
Signatures.ELECTION_BUNDLE with type 'a E.m = 'a Lwt.t
module type WEB_BALLOT_BOX_BUNDLE = sig
include WEB_ELECTION_BUNDLE
module B : WEB_BALLOT_BOX
end
type 'a web_election = {
modules : (module WEB_BALLOT_BOX_BUNDLE with type elt = 'a);
election : 'a Signatures.election;
election_web : election_web;
}
module type TEMPLATES = sig
......@@ -222,24 +265,22 @@ module type TEMPLATES = sig
featured:'a Serializable_t.params list ->
[> `Html ] Eliom_content.Html5.F.elt Lwt.t
type 'a election
val election_update_credential :
election:'a election ->
election:'a web_election ->
[> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_view :
election:'a election ->
election:'a web_election ->
user:logged_user option ->
[> `Html ] Eliom_content.Html5.F.elt Lwt.t
val do_cast_ballot :
election:'a election ->
election:'a web_election ->
result:[< `Error of Web_common.error | `Valid of string ] ->
[> `Html ] Eliom_content.Html5.F.elt Lwt.t
val ballot_received :
election:'a election ->
election:'a web_election ->
confirm:(unit ->
(Serializable_t.uuid, 'b,
[< Eliom_service.post_service_kind ],
......@@ -250,7 +291,7 @@ module type TEMPLATES = sig
can_vote:bool -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_cast_raw :
election:'a election ->
election:'a web_election ->
[> `Html ] Eliom_content.Html5.F.elt Lwt.t
val dummy_login :
......
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