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

Add state

parent c0900856
......@@ -133,6 +133,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
| Some a, Some b -> datetime_compare a b
| _, _ -> -1
in
!state = `Open &&
compare metadata.e_voting_starts_at (Some date) <= 0 &&
compare (Some date) metadata.e_voting_ends_at < 0
in
......
......@@ -58,6 +58,7 @@ let election_admin = service ~path:["elections"] ~get_params:(suffix (uuid "uuid
let election_login = service ~path:["elections"] ~get_params:(suffix_prod (uuid "uuid" ** suffix_const "login") (opt (string "service"))) ()
let election_logout = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "logout")) ()
let election_set_featured = post_coservice ~fallback:election_admin ~post_params:(bool "featured") ()
let election_set_state = post_coservice ~fallback:election_admin ~post_params:(bool "state") ()
let election_update_credential = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "update-cred")) ()
let election_update_credential_post = post_service ~fallback:election_update_credential ~post_params:(string "old_credential" ** string "new_credential") ()
let election_vote = service ~path:["elections"] ~get_params:(suffix (uuid "uuid" ** suffix_const "vote")) ()
......
......@@ -120,6 +120,7 @@ end
module type WEB_PARAMS = sig
val metadata : metadata
val dir : string
val state : [ `Open | `Closed ] ref
end
module type WEB_ELECTION_ = sig
......
......@@ -194,6 +194,7 @@ let delete_shallow_directory dir =
let module X = struct
let metadata = metadata
let dir = dir
let state = ref `Open
end in
let web_params = (module X : WEB_PARAMS) in
let r, do_register = register_election params web_params in
......@@ -746,6 +747,19 @@ let delete_shallow_directory dir =
lwt is_featured = is_featured_election uuid_s in
W.Z.admin user is_featured () ())
let () =
Any.register
~service:election_set_state
(fun (uuid, ()) state ->
let uuid_s = Uuidm.to_string uuid in
let w = SMap.find uuid_s !election_table in
let module W = (val w : WEB_ELECTION) in
match_lwt get_user () with
| Some u when W.metadata.e_owner = Some u ->
W.state := if state then `Open else `Closed;
Redirection.send (preapply election_admin (uuid, ()))
| _ -> forbidden ())
let () =
Any.register
~service:election_login
......
......@@ -632,6 +632,14 @@ let make_login_box style auth links =
pcdata ".";
]
in
let state =
if !W.state = `Closed then
[
pcdata " ";
b [pcdata "This election is currently closed."];
]
else []
in
let ballots_link =
p [
a ~service:election_pretty_ballots [
......@@ -672,7 +680,7 @@ let make_login_box style auth links =
p ~a:[a_style "margin: 1em; padding: 2pt; font-style: italic; border: 1pt solid;"] [
pcdata params.e_description
];
p voting_period;
p (voting_period @ state);
p permissions;
div [
div [
......@@ -702,6 +710,17 @@ let make_login_box style auth links =
string_input ~input_type:`Submit ~value:"Apply" ();
]) (W.election.e_params.e_uuid, ())
in
let state_form =
let checked = !W.state = `Open in
post_form
~service:election_set_state
(fun name ->
[
bool_checkbox ~name ~checked ();
pcdata "Open this election ";
string_input ~input_type:`Submit ~value:"Apply" ();
]) (W.election.e_params.e_uuid, ())
in
let uuid = W.election.e_params.e_uuid in
let content = [
h1 [pcdata title];
......@@ -715,6 +734,7 @@ let make_login_box style auth links =
a ~service:election_dir [pcdata "Voting records"] (uuid, ESRecords);
];
div [feature_form];
div [state_form];
] in
lwt login_box = site_login_box () in
base ~title ~login_box ~content
......
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