Skip to content

GitLab

Commit 6cde86d2 authored by Stephane Glondu's avatar Stephane Glondu
Browse files
Options

Move ballot and cast_confirmed to Web_services, drop WEB_ELECTION_

parent fefc7315
Hide whitespace changes
Inline Side-by-side
Showing with 39 additions and 53 deletions
src/web/web_election.ml
View file @ 6cde86d2
......@@ -33,8 +33,8 @@ open Web_services
let ( / ) = Filename.concat
module type REGISTRATION = sig
module W : WEB_ELECTION_
module Register (X : EMPTY) : ELECTION_HANDLERS
module W : WEB_ELECTION
module Register (X : EMPTY) : EMPTY
end
module type REGISTRABLE = sig
......@@ -258,16 +258,11 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
end
module Register (X : EMPTY) : ELECTION_HANDLERS = struct
module Register (X : EMPTY) : EMPTY = struct
let () =
Auth.configure N.auth_config
let scope = Eliom_common.default_session_scope
let ballot = Eliom_reference.eref ~scope None
let cast_confirmed = Eliom_reference.eref ~scope None
end
end
......
src/web/web_election.mli
View file @ 6cde86d2
......@@ -26,8 +26,8 @@ open Web_serializable_t
open Web_signatures
module type REGISTRATION = sig
module W : WEB_ELECTION_
module Register (X : EMPTY) : ELECTION_HANDLERS
module W : WEB_ELECTION
module Register (X : EMPTY) : EMPTY
end
module type REGISTRABLE = sig
......
src/web/web_services.ml
View file @ 6cde86d2
......@@ -74,3 +74,9 @@ let scope = Eliom_common.default_session_scope
let cont : (unit -> service_handler) Eliom_reference.eref =
Eliom_reference.eref ~scope (fun () () -> Eliom_registration.Redirection.send home)
let ballot : string option Eliom_reference.eref =
Eliom_reference.eref ~scope None
let cast_confirmed : [ `Error of Web_common.error | `Valid of string ] option Eliom_reference.eref =
Eliom_reference.eref ~scope None
src/web/web_signatures.mli
View file @ 6cde86d2
......@@ -62,12 +62,6 @@ end
type content =
Eliom_registration.browser_content Eliom_registration.kind Lwt.t
module type ELECTION_HANDLERS =
sig
val ballot : string option Eliom_reference.eref
val cast_confirmed : [ `Error of Web_common.error | `Valid of string ] option Eliom_reference.eref
end
module type AUTH_HANDLERS_RAW =
sig
val login : string option -> unit -> content
......@@ -110,7 +104,7 @@ module type WEB_PARAMS = sig
val dir : string
end
module type WEB_ELECTION_ = sig
module type WEB_ELECTION = sig
include ELECTION_DATA
include WEB_PARAMS
module E : ELECTION with type elt = G.t
......@@ -121,11 +115,6 @@ module type WEB_ELECTION_ = sig
end
end
module type WEB_ELECTION = sig
include WEB_ELECTION_
module Z : ELECTION_HANDLERS
end
type election_files = {
f_election : string;
f_metadata : string;
......
src/web/web_site.ml
View file @ 6cde86d2
......@@ -93,11 +93,7 @@ let register_election params web_params =
(* starting from here, we do side-effects on the running server *)
let module R = R.Register (struct end) in
let module W = R.W in
let module X : ELECTION_HANDLERS = R.Register (T) in
let module W = struct
include W
module Z = X
end in
let module X : EMPTY = R.Register (T) in
let election = (module W : WEB_ELECTION) in
election_table := SMap.add uuid election !election_table;
election
......@@ -698,16 +694,16 @@ let () =
let uuid = Uuidm.to_string W.election.e_params.e_uuid in
(if_eligible w can_read
(fun user () ->
Eliom_reference.unset W.Z.ballot >>
Eliom_reference.unset Web_services.ballot >>
let cont () () =
Redirection.send
(Eliom_service.preapply
election_home (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set Web_services.cont cont >>
match_lwt Eliom_reference.get W.Z.cast_confirmed with
match_lwt Eliom_reference.get Web_services.cast_confirmed with
| Some result ->
Eliom_reference.unset W.Z.cast_confirmed >>
Eliom_reference.unset Web_services.cast_confirmed >>
T.cast_confirmed (module W) ~result () >>= Html5.send
| None ->
lwt state = Web_persist.get_election_state uuid in
......@@ -826,7 +822,7 @@ let () =
let module W = (val w : WEB_ELECTION) in
(if_eligible w can_read
(fun user () ->
Eliom_reference.unset W.Z.ballot >>
Eliom_reference.unset Web_services.ballot >>
let cont () () =
Redirection.send
(Eliom_service.preapply
......@@ -863,7 +859,7 @@ let () =
election_cast (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set Web_services.cont cont >>
match_lwt Eliom_reference.get W.Z.ballot with
match_lwt Eliom_reference.get Web_services.ballot with
| Some b -> ballot_received w user (sha256_b64 b) >>= Html5.send
| None -> T.cast_raw (module W) () >>= Html5.send
)
......@@ -891,7 +887,7 @@ let () =
Web_services.election_cast (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set Web_services.cont cont >>
Eliom_reference.set W.Z.ballot (Some the_ballot) >>
Eliom_reference.set Web_services.ballot (Some the_ballot) >>
match user with
| None ->
Redirection.send
......@@ -909,10 +905,10 @@ let () =
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 Eliom_reference.get W.Z.ballot with
match_lwt Eliom_reference.get Web_services.ballot with
| Some the_ballot ->
begin
Eliom_reference.unset W.Z.ballot >>
Eliom_reference.unset Web_services.ballot >>
match_lwt W.Auth.Services.get_user () with
| Some u ->
let b = check_acl W.metadata.e_voters u in
......@@ -924,8 +920,8 @@ let () =
return (`Valid hash)
with Error e -> return (`Error e)
in
Eliom_reference.unset W.Z.ballot >>
Eliom_reference.set W.Z.cast_confirmed (Some result) >>
Eliom_reference.unset Web_services.ballot >>
Eliom_reference.set Web_services.cast_confirmed (Some result) >>
Redirection.send
(Eliom_service.preapply
election_home (W.election.e_params.e_uuid, ()))
......
src/web/web_templates.ml
View file @ 6cde86d2
......@@ -497,7 +497,7 @@ let election_setup_trustee token uuid se () =
let election_login_box w =
let module W = (val w : WEB_ELECTION_) in
let module W = (val w : WEB_ELECTION) in
let auth = (module W.Auth.Services : AUTH_SERVICES) in
let module L = struct
let login x =
......@@ -513,13 +513,13 @@ let election_login_box w =
fun () -> make_login_box "" auth links
let file w x =
let module W = (val w : WEB_ELECTION_) in
let module W = (val w : WEB_ELECTION) in
Eliom_service.preapply
election_dir
(W.election.e_params.e_uuid, x)
let election_home w state () =
let module W = (val w : WEB_ELECTION_) in
let module W = (val w : WEB_ELECTION) in
lwt user = W.Auth.Services.get_user () in
let params = W.election.e_params and m = W.metadata in
lwt permissions =
......@@ -644,7 +644,7 @@ let election_home w state () =
base ~title:params.e_name ~login_box ~content ~footer ()
let election_admin w ~is_featured state auth () =
let module W = (val w : WEB_ELECTION_) in
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 -> [
......@@ -682,7 +682,7 @@ let election_admin w ~is_featured state auth () =
base ~title ~login_box ~content ()
let update_credential w auth () =
let module W = (val w : WEB_ELECTION_) in
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_) ->
......@@ -723,7 +723,7 @@ let update_credential w auth () =
base ~title:params.e_name ~login_box ~content ()
let cast_raw w () =
let module W = (val w : WEB_ELECTION_) in
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, _) ->
......@@ -756,7 +756,7 @@ let cast_raw w () =
base ~title:params.e_name ~login_box ~content ()
let cast_confirmation w ~can_vote hash () =
let module W = (val w : WEB_ELECTION_) in
let module W = (val w : WEB_ELECTION) in
lwt user = W.Auth.Services.get_user () in
let params = W.election.e_params in
let name = params.e_name in
......@@ -818,7 +818,7 @@ let cast_confirmation w ~can_vote hash () =
base ~title:name ~login_box ~content ()
let cast_confirmed w ~result () =
let module W = (val w : WEB_ELECTION_) in
let module W = (val w : WEB_ELECTION) in
let params = W.election.e_params in
let name = params.e_name in
let progress = div ~a:[a_style "text-align:center;margin-bottom:20px;"] [
......@@ -863,7 +863,7 @@ let cast_confirmed w ~result () =
base ~title:name ~login_box ~content ()
let pretty_ballots w hashes () =
let module W = (val w : WEB_ELECTION_) in
let module W = (val w : WEB_ELECTION) in
let params = W.election.e_params in
let title = params.e_name ^ " — Accepted ballots" in
let nballots = ref 0 in
......
src/web/web_templates.mli
View file @ 6cde86d2
......@@ -35,13 +35,13 @@ val election_setup_questions : Uuidm.t -> Web_common.setup_election -> (module A
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_) -> [ `Open | `Closed ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_admin : (module WEB_ELECTION_) -> is_featured:bool -> [ `Open | `Closed ] -> (module AUTH_SERVICES) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val update_credential : (module WEB_ELECTION_) -> (module AUTH_SERVICES) -> 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
val cast_confirmed : (module WEB_ELECTION_) -> result:[< `Error of Web_common.error | `Valid of string ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val pretty_ballots : (module WEB_ELECTION_) -> string list -> 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 ] -> (module AUTH_SERVICES) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val update_credential : (module WEB_ELECTION) -> (module AUTH_SERVICES) -> 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
val cast_confirmed : (module WEB_ELECTION) -> result:[< `Error of Web_common.error | `Valid of string ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val pretty_ballots : (module WEB_ELECTION) -> string list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val dummy :
service:(unit, 'a, [< Eliom_service.post_service_kind ],
......
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