Commit ab29fbab authored by Stephane Glondu's avatar Stephane Glondu

Add administration pages for site and elections

 - do not show any login box on the site home page
 - add a link to site admnistration page to the generic footer
parent 7df73649
......@@ -229,6 +229,11 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRATION = struct
~get_params:unit
()
let admin = service
~path:(make_path ["admin"])
~get_params:unit
()
let election_dir = service
~path:root
~priority:(-1)
......@@ -309,6 +314,13 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRATION = struct
)
)
let () = Html5.register ~service:W.S.admin
(fun () () ->
match_lwt S.get_user () with
| Some u when W.metadata.e_owner = Some u -> T.admin ()
| _ -> forbidden ()
)
let ( / ) = Filename.concat
let f_raw user () =
......
......@@ -64,6 +64,15 @@ module type CORE_SERVICES = sig
[< Eliom_service.registrable > `Registrable ], 'a)
Eliom_service.service
val admin :
(unit, unit,
[> `Attached of
([> `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ], unit, unit,
[< Eliom_service.registrable > `Registrable ], 'a)
Eliom_service.service
val source_code :
(unit, unit,
[> `Attached of
......@@ -96,6 +105,15 @@ module type ELECTION_SERVICES = sig
[< Eliom_service.registrable > `Registrable ], 'a)
Eliom_service.service
val admin :
(unit, unit,
[> `Attached of
([> `Internal of [> `Service ] ], [> `Get ])
Eliom_service.a_s ],
[ `WithoutSuffix ], unit, unit,
[< Eliom_service.registrable > `Registrable ], 'a)
Eliom_service.service
val election_dir :
(Web_common.election_file, unit,
[> `Attached of
......@@ -204,6 +222,9 @@ module type ELECTION_TEMPLATES = sig
val home :
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val admin :
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val update_credential :
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
......@@ -302,6 +323,10 @@ module type TEMPLATES = sig
featured:(module WEB_ELECTION_RO) list ->
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val admin :
elections:(module WEB_ELECTION_RO) list ->
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
module Login (S : AUTH_SERVICES) : LOGIN_TEMPLATES
module Election (W : WEB_ELECTION_RO) : ELECTION_TEMPLATES
......
......@@ -95,6 +95,11 @@ module Make (C : CONFIG) : SITE = struct
~get_params:unit
()
let admin = service
~path:(make_path ["admin"])
~get_params:unit
()
let source_code = service
~path:(make_path ["belenios.tar.gz"])
~get_params:unit
......@@ -258,6 +263,26 @@ module Make (C : CONFIG) : SITE = struct
Redirection.send W.S.home
)
let () = Html5.register ~service:admin
(fun () () ->
let cont () () = Redirection.send admin in
Eliom_reference.set S.cont cont >>
lwt elections =
match_lwt get_user () with
| None -> return []
| Some u ->
SMap.fold (fun _ w accu ->
let module W = (val w : WEB_ELECTION) in
if W.metadata.e_owner = Some u then (
(module W : WEB_ELECTION_RO) :: accu
) else (
accu
)
) !election_table [] |> List.rev |> return
in
T.admin ~elections ()
)
let () = File.register
~service:source_code
~content_type:"application/x-gzip"
......
......@@ -96,16 +96,23 @@ module Make (S : SITE_SERVICES) : TEMPLATES = struct
div ~a:[a_id "footer"; a_style "text-align: center;" ] [
pcdata "Powered by ";
a ~service:S.source_code [pcdata "Belenios"] ();
pcdata ". ";
a ~service:S.admin [pcdata "Administer elections"] ();
pcdata ".";
]
]))
let format_one_featured_election election =
let format_election kind election =
let module W = (val election : WEB_ELECTION_RO) in
let e = W.election.e_params in
let service =
match kind with
| `Home -> W.S.home
| `Admin -> W.S.admin
in
li [
h3 [
a ~service:W.S.home [pcdata e.e_name] ();
a ~service [pcdata e.e_name] ();
];
p [pcdata e.e_description];
]
......@@ -115,7 +122,7 @@ module Make (S : SITE_SERVICES) : TEMPLATES = struct
| _::_ ->
div [
h2 [pcdata "Current featured elections"];
ul (List.map format_one_featured_election featured);
ul (List.map (format_election `Home) featured);
]
| [] ->
div [
......@@ -129,9 +136,26 @@ module Make (S : SITE_SERVICES) : TEMPLATES = struct
featured_box;
];
] in
lwt login_box = site_login_box () in
let login_box = pcdata "" in
base ~title:site_title ~login_box ~content
let admin ~elections () =
let title = site_title ^ " — Administration" in
let elections =
match elections with
| [] -> p [pcdata "You cannot administer any elections!"]
| _ -> ul @@ List.map (format_election `Admin) elections
in
let content = [
h1 [pcdata title];
div [
h2 [pcdata "Elections you can administer"];
elections;
];
] in
lwt login_box = site_login_box () in
base ~title ~login_box ~content
module Login (S : AUTH_SERVICES) : LOGIN_TEMPLATES = struct
let login_box =
......@@ -337,6 +361,22 @@ module Make (S : SITE_SERVICES) : TEMPLATES = struct
lwt login_box = election_login_box () in
base ~title:params.e_name ~login_box ~content
let admin () =
let title = W.election.e_params.e_name ^ " — Administration" in
let content = [
h1 [pcdata title];
div [
let service = W.S.home in
a ~service [pcdata "Election home"] ();
];
div [
let service = W.S.election_update_credential in
a ~service [pcdata "Update a credential"] ();
];
] in
lwt login_box = site_login_box () in
base ~title ~login_box ~content
let update_credential () =
let params = W.election.e_params in
let form = post_form ~service:W.S.election_update_credential_post
......
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