Commit 9ef319af authored by Stephane Glondu's avatar Stephane Glondu

Avoid passing Web_site_auth around in calls to Web_template

parent e18b0be1
......@@ -11,6 +11,7 @@ Web_serializable_j
Web_common
Web_persist
Web_services
Web_site_auth_state
Web_templates
Web_auth
Auth_dummy
......
......@@ -262,7 +262,7 @@ let () = Html5.register ~service:admin
else return accu
) election_stable []
in
T.admin ~elections ~setup_elections (module Web_site_auth) ()
T.admin ~elections ~setup_elections ()
)
let () = File.register
......@@ -294,7 +294,7 @@ let () = Html5.register ~service:new_election
(fun () () ->
match_lwt Web_site_auth.get_user () with
| None -> forbidden ()
| Some _ -> T.new_election (module Web_site_auth : AUTH_SERVICES) ()
| Some _ -> T.new_election ()
)
let () = Any.register ~service:new_election_post
......@@ -311,7 +311,7 @@ let () = Any.register ~service:new_election_post
begin try_lwt
begin match_lwt import_election files with
| None ->
T.new_election_failure `Exists (module Web_site_auth : AUTH_SERVICES) () >>= Html5.send
T.new_election_failure `Exists () >>= Html5.send
| Some w ->
let module W = (val w : REGISTRABLE_ELECTION) in
lwt w = W.register () in
......@@ -320,7 +320,7 @@ let () = Any.register ~service:new_election_post
(preapply election_admin (W.election.e_params.e_uuid, ()))
end
with e ->
T.new_election_failure (`Exception e) (module Web_site_auth : AUTH_SERVICES) () >>= Html5.send
T.new_election_failure (`Exception e) () >>= Html5.send
end
| None -> forbidden ()
)
......@@ -374,7 +374,7 @@ let () = Html5.register ~service:election_setup
let uuid_s = Uuidm.to_string uuid in
lwt se = Ocsipersist.find election_stable uuid_s in
if se.se_owner = u
then T.election_setup uuid se (module Web_site_auth : AUTH_SERVICES) ()
then T.election_setup uuid se ()
else forbidden ()
| None -> forbidden ()
)
......@@ -425,7 +425,7 @@ let () =
let uuid_s = Uuidm.to_string uuid in
lwt se = Ocsipersist.find election_stable uuid_s in
if se.se_owner = u
then T.election_setup_questions uuid se (module Web_site_auth : AUTH_SERVICES) ()
then T.election_setup_questions uuid se ()
else forbidden ()
| None -> forbidden ()
)
......@@ -446,7 +446,7 @@ let () =
let uuid_s = Uuidm.to_string uuid in
lwt se = Ocsipersist.find election_stable uuid_s in
if se.se_owner = u
then T.election_setup_voters uuid se (module Web_site_auth : AUTH_SERVICES) ()
then T.election_setup_voters uuid se ()
else forbidden ()
| None -> forbidden ()
)
......@@ -689,7 +689,7 @@ let () =
(* actually create the election *)
begin match_lwt import_election files with
| None ->
T.new_election_failure `Exists (module Web_site_auth : AUTH_SERVICES) () >>= Html5.send
T.new_election_failure `Exists () >>= Html5.send
| Some w ->
let module W = (val w : REGISTRABLE_ELECTION) in
lwt w = W.register () in
......@@ -719,7 +719,7 @@ let () =
end
)
with e ->
T.new_election_failure (`Exception e) (module Web_site_auth : AUTH_SERVICES) () >>= Html5.send
T.new_election_failure (`Exception e) () >>= Html5.send
end
)
......@@ -770,7 +770,7 @@ let () =
match site_user with
| Some u when W.metadata.e_owner = Some u ->
lwt state = Web_persist.get_election_state uuid in
T.election_admin (module W) ~is_featured state (module Web_site_auth : AUTH_SERVICES) () >>= Html5.send
T.election_admin (module W) ~is_featured state () >>= Html5.send
| _ -> forbidden ()
)
......@@ -826,7 +826,7 @@ let () =
match site_user with
| Some u ->
if W.metadata.e_owner = Some u then (
T.update_credential (module W) (module Web_site_auth : AUTH_SERVICES) () >>= Html5.send
T.update_credential (module W) () >>= Html5.send
) else (
forbidden ()
)
......
......@@ -42,3 +42,6 @@ let logout () () =
let () = Any.register ~service:site_login login
let () = Any.register ~service:site_logout logout
let () = Web_site_auth_state.get_user := get_user
let () = Web_site_auth_state.get_auth_systems := get_auth_systems
open Lwt
open Web_serializable_t
(* Forward references filled in by Web_site_auth, needed by Web_templates *)
let get_user : (unit -> user option Lwt.t) ref = ref (fun () -> return None)
let get_auth_systems : (unit -> string list) ref = ref (fun () -> [])
......@@ -79,10 +79,17 @@ module Site_links = struct
let logout = Eliom_service.preapply site_logout ()
end
module Site_auth = struct
let auth_realm = "site"
let get_user () = !Web_site_auth_state.get_user ()
let get_auth_systems () = !Web_site_auth_state.get_auth_systems ()
end
let site_links = (module Site_links : AUTH_LINKS)
let site_auth = (module Site_auth : AUTH_SERVICES)
let site_login_box auth () =
make_login_box admin_background auth site_links
let site_login_box () =
make_login_box admin_background site_auth site_links
let base ~title ~login_box ~content ?(footer = div []) () =
Lwt.return (html ~a:[a_dir `Ltr; a_xml_lang "en"]
......@@ -151,7 +158,7 @@ let home ~featured () =
let login_box = pcdata "" in
base ~title:site_title ~login_box ~content ()
let admin ~elections ~setup_elections auth () =
let admin ~elections ~setup_elections () =
let title = site_title ^ " — Administration" in
let elections =
match elections with
......@@ -175,7 +182,7 @@ let admin ~elections ~setup_elections auth () =
elections;
];
] in
lwt login_box = site_login_box auth () in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
let format_date = Platform.format_datetime "%a, %d %b %Y %T %z"
......@@ -187,7 +194,7 @@ let make_button ~service contents =
uri
contents
let new_election auth () =
let new_election () =
let title = "Create new election" in
lwt body =
let form = post_form ~service:new_election_post
......@@ -232,10 +239,10 @@ let new_election auth () =
let content = [
div body;
] in
lwt login_box = site_login_box auth () in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
let new_election_failure reason auth () =
let new_election_failure reason () =
let title = "Create new election" in
let reason =
match reason with
......@@ -248,7 +255,7 @@ let new_election_failure reason auth () =
p [reason];
]
] in
lwt login_box = site_login_box auth () in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
let generic_page ~title message () =
......@@ -258,7 +265,7 @@ let generic_page ~title message () =
let login_box = pcdata "" in
base ~title ~login_box ~content ()
let election_setup uuid se auth () =
let election_setup uuid se () =
let title = "Preparation of election " ^ Uuidm.to_string uuid in
let make_form ?a service value title =
post_form ?a ~service
......@@ -372,10 +379,10 @@ let election_setup uuid se auth () =
div_questions;
form_create;
] in
lwt login_box = site_login_box auth () in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
let election_setup_questions uuid se auth () =
let election_setup_questions uuid se () =
let title = "Questions for election " ^ Uuidm.to_string uuid in
let form =
let value = string_of_template se.se_questions in
......@@ -408,10 +415,10 @@ let election_setup_questions uuid se auth () =
form;
link;
] in
lwt login_box = site_login_box auth () in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
let election_setup_voters uuid se auth () =
let election_setup_voters uuid se () =
let title = "Voters for election " ^ Uuidm.to_string uuid in
let form =
post_form
......@@ -426,7 +433,7 @@ let election_setup_voters uuid se auth () =
let content = [
form
] in
lwt login_box = site_login_box auth () in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
let election_setup_credentials token uuid se () =
......@@ -695,7 +702,7 @@ let election_home w state () =
lwt login_box = election_login_box w () in
base ~title:params.e_name ~login_box ~content ~footer ()
let election_admin w ~is_featured state auth () =
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 uuid_s = Uuidm.to_string W.election.e_params.e_uuid in
......@@ -811,10 +818,10 @@ let election_admin w ~is_featured state auth () =
div [feature_form];
div [state_div];
] in
lwt login_box = site_login_box auth () in
lwt login_box = site_login_box () in
base ~title ~login_box ~content ()
let update_credential w auth () =
let update_credential w () =
let module W = (val w : WEB_ELECTION) in
let params = W.election.e_params in
let form = post_form ~service:election_update_credential_post
......@@ -852,7 +859,7 @@ let update_credential w auth () =
let content = [
form;
] in
lwt login_box = site_login_box auth () in
lwt login_box = site_login_box () in
base ~title:params.e_name ~login_box ~content ()
let cast_raw w () =
......
......@@ -22,22 +22,22 @@
open Web_signatures
val home : featured:(module WEB_ELECTION) list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val admin : elections:(module WEB_ELECTION) list -> setup_elections:(Uuidm.t list) -> (module AUTH_SERVICES) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val admin : elections:(module WEB_ELECTION) list -> setup_elections:(Uuidm.t list) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val new_election : (module AUTH_SERVICES) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val new_election_failure : [ `Exists | `Exception of exn ] -> (module AUTH_SERVICES) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val new_election : unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val new_election_failure : [ `Exists | `Exception of exn ] -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val generic_page : title:string -> string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup : Uuidm.t -> Web_common.setup_election -> (module AUTH_SERVICES) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_voters : Uuidm.t -> Web_common.setup_election -> (module AUTH_SERVICES) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_questions : Uuidm.t -> Web_common.setup_election -> (module AUTH_SERVICES) -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup : Uuidm.t -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_voters : Uuidm.t -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_questions : Uuidm.t -> Web_common.setup_election -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
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) -> Web_persist.election_state -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_admin : (module WEB_ELECTION) -> is_featured:bool -> Web_persist.election_state -> (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 election_admin : (module WEB_ELECTION) -> is_featured:bool -> Web_persist.election_state -> 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) -> 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
......
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