Commit 7f40105c authored by Stephane Glondu's avatar Stephane Glondu

Remove one layer of functors in Web_templates

parent 7edd9c40
......@@ -14,6 +14,7 @@ Web_auth
Auth_dummy
Auth_password
Auth_cas
Web_site_auth
Web_templates
Web_election
Web_site
......
......@@ -50,7 +50,7 @@ let can_vote m user =
module type REGISTRATION = sig
module W : WEB_ELECTION_
module Register (T : TEMPLATES) : ELECTION_HANDLERS
module Register (X : EMPTY) : ELECTION_HANDLERS
end
module type REGISTRABLE = sig
......@@ -274,7 +274,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
end
module Register (T : TEMPLATES) : ELECTION_HANDLERS = struct
module Register (X : EMPTY) : ELECTION_HANDLERS = struct
open Eliom_registration
module L = struct
......@@ -283,7 +283,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
end
let () =
let module T = T.Login (W.S) (L) in
let module T = Web_templates.Login (W.S) (L) in
let templates = (module T : LOGIN_TEMPLATES) in
Auth.register templates N.auth_config
......@@ -295,7 +295,7 @@ module Make (D : ELECTION_DATA) (P : WEB_PARAMS) : REGISTRABLE = struct
lwt cont = Eliom_reference.get Web_services.cont in
Auth.Handlers.do_logout cont ()
module T = T.Election (W)
module T = Web_templates.Election (W)
let if_eligible acl f () x =
lwt user = W.S.get_user () in
......
......@@ -27,7 +27,7 @@ open Web_signatures
module type REGISTRATION = sig
module W : WEB_ELECTION_
module Register (T : TEMPLATES) : ELECTION_HANDLERS
module Register (X : EMPTY) : ELECTION_HANDLERS
end
module type REGISTRABLE = sig
......
......@@ -210,46 +210,6 @@ module type LOGIN_TEMPLATES = sig
end
module type TEMPLATES = sig
val home :
featured:(module WEB_ELECTION) list ->
unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val admin :
elections:(module WEB_ELECTION) list ->
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_error_page :
string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_index :
Uuidm.t list -> 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_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
module Login (S : AUTH_SERVICES) (L : AUTH_LINKS) : LOGIN_TEMPLATES
module Election (W : WEB_ELECTION_) : ELECTION_TEMPLATES
end
module type NAME = sig
val name : string
val path : string list
......
......@@ -61,28 +61,21 @@ let delete_shallow_directory dir =
open Eliom_service
open Eliom_registration
module C = struct
let name = "site"
let path = []
let kind = `Site
end
module Auth = Web_auth.Make (C)
module LwtRandom = MakeLwtRandom (struct let rng = make_rng () end)
let store = Ocsipersist.open_store C.name
let store = Ocsipersist.open_store "site"
(* Persistent table, used to initialize the server. *)
let election_ptable = Ocsipersist.open_table (C.name ^ "_elections")
let election_ptable = Ocsipersist.open_table "site_elections"
(* Table with elections in setup mode. *)
let election_stable = Ocsipersist.open_table (C.name ^ "_setup")
let election_stable = Ocsipersist.open_table "site_setup"
(* Table with tokens given to trustees. *)
let election_pktokens = Ocsipersist.open_table (C.name ^ "_pktokens")
let election_pktokens = Ocsipersist.open_table "site_pktokens"
(* Table with tokens given to credential authorities. *)
let election_credtokens = Ocsipersist.open_table (C.name ^ "_credtokens")
let election_credtokens = Ocsipersist.open_table "site_credtokens"
(* In-memory table, indexed by UUID, contains closures. *)
let election_table = ref SMap.empty
......@@ -102,7 +95,7 @@ let delete_shallow_directory dir =
(* Forward reference *)
let install_authentication_ref = ref (fun _ -> assert false)
include Auth.Services
include Web_site_auth
let import_election f = !import_election_ref f
......@@ -136,7 +129,7 @@ let delete_shallow_directory dir =
let install_authentication xs = !install_authentication_ref xs
module T = Web_templates.Make (Auth.Services)
module T = Web_templates
let register_election params web_params =
let module P = (val params : ELECTION_PARAMS) in
......@@ -291,9 +284,9 @@ let delete_shallow_directory dir =
end
let () = install_authentication_ref := fun auth_configs ->
let module T = T.Login (Auth.Services) (L) in
let module T = T.Login (Web_site_auth) (L) in
let templates = (module T : LOGIN_TEMPLATES) in
Auth.register templates auth_configs
Web_site_auth.register templates auth_configs
let () = Any.register ~service:home
(fun () () ->
......@@ -331,17 +324,6 @@ let delete_shallow_directory dir =
T.admin ~elections ()
)
let login service () =
lwt cont = Eliom_reference.get Web_services.cont in
Auth.Handlers.do_login service cont ()
let logout () () =
lwt cont = Eliom_reference.get Web_services.cont in
Auth.Handlers.do_logout cont ()
let () = Any.register ~service:site_login login
let () = Any.register ~service:site_logout logout
let () = File.register
~service:source_code
~content_type:"application/x-gzip"
......
(**************************************************************************)
(* BELENIOS *)
(* *)
(* Copyright © 2012-2014 Inria *)
(* *)
(* This program is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Affero General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version, with the additional *)
(* exemption that compiling, linking, and/or using OpenSSL is allowed. *)
(* *)
(* This program is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
(* Affero General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU Affero General Public *)
(* License along with this program. If not, see *)
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
module C = struct
let name = "site"
let path = []
let kind = `Site
end
module A = Web_auth.Make (C)
let register = A.register
include A.Services
open Eliom_registration
open Web_services
let login service () =
lwt cont = Eliom_reference.get Web_services.cont in
A.Handlers.do_login service cont ()
let logout () () =
lwt cont = Eliom_reference.get Web_services.cont in
A.Handlers.do_logout cont ()
let () = Any.register ~service:site_login login
let () = Any.register ~service:site_logout logout
open Web_serializable_t
open Web_signatures
val register : (module LOGIN_TEMPLATES) -> auth_config list -> unit
include AUTH_SERVICES
......@@ -74,10 +74,9 @@ let make_login_box style auth links =
]
)
module Make (S : AUTH_SERVICES) : TEMPLATES = struct
let site_login_box =
let auth = (module S : AUTH_SERVICES) in
let auth = (module Web_site_auth : AUTH_SERVICES) in
let module L = struct
let login x = Eliom_service.preapply site_login x
let logout = Eliom_service.preapply site_logout ()
......@@ -810,5 +809,3 @@ module Make (S : AUTH_SERVICES) : TEMPLATES = struct
base ~title:name ~login_box ~content
end
end
(**************************************************************************)
(* BELENIOS *)
(* *)
(* Copyright © 2012-2014 Inria *)
(* *)
(* This program is free software: you can redistribute it and/or modify *)
(* it under the terms of the GNU Affero General Public License as *)
(* published by the Free Software Foundation, either version 3 of the *)
(* License, or (at your option) any later version, with the additional *)
(* exemption that compiling, linking, and/or using OpenSSL is allowed. *)
(* *)
(* This program is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *)
(* Affero General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU Affero General Public *)
(* License along with this program. If not, see *)
(* <http://www.gnu.org/licenses/>. *)
(**************************************************************************)
open Web_signatures
module Make (S : AUTH_SERVICES) : TEMPLATES
val home : featured:(module WEB_ELECTION) list -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val admin : elections:(module WEB_ELECTION) list -> 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_error_page : string -> unit -> [> `Html ] Eliom_content.Html5.F.elt Lwt.t
val election_setup_index : Uuidm.t list -> 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_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
module Login (S : AUTH_SERVICES) (L : AUTH_LINKS) : LOGIN_TEMPLATES
module Election (W : WEB_ELECTION_) : ELECTION_TEMPLATES
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