Skip to content

GitLab

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

Move election service handlers out of functor

parent ef197a11
Hide whitespace changes
Inline Side-by-side
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