Change of topology in Auth_common

We want to be able to share private variables between service
definition time and registration time, so we put both as submodules of
the Make functor.

src/web/auth_common.ml

@@ -43,20 +43,6 @@ let user = Eliom_reference.eref
 
 (* TODO: make the authentication system more flexible *)
 
-module Make (X : EMPTY) = struct
-
-  let login = Eliom_service.service
-    ~path:["login"]
-    ~get_params:Eliom_parameter.(opt (string "service"))
-    ()
-
-  let logout = Eliom_service.service
-    ~path:["logout"]
-    ~get_params:Eliom_parameter.unit
-    ()
-
-end
-
 let auth_system_map = ref []
 
 let register_auth_system name service =
@@ -71,33 +57,53 @@ let get_default_auth_system () =
   | [] -> fail_http 404
   | (name, _) :: _ -> Lwt.return name
 
-module Register (S : ALL_SERVICES) = struct
-
-  let () = Eliom_registration.Redirection.register ~service:S.login
-    (fun service () ->
-      lwt x = match service with
-        | None -> get_default_auth_system ()
-        | Some x -> Lwt.return x
-      in
-      try
-        let auth_system = List.assoc x !auth_system_map in
-        let module A = (val auth_system : AUTH_SYSTEM) in
-        Lwt.return A.service
-      with Not_found -> fail_http 404
-    )
-
-  let () = Eliom_registration.Redirection.register ~service:S.logout
-    (fun () () ->
-      lwt u = Eliom_reference.get user in
-      (* should ballot be unset here or not? *)
-      Eliom_reference.unset user >>
-      match u with
-        | Some u ->
-          let module L = (val u.user_logout) in
-          security_log (fun () ->
-            string_of_user u.user_user ^ " logged out"
-          ) >> L.cont ()
-        | _ -> S.get ()
-    )
+module Make (X : EMPTY) = struct
+
+  module Services : AUTH_SERVICES = struct
+
+    let login = Eliom_service.service
+      ~path:["login"]
+      ~get_params:Eliom_parameter.(opt (string "service"))
+      ()
+
+    let logout = Eliom_service.service
+      ~path:["logout"]
+      ~get_params:Eliom_parameter.unit
+      ()
+
+  end
+
+  module Register (C : CONT_SERVICE) : EMPTY = struct
+
+    let () = Eliom_registration.Redirection.register
+      ~service:Services.login
+      (fun service () ->
+        lwt x = match service with
+          | None -> get_default_auth_system ()
+          | Some x -> Lwt.return x
+        in
+        try
+          let auth_system = List.assoc x !auth_system_map in
+          let module A = (val auth_system : AUTH_SYSTEM) in
+          Lwt.return A.service
+        with Not_found -> fail_http 404
+      )
+
+    let () = Eliom_registration.Redirection.register
+      ~service:Services.logout
+      (fun () () ->
+        lwt u = Eliom_reference.get user in
+        (* should ballot be unset here or not? *)
+        Eliom_reference.unset user >>
+        match u with
+          | Some u ->
+            let module L = (val u.user_logout) in
+            security_log (fun () ->
+              string_of_user u.user_user ^ " logged out"
+            ) >> L.cont ()
+          | _ -> C.cont ()
+      )
+
+  end
 
 end

src/web/auth_common.mli

@@ -38,5 +38,7 @@ val user : logged_user option Eliom_reference.eref
 val get_auth_systems : unit -> string list
 val register_auth_system : string -> (module AUTH_SYSTEM) -> unit
 
-module Make (X : EMPTY) : AUTH_SERVICES
-module Register (S : ALL_SERVICES) : EMPTY
+module Make (X : EMPTY) : sig
+  module Services : AUTH_SERVICES
+  module Register (S : CONT_SERVICE) : EMPTY
+end

src/web/registration.ml

@@ -255,6 +255,8 @@ let if_eligible acl f uuid x =
   lwt b = check_acl acl election.Web_election.election_web user in
   if b then f uuid election user x else forbidden ()
 
+module A = Auth_common.Make (struct end)
+
 module S = struct
   open Eliom_service
   open Eliom_parameter
@@ -339,9 +341,11 @@ module S = struct
   let set s =
     Eliom_reference.set saved_service s
 
-  include Auth_common.Make (struct end)
+  include A.Services
 end
 
+let () = let module X = A.Register (struct let cont = S.get end) in ()
+
 module T = Templates.Make (S)
 
 module C = struct
@@ -352,8 +356,6 @@ module C = struct
   let rewrite_prefix = rewrite_prefix
 end
 
-module A = Auth_common.Register (S)
-
 let () =
   if C.enable_dummy then let module X = Auth_dummy.Register (S) (T) in ()