Commit f41718ae authored by Stephane Glondu's avatar Stephane Glondu

Make election state persistent

parent 00f86743
......@@ -16,6 +16,7 @@ Auth_password
Auth_cas
Web_site_auth
Web_templates
Web_persist
Web_election
Web_site
Web_main
......@@ -127,13 +127,14 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
Ocsipersist.add cred_table cred None
let do_cast rawballot (user, date) =
lwt state = Web_persist.get_election_state uuid in
let voting_open =
let compare a b =
match a, b with
| Some a, Some b -> datetime_compare a b
| _, _ -> -1
in
!state = `Open &&
state = `Open &&
compare metadata.e_voting_starts_at (Some date) <= 0 &&
compare (Some date) metadata.e_voting_ends_at < 0
in
......@@ -322,7 +323,9 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
| Some result ->
Eliom_reference.unset cast_confirmed >>
T.cast_confirmed (module W) ~result () >>= Html5.send
| None -> T.election_home (module W) () >>= Html5.send
| None ->
lwt state = Web_persist.get_election_state uuid in
T.election_home (module W) state () >>= Html5.send
)
)
......@@ -330,7 +333,8 @@ 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.election_admin (module W) ~is_featured () >>= Html5.send
lwt state = Web_persist.get_election_state uuid in
T.election_admin (module W) ~is_featured state () >>= Html5.send
| _ -> forbidden ()
)
......
open Lwt
let election_states = Ocsipersist.open_table "election_states"
let get_election_state x =
try_lwt Ocsipersist.find election_states x
with Not_found -> return `Open
let set_election_state x s =
Ocsipersist.add election_states x s
val get_election_state : string -> [ `Open | `Closed ] Lwt.t
val set_election_state : string -> [ `Open | `Closed ] -> unit Lwt.t
......@@ -120,7 +120,6 @@ end
module type WEB_PARAMS = sig
val metadata : metadata
val dir : string
val state : [ `Open | `Closed ] ref
end
module type WEB_ELECTION_ = sig
......
......@@ -770,7 +770,8 @@ let () =
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;
let state = if state then `Open else `Closed in
Web_persist.set_election_state uuid_s state >>
Redirection.send (preapply election_admin (uuid, ()))
| _ -> forbidden ())
......
......@@ -613,7 +613,7 @@ let make_login_box style auth links =
election_dir
(W.election.e_params.e_uuid, x)
let election_home w () =
let election_home w state () =
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
......@@ -672,7 +672,7 @@ let make_login_box style auth links =
]
in
let state =
if !W.state = `Closed then
if state = `Closed then
[
pcdata " ";
b [pcdata "This election is currently closed."];
......@@ -738,7 +738,7 @@ let make_login_box style auth links =
lwt login_box = election_login_box w () in
base ~title:params.e_name ~login_box ~content ~footer ()
let election_admin w ~is_featured () =
let election_admin w ~is_featured state () =
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
......@@ -749,7 +749,7 @@ let make_login_box style auth links =
]) (W.election.e_params.e_uuid, ())
in
let state_form =
let checked = !W.state = `Open in
let checked = state = `Open in
post_form
~service:election_set_state
(fun name ->
......
......@@ -35,8 +35,8 @@ val election_setup_questions : Uuidm.t -> Web_common.setup_election -> unit -> [
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 election_home : (module WEB_ELECTION_) -> [ `Open | `Closed ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_admin : (module WEB_ELECTION_) -> is_featured:bool -> [ `Open | `Closed ] -> 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 -> string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
......
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