Commit 944f0679 authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Remove another layer of functors in Web_templates

parent 7f40105c
......@@ -295,7 +295,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
lwt cont = Eliom_reference.get Web_services.cont in
Auth.Handlers.do_logout cont ()
module T = Web_templates.Election (W)
module T = Web_templates
let if_eligible acl f () x =
lwt user = W.S.get_user () in
......@@ -322,8 +322,8 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
match_lwt Eliom_reference.get cast_confirmed with
| Some result ->
Eliom_reference.unset cast_confirmed >>
T.cast_confirmed ~result () >>= Html5.send
| None -> T.home () >>= Html5.send
T.cast_confirmed (module W) ~result () >>= Html5.send
| None -> T.election_home (module W) () >>= Html5.send
)
)
......@@ -331,7 +331,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
(fun () () ->
match site_user with
| Some u when W.metadata.e_owner = Some u ->
T.admin ~is_featured () >>= Html5.send
T.election_admin (module W) ~is_featured () >>= Html5.send
| _ -> forbidden ()
)
......@@ -367,7 +367,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
match site_user with
| Some u ->
if W.metadata.e_owner = Some u then (
T.update_credential () >>= Html5.send
T.update_credential (module W) () >>= Html5.send
) else (
forbidden ()
)
......@@ -439,7 +439,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
let ballot_received user =
let can_vote = can_vote W.metadata user in
T.cast_confirmation ~can_vote ()
T.cast_confirmation (module W) ~can_vote ()
let election_cast =
(if_eligible can_read
......@@ -452,7 +452,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
Eliom_reference.set Web_services.cont cont >>
match_lwt Eliom_reference.get ballot with
| Some _ -> ballot_received user >>= Html5.send
| None -> T.cast_raw () >>= Html5.send
| None -> T.cast_raw (module W) () >>= Html5.send
)
)
......
......@@ -115,31 +115,6 @@ module type WEB_BALLOT_BOX = sig
val update_cred : old:string -> new_:string -> unit Lwt.t
end
module type ELECTION_TEMPLATES = sig
val home :
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val admin :
is_featured:bool ->
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val update_credential :
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_raw :
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_confirmation :
can_vote:bool ->
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_confirmed :
result:[< `Error of Web_common.error | `Valid of string ] ->
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
end
module type WEB_PARAMS = sig
val metadata : metadata
val dir : string
......
......@@ -504,9 +504,9 @@ let make_login_box style auth links =
let login_box = pcdata "" in
base ~title ~login_box ~content
module Election (W : WEB_ELECTION_) = struct
let election_login_box =
let election_login_box w =
let module W = (val w : WEB_ELECTION_) in
let auth = (module W.S : AUTH_SERVICES) in
let module L = struct
let login x =
......@@ -521,12 +521,14 @@ let make_login_box style auth links =
let links = (module L : AUTH_LINKS) in
fun () -> make_login_box "" auth links
let file x =
let file w x =
let module W = (val w : WEB_ELECTION_) in
Eliom_service.preapply
election_dir
(W.election.e_params.e_uuid, x)
let home () =
let election_home w () =
let module W = (val w : WEB_ELECTION_) in
lwt user = W.S.get_user () in
let params = W.election.e_params and m = W.metadata in
lwt permissions =
......@@ -592,19 +594,19 @@ let make_login_box style auth links =
];
div [
pcdata "Election data: ";
a ~service:(file ESRaw) [
a ~service:(file w ESRaw) [
pcdata "parameters"
] ();
pcdata ", ";
a ~service:(file ESCreds) [
a ~service:(file w ESCreds) [
pcdata "public credentials"
] ();
pcdata ", ";
a ~service:(file ESKeys) [
a ~service:(file w ESKeys) [
pcdata "trustee public keys"
] ();
pcdata ", ";
a ~service:(file ESBallots) [
a ~service:(file w ESBallots) [
pcdata "ballots";
] ();
pcdata ".";
......@@ -632,10 +634,11 @@ let make_login_box style auth links =
br ();
audit_info;
] in
lwt login_box = election_login_box () in
lwt login_box = election_login_box w () in
base ~title:params.e_name ~login_box ~content
let admin ~is_featured () =
let election_admin w ~is_featured () =
let module W = (val w : WEB_ELECTION_) in
let title = W.election.e_params.e_name ^ " — Administration" in
let feature_form = post_form ~service:election_set_featured
(fun featured -> [
......@@ -648,7 +651,7 @@ let make_login_box style auth links =
let content = [
h1 [pcdata title];
div [
a ~service:election_home [pcdata "Election home"] (uuid, ());
a ~service:Web_services.election_home [pcdata "Election home"] (uuid, ());
];
div [
a ~service:election_update_credential [pcdata "Update a credential"] (uuid, ());
......@@ -661,7 +664,8 @@ let make_login_box style auth links =
lwt login_box = site_login_box () in
base ~title ~login_box ~content
let update_credential () =
let update_credential w () =
let module W = (val w : WEB_ELECTION_) in
let params = W.election.e_params in
let form = post_form ~service:election_update_credential_post
(fun (old, new_) ->
......@@ -702,7 +706,8 @@ let make_login_box style auth links =
lwt login_box = site_login_box () in
base ~title:params.e_name ~login_box ~content
let cast_raw () =
let cast_raw w () =
let module W = (val w : WEB_ELECTION_) in
let params = W.election.e_params in
let form_rawballot = post_form ~service:election_cast_post
(fun (name, _) ->
......@@ -732,10 +737,11 @@ let make_login_box style auth links =
h3 [ pcdata "Submit by file" ];
form_upload;
] in
lwt login_box = election_login_box () in
lwt login_box = election_login_box w () in
base ~title:params.e_name ~login_box ~content
let cast_confirmation ~can_vote () =
let cast_confirmation w ~can_vote () =
let module W = (val w : WEB_ELECTION_) in
lwt user = W.S.get_user () in
let params = W.election.e_params in
let name = params.e_name in
......@@ -770,7 +776,7 @@ let make_login_box style auth links =
p [
(let service =
Eliom_service.preapply
election_home (W.election.e_params.e_uuid, ())
Web_services.election_home (W.election.e_params.e_uuid, ())
in
a ~service [
pcdata "Go back to election"
......@@ -778,10 +784,11 @@ let make_login_box style auth links =
pcdata ".";
];
] in
lwt login_box = election_login_box () in
lwt login_box = election_login_box w () in
base ~title:name ~login_box ~content
let cast_confirmed ~result () =
let cast_confirmed w ~result () =
let module W = (val w : WEB_ELECTION_) in
let params = W.election.e_params in
let name = params.e_name in
let content = [
......@@ -805,7 +812,6 @@ let make_login_box style auth links =
pcdata ".";
];
] in
lwt login_box = election_login_box () in
lwt login_box = election_login_box w () in
base ~title:name ~login_box ~content
end
......@@ -34,5 +34,11 @@ val election_setup : Uuidm.t -> Web_common.setup_election -> unit -> [> `Html ]
val election_setup_credentials : string -> string -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_trustee : string -> string -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_home : (module WEB_ELECTION_) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_admin : (module WEB_ELECTION_) -> is_featured:bool -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val update_credential : (module WEB_ELECTION_) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_raw : (module WEB_ELECTION_) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_confirmation : (module WEB_ELECTION_) -> can_vote:bool -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val cast_confirmed : (module WEB_ELECTION_) -> result:[< `Error of Web_common.error | `Valid of string ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
module Login (S : AUTH_SERVICES) (L : AUTH_LINKS) : LOGIN_TEMPLATES
module Election (W : WEB_ELECTION_) : ELECTION_TEMPLATES
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