Commit 56a7581f authored by Stephane Glondu's avatar Stephane Glondu
Browse files

Make logged_user private to Auth_common

parent 9f74cb42
......@@ -48,6 +48,11 @@ type auth_instance = {
auth_config : (string * string) list;
}
type logged_user = {
user_user : user;
user_handlers : (module AUTH_HANDLERS);
}
module type CONFIG = sig
include NAME
val instances : auth_instance list
......@@ -66,7 +71,10 @@ module Make (N : CONFIG) = struct
let get_auth_systems () = !auth_instance_names
let get_logged_user () = Eliom_reference.get user
let get_user () =
match_lwt Eliom_reference.get user with
| Some u -> return (Some u.user_user)
| None -> return None
let login = Eliom_service.service
~path:(N.path @ ["login"])
......
......@@ -34,7 +34,7 @@ let can_read m user =
| Some acls ->
match user with
| None -> List.mem `Any acls (* readers can be anonymous *)
| Some u -> check_acl (Some acls) u.user_user
| Some u -> check_acl (Some acls) u
let can_vote m user =
match m.e_voters with
......@@ -42,7 +42,7 @@ let can_vote m user =
| Some acls ->
match user with
| None -> false (* voters must log in *)
| Some u -> check_acl (Some acls) u.user_user
| Some u -> check_acl (Some acls) u
module type REGISTRATION = sig
module W : WEB_ELECTION
......@@ -307,7 +307,7 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
forbidden ()
let () = Html5.register ~service:W.S.home
(if_eligible S.get_logged_user can_read
(if_eligible S.get_user can_read
(fun user () ->
let module X = struct let s = W.S.home end in
let x = (module X : SAVED_SERVICE) in
......@@ -342,7 +342,7 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
let f_records user () =
match user with
| Some u ->
if metadata.e_owner = Some u.user_user then (
if metadata.e_owner = Some u then (
(* TODO: streaming *)
lwt ballots = W.B.Records.fold (fun u (d, _) xs ->
let x = Printf.sprintf "%s %S\n"
......@@ -361,10 +361,10 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
let handle_pseudo_file u f =
let open Eliom_registration in
let file f =
if_eligible S.get_logged_user can_read f u () >>=
if_eligible S.get_user can_read f u () >>=
File.send ~content_type:"application/json"
and stream f =
if_eligible S.get_logged_user can_read f u () >>=
if_eligible S.get_user can_read f u () >>=
Streamlist.send >>=
(fun x -> return (cast_unknown_content_kind x))
in
......@@ -389,10 +389,10 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
let () = Html5.register
~service:W.S.election_update_credential
(fun uuid () ->
lwt user = S.get_logged_user () in
lwt user = S.get_user () in
match user with
| Some u ->
if metadata.e_owner = Some u.user_user then (
if metadata.e_owner = Some u then (
T.update_credential ()
) else (
forbidden ()
......@@ -403,10 +403,10 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
let () = String.register
~service:W.S.election_update_credential_post
(fun uuid (old, new_) ->
lwt user = S.get_logged_user () in
lwt user = S.get_user () in
match user with
| Some u ->
if metadata.e_owner = Some u.user_user then (
if metadata.e_owner = Some u then (
try_lwt
W.B.update_cred ~old ~new_ >>
return ("OK", "text/plain")
......@@ -420,7 +420,7 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
let () = Redirection.register
~service:W.S.election_vote
(if_eligible S.get_logged_user can_read
(if_eligible S.get_user can_read
(fun user () ->
Eliom_reference.unset ballot >>
let module X = struct let s = W.S.election_vote end in
......@@ -435,12 +435,12 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
| Some the_ballot ->
begin
Eliom_reference.unset ballot >>
match_lwt S.get_logged_user () with
match_lwt S.get_user () with
| Some u ->
let b = check_acl metadata.e_voters u.user_user in
let b = check_acl metadata.e_voters u in
if b then (
let record =
Auth_common.string_of_user u.user_user,
Auth_common.string_of_user u,
(CalendarLib.Fcalendar.Precise.now (), None)
in
lwt result =
......@@ -476,7 +476,7 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
let () = Html5.register
~service:W.S.election_cast
(if_eligible S.get_logged_user can_read
(if_eligible S.get_user can_read
(fun user () ->
let uuid = W.election.e_params.e_uuid in
let module X = struct let s = W.S.election_cast end in
......@@ -490,7 +490,7 @@ let make {raw_election; metadata; featured; params_fname; public_keys_fname} =
let () = Redirection.register
~service:W.S.election_cast_post
(if_eligible S.get_logged_user can_read
(if_eligible S.get_user can_read
(fun user (ballot_raw, ballot_file) ->
lwt the_ballot = match ballot_raw, ballot_file with
| Some ballot, None -> return ballot
......
......@@ -180,15 +180,10 @@ module type AUTH_HANDLERS = sig
val logout : unit service_cont
end
type logged_user = {
user_user : user;
user_handlers : (module AUTH_HANDLERS);
}
module type AUTH_SERVICES = sig
val get_auth_systems : unit -> string list
val get_logged_user : unit -> logged_user option Lwt.t
val get_user : unit -> user option Lwt.t
val login :
(string option, unit,
......@@ -230,7 +225,7 @@ end
module type ELECTION_TEMPLATES = sig
val home :
user:logged_user option ->
user:user option ->
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val update_credential :
......@@ -246,7 +241,7 @@ module type ELECTION_TEMPLATES = sig
[< Eliom_service.suff ], 'c, unit,
[< Eliom_service.registrable ], 'd)
Eliom_service.service) ->
user:logged_user option ->
user:user option ->
can_vote:bool ->
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
......
......@@ -33,12 +33,12 @@ let site_title = "Election Server"
let welcome_message = "Welcome!"
let format_user u =
em [pcdata (Auth_common.(string_of_user u.user_user))]
em [pcdata (Auth_common.(string_of_user u))]
module Make (S : SITE_SERVICES) : TEMPLATES = struct
let base ~title ~content =
lwt user = S.get_logged_user () in
lwt user = S.get_user () in
Lwt.return (html ~a:[a_dir `Ltr; a_xml_lang "en"]
(head (Eliom_content.Html5.F.title (pcdata title)) [])
(body [
......@@ -201,7 +201,7 @@ module Make (S : SITE_SERVICES) : TEMPLATES = struct
pcdata "log in at the last moment.";
]
| Some u ->
let can = if check_acl m.e_voters u.user_user then "can" else "cannot" in
let can = if check_acl m.e_voters u then "can" else "cannot" in
Lwt.return [
pcdata "You ";
pcdata can;
......
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