Skip to content

GitLab

Attention une mise à jour du serveur va être effectuée le lundi 17 mai entre 13h et 13h30. Cette mise à jour va générer une interruption du service de quelques minutes.

Commit f2cadfe4 authored by Stephane Glondu's avatar Stephane Glondu
Browse files
Options

Move election service handlers out of functor

parent ef197a11
Hide whitespace changes
Inline Side-by-side
Showing with 94 additions and 86 deletions
src/web/web_election.ml
View file @ f2cadfe4
......@@ -275,46 +275,58 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
end
module Register (X : EMPTY) : ELECTION_HANDLERS = struct
open Eliom_registration
let () =
Auth.configure N.auth_config
let login service () =
let scope = Eliom_common.default_session_scope
let ballot = Eliom_reference.eref ~scope None
let cast_confirmed = Eliom_reference.eref ~scope None
end
end
end
open Eliom_registration
let login w service () =
let module W = (val w : WEB_ELECTION) in
lwt cont = Eliom_reference.get Web_services.cont in
Auth.Handlers.login service cont ()
W.Auth.Handlers.login service cont ()
let logout () () =
let logout w () () =
let module W = (val w : WEB_ELECTION) in
lwt cont = Eliom_reference.get Web_services.cont in
Auth.Handlers.logout cont ()
W.Auth.Handlers.logout cont ()
module T = Web_templates
let if_eligible acl f () x =
let if_eligible w acl f () x =
let module W = (val w : WEB_ELECTION) in
lwt user = W.Auth.Services.get_user () in
if acl W.metadata user then
f user x
else
forbidden ()
let scope = Eliom_common.default_session_scope
let ballot = Eliom_reference.eref ~scope None
let cast_confirmed = Eliom_reference.eref ~scope None
let home =
(if_eligible can_read
let home w =
let module W = (val w : WEB_ELECTION) in
let uuid = Uuidm.to_string W.election.e_params.e_uuid in
(if_eligible w can_read
(fun user () ->
Eliom_reference.unset ballot >>
Eliom_reference.unset W.Z.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 cast_confirmed with
match_lwt Eliom_reference.get W.Z.cast_confirmed with
| Some result ->
Eliom_reference.unset cast_confirmed >>
Eliom_reference.unset W.Z.cast_confirmed >>
T.cast_confirmed (module W) ~result () >>= Html5.send
| None ->
lwt state = Web_persist.get_election_state uuid in
......@@ -322,7 +334,9 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
)
)
let admin site_user is_featured =
let admin w site_user is_featured =
let module W = (val w : WEB_ELECTION) in
let uuid = Uuidm.to_string W.election.e_params.e_uuid in
(fun () () ->
match site_user with
| Some u when W.metadata.e_owner = Some u ->
......@@ -335,7 +349,8 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
| ESRaw | ESKeys | ESBallots -> "application/json"
| ESCreds | ESRecords -> "text/plain"
let handle_pseudo_file u f site_user =
let handle_pseudo_file w u f site_user =
let module W = (val w : WEB_ELECTION) in
lwt () =
if f = ESRecords then (
match site_user with
......@@ -346,7 +361,8 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
let content_type = content_type_of_file f in
File.send ~content_type (W.dir / string_of_election_file f)
let election_dir site_user =
let election_dir w site_user =
let module W = (val w : WEB_ELECTION) in
(fun f () ->
let cont () () =
Redirection.send
......@@ -355,10 +371,11 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
(W.election.e_params.e_uuid, f))
in
Eliom_reference.set Web_services.cont cont >>
handle_pseudo_file () f site_user
handle_pseudo_file w () f site_user
)
let election_update_credential site_user =
let election_update_credential w site_user =
let module W = (val w : WEB_ELECTION) in
(fun () () ->
match site_user with
| Some u ->
......@@ -370,7 +387,8 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
| _ -> forbidden ()
)
let election_update_credential_post site_user =
let election_update_credential_post w site_user =
let module W = (val w : WEB_ELECTION) in
(fun () (old, new_) ->
match site_user with
| Some u ->
......@@ -387,10 +405,11 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
| _ -> forbidden ()
)
let election_vote =
(if_eligible can_read
let election_vote w =
let module W = (val w : WEB_ELECTION) in
(if_eligible w can_read
(fun user () ->
Eliom_reference.unset ballot >>
Eliom_reference.unset W.Z.ballot >>
let cont () () =
Redirection.send
(Eliom_service.preapply
......@@ -407,11 +426,12 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
)
)
let election_cast_confirm () () =
match_lwt Eliom_reference.get ballot with
let election_cast_confirm w () () =
let module W = (val w : WEB_ELECTION) in
match_lwt Eliom_reference.get W.Z.ballot with
| Some the_ballot ->
begin
Eliom_reference.unset ballot >>
Eliom_reference.unset W.Z.ballot >>
match_lwt W.Auth.Services.get_user () with
| Some u ->
let b = check_acl W.metadata.e_voters u in
......@@ -423,8 +443,8 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
return (`Valid hash)
with Error e -> return (`Error e)
in
Eliom_reference.unset ballot >>
Eliom_reference.set cast_confirmed (Some result) >>
Eliom_reference.unset W.Z.ballot >>
Eliom_reference.set W.Z.cast_confirmed (Some result) >>
Redirection.send
(Eliom_service.preapply
election_home (W.election.e_params.e_uuid, ()))
......@@ -433,12 +453,14 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
end
| None -> fail_http 404
let ballot_received user hash =
let ballot_received w user hash =
let module W = (val w : WEB_ELECTION) in
let can_vote = can_vote W.metadata user in
T.cast_confirmation (module W) ~can_vote hash ()
let election_cast =
(if_eligible can_read
let election_cast w =
let module W = (val w : WEB_ELECTION) in
(if_eligible w can_read
(fun user () ->
let cont () () =
Redirection.send
......@@ -446,14 +468,15 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
election_cast (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set Web_services.cont cont >>
match_lwt Eliom_reference.get ballot with
| Some b -> ballot_received user (sha256_b64 b) >>= Html5.send
match_lwt Eliom_reference.get W.Z.ballot with
| Some b -> ballot_received w user (sha256_b64 b) >>= Html5.send
| None -> T.cast_raw (module W) () >>= Html5.send
)
)
let election_cast_post =
(if_eligible can_read
let election_cast_post w =
let module W = (val w : WEB_ELECTION) in
(if_eligible w can_read
(fun user (ballot_raw, ballot_file) ->
lwt the_ballot = match ballot_raw, ballot_file with
| Some ballot, None -> return ballot
......@@ -468,7 +491,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
Web_services.election_cast (W.election.e_params.e_uuid, ()))
in
Eliom_reference.set Web_services.cont cont >>
Eliom_reference.set ballot (Some the_ballot) >>
Eliom_reference.set W.Z.ballot (Some the_ballot) >>
match user with
| None ->
Redirection.send
......@@ -479,7 +502,8 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
)
)
let election_pretty_ballots start () =
let election_pretty_ballots w start () =
let module W = (val w : WEB_ELECTION) in
lwt user = W.Auth.Services.get_user () in
if can_read W.metadata user then (
lwt res, _ =
......@@ -492,7 +516,8 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
in T.pretty_ballots (module W) res () >>= Html5.send
) else forbidden ()
let election_pretty_ballot hash () =
let election_pretty_ballot w hash () =
let module W = (val w : WEB_ELECTION) in
lwt user = W.Auth.Services.get_user () in
if can_read W.metadata user then (
lwt ballot =
......@@ -507,9 +532,3 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
String.send (b, "application/json") >>=
(fun x -> return @@ cast_unknown_content_kind x)
) else forbidden ()
end
end
end
src/web/web_election.mli
View file @ f2cadfe4
......@@ -40,3 +40,17 @@ module type REGISTRABLE = sig
end
module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE
val login : (module WEB_ELECTION) -> string option -> unit -> content
val logout : (module WEB_ELECTION) -> unit -> unit -> content
val home : (module WEB_ELECTION) -> unit -> unit -> content
val admin : (module WEB_ELECTION) -> user option -> bool -> unit -> unit -> content
val election_dir : (module WEB_ELECTION) -> user option -> Web_common.election_file -> unit -> content
val election_update_credential : (module WEB_ELECTION) -> user option -> unit -> unit -> content
val election_update_credential_post : (module WEB_ELECTION) -> user option -> unit -> string * string -> content
val election_vote : (module WEB_ELECTION) -> unit -> unit -> content
val election_cast : (module WEB_ELECTION) -> unit -> unit -> content
val election_cast_post : (module WEB_ELECTION) -> unit -> string option * Eliom_lib.file_info option -> content
val election_cast_confirm : (module WEB_ELECTION) -> unit -> unit -> content
val election_pretty_ballots : (module WEB_ELECTION) -> int -> unit -> content
val election_pretty_ballot : (module WEB_ELECTION) -> string -> unit -> content
src/web/web_signatures.mli
View file @ f2cadfe4
......@@ -64,20 +64,8 @@ type content =
module type ELECTION_HANDLERS =
sig
val login : string option -> unit -> content
val logout : unit -> unit -> content
val home : unit -> unit -> content
val admin : user option -> bool -> unit -> unit -> content
val election_dir : user option -> Web_common.election_file -> unit -> content
val election_update_credential : user option -> unit -> unit -> content
val election_update_credential_post : user option -> unit -> string * string -> content
val election_vote : unit -> unit -> content
val election_cast : unit -> unit -> content
val election_cast_post :
unit -> string option * Eliom_lib.file_info option -> content
val election_cast_confirm : unit -> unit -> content
val election_pretty_ballots : int -> unit -> content
val election_pretty_ballot : string -> unit -> content
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 =
......
src/web/web_site.ml
View file @ f2cadfe4
......@@ -670,8 +670,7 @@ let () =
(fun (uuid, ()) () ->
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
W.Z.home () ())
Web_election.home w () ())
let () =
Any.register
......@@ -691,10 +690,9 @@ let () =
(fun (uuid, ()) () ->
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
lwt user = Web_site_auth.get_user () in
lwt is_featured = Web_persist.is_featured_election uuid_s in
W.Z.admin user is_featured () ())
Web_election.admin w user is_featured () ())
let () =
Any.register
......@@ -716,8 +714,7 @@ let () =
(fun ((uuid, ()), service) () ->
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
W.Z.login service ())
Web_election.login w service ())
let () =
Any.register
......@@ -725,8 +722,7 @@ let () =
(fun (uuid, ()) () ->
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
W.Z.logout () ())
Web_election.logout w () ())
let () =
Any.register
......@@ -734,9 +730,8 @@ let () =
(fun (uuid, ()) () ->
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
lwt user = Web_site_auth.get_user () in
W.Z.election_update_credential user () ())
Web_election.election_update_credential w user () ())
let () =
Any.register
......@@ -744,9 +739,8 @@ let () =
(fun (uuid, ()) x ->
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
lwt user = Web_site_auth.get_user () in
W.Z.election_update_credential_post user () x)
Web_election.election_update_credential_post w user () x)
let () =
Any.register
......@@ -754,8 +748,7 @@ let () =
(fun (uuid, ()) x ->
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
W.Z.election_vote () x)
Web_election.election_vote w () x)
let () =
Any.register
......@@ -763,8 +756,7 @@ let () =
(fun (uuid, ()) x ->
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
W.Z.election_cast () x)
Web_election.election_cast w () x)
let () =
Any.register
......@@ -772,8 +764,7 @@ let () =
(fun (uuid, ()) x ->
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
W.Z.election_cast_post () x)
Web_election.election_cast_post w () x)
let () =
Any.register
......@@ -781,8 +772,7 @@ let () =
(fun (uuid, ()) x ->
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
W.Z.election_cast_confirm () x)
Web_election.election_cast_confirm w () x)
let () =
Any.register
......@@ -790,8 +780,7 @@ let () =
(fun ((uuid, ()), start) () ->
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
W.Z.election_pretty_ballots start ())
Web_election.election_pretty_ballots w start ())
let () =
Any.register
......@@ -799,8 +788,7 @@ let () =
(fun ((uuid, ()), hash) () ->
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
W.Z.election_pretty_ballot hash ())
Web_election.election_pretty_ballot w hash ())
let () =
Any.register
......@@ -808,6 +796,5 @@ let () =
(fun (uuid, f) x ->
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
lwt user = Web_site_auth.get_user () in
W.Z.election_dir user f x)
Web_election.election_dir w user f x)
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